Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!wuarchive!zaphod.mps.ohio-state.edu!pacific.mps.ohio-state.edu!linac!att!ucbvax!VMTECSLP.BITNET!AL281785
From: AL281785@VMTECSLP.BITNET (RoDoGu)
Newsgroups: comp.lang.modula2
Subject: RE: POINTER/LINKED LIST HELP?
Message-ID: <INFO-M2%91040213325395@UCF1VM.BITNET>
Date: 2 Apr 91 18:25:45 GMT
Sender: daemon@ucbvax.BERKELEY.EDU
Reply-To: Modula2 List <INFO-M2%UCF1VM.BITNET@ucf1vm.cc.ucf.edu>
Organization: The Internet
Lines: 305

Here is another Lists ADT. It works (i have used for two years).
The lasts procedures (ResetList and NextList) are based on the same philosophy
as JPI Btree Toolkit.


DEFINITION MODULE Lists;

FROM SYSTEM
  IMPORT BYTE,ADDRESS;

TYPE
  List;
  NodePointer;
  PROCEDURE InitList(VAR l : List);
  PROCEDURE EmptyList(l : List):BOOLEAN;
  PROCEDURE First(l : List):NodePointer;
  PROCEDURE Last(l : List):NodePointer;
  PROCEDURE LengthList(l : List):CARDINAL;
  PROCEDURE InsertRight(VAR l : List;place : NodePointer;x : ARRAY OF BYTE);
  PROCEDURE InsertLeft(VAR l : List;place : NodePointer;x : ARRAY OF BYTE);
  PROCEDURE UpdateList(VAR l : List;place : NodePointer;x : ARRAY OF BYTE);
  PROCEDURE DeleteList(VAR l : List;VAR place : NodePointer);
  PROCEDURE Retrieve(VAR l : List;place : NodePointer; VAR x : ARRAY OF BYTE);
  PROCEDURE Next(place : NodePointer):NodePointer;
  PROCEDURE Previous(place : NodePointer):NodePointer;
  PROCEDURE EndList(place : NodePointer):BOOLEAN;
  PROCEDURE ClearList(VAR l : List);
  PROCEDURE DestroyList(VAR l : List);
  PROCEDURE ResetList(VAR l : List);
  PROCEDURE NextList(VAR l : List;VAR data : ARRAY OF BYTE) : BOOLEAN;

END Lists.

IMPLEMENTATION MODULE Lists;

FROM SYSTEM
  IMPORT ADDRESS,ADR,SIZE,BYTE;
FROM Storage
  IMPORT ALLOCATE,DEALLOCATE;

TYPE
  NodePointer = POINTER TO Node;
  List = POINTER TO
         RECORD
           Start,
           Curr,
           First,Last : NodePointer;
           len : CARDINAL
         END;
  Node = RECORD
           Info : ADDRESS;
           Mem  : CARDINAL;
           Left,Right : NodePointer
         END;

  TYPE
       PtrAdr = POINTER TO ARRAY 0..0FFFFH-1| OF BYTE;


  PROCEDURE Move(f,t : PtrAdr; (* check type compativility *)
                 c : CARDINAL);
  TYPE
       xu    : CARDINAL;
  BEGIN
    FOR xu := 0 TO c - 1 DO
      t^xu| := f^xu|
    END (* for *);
  END Move;

  PROCEDURE InitList(VAR l : List);
  BEGIN
    NEW(l);
    WITH l^ DO
      First := NIL;
      Last := NIL;
      NEW(Start);
      len := 0
    END
  END InitList;

  PROCEDURE EmptyList(l : List):BOOLEAN;
  BEGIN
    RETURN l^.First = NIL
  END EmptyList;

  PROCEDURE First(l : List):NodePointer;
  BEGIN
    RETURN l^.First
  END First;

  PROCEDURE Last(l : List):NodePointer;
  BEGIN
    RETURN l^.Last
  END Last;

  PROCEDURE LengthList(l : List):CARDINAL;
  BEGIN
    RETURN l^.len
  END LengthList;

  PROCEDURE InsertRight(VAR l : List;place : NodePointer;x : ARRAY OF BYTE);
  VAR
    t : NodePointer;
  BEGIN
    WITH l^ DO
      NEW(t);
      t^.Mem := SIZE(x);
      ALLOCATE(t^.Info,t^.Mem);
      MoveFwd(ADR(x),t^.Info,SIZE(x));
      INC(len);
      IF First = NIL THEN
        First := t;
        Last := t;
        t^.Right := NIL;
        t^.Left := NIL
      ELSIF place = Last THEN
        Last^.Right := t;
        t^.Left := Last;
        t^.Right := NIL;
        Last := t
      ELSIF place # NIL THEN
        t^.Right := place^.Right;
        t^.Left := place;
        place^.Right := t;
        t^.Right^.Left := t
      ELSE
        DEALLOCATE(t^.Info,t^.Mem);
        DISPOSE(t);
        DEC(len)
      END
    END
  END InsertRight;

  PROCEDURE InsertLeft(VAR l : List;place : NodePointer;x : ARRAY OF BYTE);
  VAR
    t : NodePointer;
  BEGIN
    WITH l^ DO
      NEW(t);
      t^.Mem := SIZE(x);
      ALLOCATE(t^.Info,t^.Mem);
      MoveFwd(ADR(x),t^.Info,SIZE(x));
      INC(len);
      IF First = NIL THEN
        First := t;
        Last := t;
        t^.Right := NIL;
        t^.Left := NIL
      ELSIF place = First THEN
        t^.Right := First;
        t^.Left := NIL;
        First^.Left := t;
        First := t
      ELSIF place # NIL THEN
        t^.Left := place^.Left;
        t^.Right := place;
        t^.Left^.Right :=  t;
        place^.Left := t
      ELSE
        DEALLOCATE(t^.Info,t^.Mem);
        DISPOSE(t);
        DEC(len)
      END
    END
  END InsertLeft;

  PROCEDURE UpdateList(VAR l : List;place : NodePointer; x : ARRAY OF BYTE);
  BEGIN
    WITH l^ DO
      IF (First # NIL) & (place # NIL) THEN
        MoveFwd(ADR(x),place^.Info,place^.Mem)
      END
    END
  END UpdateList;

  PROCEDURE DeleteList(VAR l : List;VAR place : NodePointer);
  VAR
    t : NodePointer;
  BEGIN
    WITH l^ DO
      IF First # NIL THEN
        IF place = First THEN
          t := First;
          First := First^.Right;
          place := First;
          IF First # NIL THEN First^.Left := NIL END
        ELSIF place = Last THEN
          t := Last;
          Last := Last^.Left;
          place := NIL;
          Last^.Right := NIL
        ELSIF place # NIL THEN
          t := place;
          place := place^.Right;
          t^.Right^.Left := t^.Left;
          t^.Left^.Right := t^.Right
        ELSE
          t := NIL
        END;
        IF t # NIL THEN
          DEALLOCATE(t^.Info,t^.Mem);
          DISPOSE(t);
          DEC(len)
        END
      END
    END
  END DeleteList;

  PROCEDURE Retrieve(VAR l : List;place : NodePointer; VAR x : ARRAY OF BYTE);
  BEGIN
    WITH l^ DO
      IF (First # NIL) & (place # NIL) THEN
        MoveFwd(place^.Info,ADR(x),place^.Mem)
      END
    END
  END Retrieve;

  PROCEDURE Next(place : NodePointer):NodePointer;
  BEGIN
    IF place # NIL THEN
      RETURN place^.Right
    ELSE
      RETURN NIL
    END
  END Next;

  PROCEDURE Previous(place : NodePointer):NodePointer;
  BEGIN
    IF place # NIL THEN
      RETURN place^.Left
    ELSE
      RETURN NIL
    END
  END Previous;

  PROCEDURE EndList(place : NodePointer):BOOLEAN;
  BEGIN
    RETURN place = NIL
  END EndList;

  PROCEDURE ClearList(VAR l : List);
  VAR
    trace : NodePointer;
  BEGIN
    trace := First(l);
    WHILE NOT EndList(trace) DO
      DeleteList(l,trace)
    END
  END ClearList;

  PROCEDURE DestroyList(VAR l : List);
  BEGIN
    ClearList(l);
    DISPOSE(l^.Start);
    DISPOSE(l)
   END DestroyList;

  PROCEDURE ResetList(VAR l : List);
  BEGIN
    WITH l^ DO
      Start^.Right := First;
      Start^.Left := Last;
      Curr := Start;
    END (* with *)
  END ResetList;

  PROCEDURE NextList(VAR l : List;VAR data : ARRAY OF BYTE) : BOOLEAN;
  BEGIN
    WITH l^ DO
      Curr := Next(Curr);
      IF ~ EndList(Curr) THEN
        Retrieve(l,Curr,data);
        RETURN TRUE
      ELSE
        RETURN FALSE
      END (* if *);
    END (* with *);
  END NextList;

END Lists.

MODULE Example;

(* using ResetList and NextList *);

VAR
    n : CARDINAL;
    l : List;

BEGIN

   -
   -
   -

  ResetList(l);
  WHILE NextList(l,n) DO  (* this is beautiful! *)
    WrCard(n,0);
    WrLn
  END (* while *);
END Example.


Instituto Tecnologico y de Estudios Superiores de Monterrey, Campus San Luis
ROberto DOminguez GUtierrez.