15.7 A Generic List Type With ARRAY OF LOC

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.


Contents