With the question of assignment out of the way, the Lists module of chapter 12 can be modified to be entirely generic, using ARRAY OF LOC for its parameters, and the above procedures for assignments. However, there is a down side to the increased flexibility, and that is that ARRAY OF LOC parameters have no type checking whatsoever. This means that anything could be passed to the procedure that adds an item to the list, and there would be no way of checking to ensure the data type is correct. However, the approach shown here is a typical one in ISO Standard Modula-2.
DEFINITION MODULE Lists;
(* Generic implementation of lists (not safely type checked) *)
(* copyright © 1995 by R. Sutcliffe *)
(* last modification 1995 03 31 *)
FROM SYSTEM IMPORT
LOC;
TYPE
List;
Operation = (insert, delete, fetchup);
PROCEDURE Create (itemSize : CARDINAL) : List;
(* Pre: itemSize is the size in storage units of the items to be listed
Post: a new list structure is initialized with length zero.
Insert, delete and fetch/update start out at the head of the list. *)
PROCEDURE Discard (VAR list : List);
(* Pre: list is a validly created list
Post: list is undefined *)
PROCEDURE Length (list : List) : CARDINAL;
(* Pre: list is a validly created list
Post: The number of items in the list is returned. *)
PROCEDURE SetAtHead (VAR list : List; op : Operation);
(* Pre: list is a validly created list
Post: The position for the given insert, delete, or fetch/update
operation is the first item. *)
PROCEDURE SetAtTail (VAR list : List; op : Operation);
(* Pre: list is a validly created list
Post: The position for the given insert, delete, or fetch/update
operation is the last item. *)
PROCEDURE SetAtPos (VAR list : List; op : Operation; itemNum : CARDINAL);
(* Pre: list is a validly created
Post: The position for the given insert, delete, or fetch/update
operation is the itemNum item. If ItemNum >= Length, it is set to the last item.
If it is zero or one, it is set to the head. Note, however that a delete or
fetch/update position set to one or greater moves forward with the item it previously designated if inserting is done before it. Likewise, an Insert or fetch/update position pulls back one numerically with the item it designated prior to a delete that occurs in front of it. *)
PROCEDURE Insert (VAR list : List; item : ARRAY OF LOC);
(* Pre: list is a validly created list and item is the right size to be
placed in the list.
Post: the item is inserted before the currently set insert position. The insert position is now before the item just inserted. For example, if inserting was being done at the head, it still is. The length is updated. *)
PROCEDURE Append (VAR list : List; item : ARRAY OF LOC);
(* Pre: list is a validly created list and item is the right size to be
placed in the list.
Post: the item is inserted after the last item in the list. Note that Insert cannot be used to do this. *)
PROCEDURE Update (VAR list : List; item : ARRAY OF LOC);
(* Pre: list is a validly created list and item is the right size to be
placed in the list.
Post: The old item at the currently set position for fetch/update is updated to item. The fetch/update position is not changed. *)
PROCEDURE Fetch (list : List; VAR item : ARRAY OF LOC);
(* Pre: list is a validly created list and item is the right size to
receive data from the list.
Post: item gets the data at the current position for fetch/update.
The fetch/update position is not changed. *)
PROCEDURE Delete (VAR list : List);
(* Pre: list is a validly created list
Post: the item at the current delete position is removed from the list
and the length is updated. The current delete position is now at
the item after the one deleted, or it if was the last, it points to
the new last. That is, if we were deleting at the head, we still are
and if we were deleting at the tail, we still are. If we delete the
position for either insert or fetch/update, their new item will be the
same as the new delete item.
Note: The initial or default delete position is at the head. Should the
list shrink to zero items and then grow again, deleting will continue
from either the head or the tail, depending on which was being
conducted at the time the last item was deleted. -- see SetAtPos. *)
END Lists.
This definition is almost the same as the previous version, except for the parameters. The implementation differs more, however, for the low level copy routines must be employed to get data to and from the list.
IMPLEMENTATION MODULE Lists;
(* Generic implementation of lists (not safe) *)
(* copyright © 1995 by R. Sutcliffe *)
(* last modification 1995 03 31 *)
FROM SYSTEM IMPORT
LOC, ADDRESS;
FROM Storage IMPORT
ALLOCATE, DEALLOCATE;
FROM CopyLocs IMPORT
CopyToAdr, CopyFromAdr;
TYPE
NodePoint = POINTER TO Node;
Node =
RECORD
dataLoc : ADDRESS;
next,
last : NodePoint;
END;
List = POINTER TO ListInfo;
ListInfo =
RECORD
dataSize,
numItems : CARDINAL;
head,
tail,
curInsert,
curDelete,
curFetchup : NodePoint;
delAtHead : BOOLEAN;
END;
PROCEDURE Create (itemSize : CARDINAL) : List;
VAR
locList : List;
BEGIN
ALLOCATE (locList, SIZE(ListInfo) );
WITH locList^
DO
dataSize := itemSize;
numItems := 0;
head := NIL;
tail := head;
curInsert := head;
curDelete := head;
curFetchup := head;
delAtHead := TRUE;
END;
RETURN locList;
END Create;
PROCEDURE Discard (VAR list : List);
BEGIN
SetAtHead (list, delete);
WHILE list^.numItems > 0
DO
Delete (list);
END;
DEALLOCATE (list, SIZE(ListInfo) );
list := NIL;
END Discard;
PROCEDURE Length (list : List) : CARDINAL;
BEGIN
RETURN list^.numItems;
END Length;
PROCEDURE SetAtHead (VAR list : List; op : Operation);
BEGIN
CASE op OF
insert:
list^.curInsert := list^.head |
delete:
list^.curDelete := list^.head;
list^.delAtHead := TRUE; |
fetchup:
list^.curFetchup := list^.head;
END;
END SetAtHead;
PROCEDURE SetAtTail (VAR list : List; op : Operation);
BEGIN
CASE op OF
insert:
list^.curInsert := list^.tail |
delete:
list^.curDelete := list^.tail;
list^.delAtHead := FALSE; |
fetchup:
list^.curFetchup := list^.tail;
END;
END SetAtTail;
PROCEDURE SetAtPos (VAR list : List; op : Operation; itemNum : CARDINAL);
VAR
count : CARDINAL;
tempPoint : NodePoint;
BEGIN
IF itemNum = 0
THEN
SetAtHead (list, op);
ELSIF itemNum >= list^.numItems THEN
SetAtTail (list, op)
ELSE (* not setting at head or tail *)
IF itemNum > (list^.numItems DIV 2) THEN (* past middle? *)
count := list^.numItems;
tempPoint := list^.tail; (* start at the back *)
WHILE count > itemNum (* back up if necessary *)
DO
tempPoint := tempPoint^.last;
DEC (count);
END;
ELSE (* before middle but not at zero *)
count := 1;
tempPoint := list^.head; (* start at the front *)
WHILE count < itemNum (* go forward if necessary *)
DO
tempPoint := tempPoint^.next;
INC (count);
END;
END;
CASE op OF
insert:
list^.curInsert := tempPoint |
delete:
list^.curDelete := tempPoint;
list^.delAtHead := FALSE; |
fetchup:
list^.curFetchup := tempPoint;
END;
END;
END SetAtPos;
PROCEDURE GetNode (list : List; item :ARRAY OF LOC) : NodePoint;
(* This is a local procedure *)
VAR
local : NodePoint;
BEGIN
ALLOCATE (local, SIZE(Node) ); (* get a new node *)
ALLOCATE (local^.dataLoc, list^.dataSize); (* get space for actual data *)
CopyToAdr (item, local^.dataLoc); (* put data there *)
RETURN local;
END GetNode;
PROCEDURE Insert (VAR list : List; item : ARRAY OF LOC);
VAR
local : NodePoint;
BEGIN
local := GetNode (list, item);
local^.next := list^.curInsert;
IF list^.curInsert # list^.head (*inserting at head? *)
THEN (* no, so chain in new item *)
local^.last := list^.curInsert^.last; (* point back to previous node *)
list^.curInsert^.last^.next := local; (* and make it point to new one *)
ELSE
local^.last := NIL; (* yes, so back pointer is NIL *)
IF (list^.curDelete = list^.head) AND list^.delAtHead
(* if delete is at head too, keep it there *)
THEN
list^.curDelete := local;
END;
IF list^.curFetchup = list^.head (* if fetchUp is at head too, keep it there *)
THEN
list^.curFetchup := local;
END;
IF list^.tail = NIL (* if this is the first item in *)
THEN
list^.tail := local;
END;
list^.head := local; (* revise the head *)
END;
IF list^.curInsert # NIL
THEN
list^.curInsert^.last := local;
END;
list^.curInsert := local; (* insert point becomes new item *)
INC (list^.numItems);
END Insert;
PROCEDURE Append (VAR list : List; item : ARRAY OF LOC);
VAR
local : NodePoint;
BEGIN
local := GetNode (list, item);
local^.last := list^.tail;
local^.next := NIL;
IF list^.tail = NIL (* list currently empty *)
THEN
WITH list^
DO
head := local;
curInsert := head;
curDelete := head;
curFetchup := head;
END;
ELSE
list^.tail^.next := local;
END;
list^.tail := local;
INC (list^.numItems);
END Append;
PROCEDURE Update (VAR list : List; item : ARRAY OF LOC);
BEGIN
CopyToAdr (item, list^.curFetchup^.dataLoc);
END Update;
PROCEDURE Fetch (list : List; VAR item : ARRAY OF LOC);
BEGIN
CopyFromAdr (list^.curFetchup^.dataLoc, item);
END Fetch;
PROCEDURE Delete (VAR list : List);
VAR
newCurDel : NodePoint;
BEGIN
IF list^.numItems = 0
THEN
RETURN
END;
DEALLOCATE (list^.curDelete^.dataLoc, list^.dataSize);
IF list^.curDelete^.last # NIL (* if not at #1 *)
THEN
list^.curDelete^.last^.next := list^.curDelete^.next;
ELSE
list^.head := list^.curDelete^.next;
END;
IF list^.curDelete^.next # NIL (* if not at last item *)
THEN
list^.curDelete^.next^.last := list^.curDelete^.last;
newCurDel := list^.curDelete^.next;
ELSE
list^.tail := list^.curDelete^.last;
newCurDel := list^.curDelete^.last;
END;
IF list^.curDelete = list^.curInsert (* hammered off insert item? *)
THEN
list^.curInsert := newCurDel;
END;
IF list^.curFetchup = list^.curInsert (* hammered off fetchup item? *)
THEN
list^.curFetchup := newCurDel;
END;
DEC (list^.numItems);
list^.curDelete := newCurDel;
END Delete;
END Lists.
Observe that this version of Create tells the list module only the size of the items that are going to be enlisted. Not only does the list module have no means to check the type of the items listed, it does not even have code to check that the correct size is indeed used. The latter oversight however, is simple for the student to correct, and is left as an exercise. The absence of type checking on the items being listed is more serious, however, and is a serious drawback to this method. The very strength of Modula-2 (strong type checking) must be sacrificed here to achieve genericity. Because of this drawback, other methods will also be explored later in chapter 16.