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.