Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/549a.lha/M2P_v1.0/mods.lzh/SymLists.mod

Modula Implementation | 1991-08-11 | 13.4 KB | 364 lines

(*======================================================================*)
(*       Programming Support Routines - Managing Lists of Symbols       *)
(*======================================================================*)
(*  Version:  2.00              Author:   Dennis Brueni                 *)
(*  Date:     1-20-91           Changes:  original                      *)
(*  Date:     1-25-91           Changes:  Duplicate Handling            *)
(*  Date:     1-25-91           Changes:  .Symbol field became pointer  *)
(*  Date:     1-26-91           Changes:  CaseSensitive Bug fixed       *)
(*  Date:     3-07-91           Changes:  Duplicate Handling removed    *)
(*                                        Traversal routines added      *)
(*                                        Merge/Sort routines added     *)
(*                                        No case-sensitivity           *)
(*  Date:     3-09-91           Changes:  Now uses FStorage (freelists) *)
(*======================================================================*)
(*  SymLists contains all the routines necessary to use, maintain, and  *)
(*  destroy a linked list of symbols.  It uses a MRU (Most Recently     *)
(*  Used) logic (relying on the principle of locality of reference) to  *)
(*  insure that the symbols most likely to be accessed next will appear *)
(*  at the beginning of the list.  This means that symbols are always   *)
(*  added to the front of a list, and whenever a search is performed,   *)
(*  the symbol found is moved to the front of the list.                 *)
(*======================================================================*)
(*  The SymList structure is itself recursively defined as follows:     *)
(*                                                                      *)
(*     A SymList is either NIL or a pair (Symbol,Next) where Next is    *)
(*     another symbol list.                                             *)
(*======================================================================*)
(*  Often one will want to aggregate additional information with a      *)
(*  symbol, so to make this table as general as possible, the symbol    *)
(*  must be sent as a pointer to record of the following form when      *)
(*  performing insertions.  (note: m should be less than 512)           *)
(*                                                                      *)
(*       symbolrec = RECORD OF                                          *)
(*                      Symbol:  POINTER TO ARRAY [0..m] OF CHAR;       *)
(*                      |                                               *)
(*                   END;                                               *)
(*                                                                      *)
(*======================================================================*)

IMPLEMENTATION MODULE SymLists;

IMPORT
    SYSTEM,FStorage,Strings;





(*----------------------------------------------------------------------*)
(*  Type definitions of a symbol and a Linked List.                     *)
(*----------------------------------------------------------------------*)

TYPE
    SymEntryPtr = POINTER TO SymbolEntry;
    SymbolEntry = RECORD
        Symbol: SymbolPtr;
    END;

    SymList = POINTER TO SymRec;
    SymRec = RECORD
        Next: SymList;
        Symbol: SymEntryPtr;
    END;

CONST
    SymRecSize = SYSTEM.TSIZE(SymRec);


(*----------------------------------------------------------------------*)
(*  CREATE      Create an initialized linked list.                      *)
(*                                                                      *)
(*  PARAMETERS  SL - the SymList pointer to initialize.                 *)
(*----------------------------------------------------------------------*)

PROCEDURE Create(VAR SL: SymList);
BEGIN
    SL := NIL;
END Create;

(*----------------------------------------------------------------------*)
(*  DESTROY     Destruct a linked list.  All information on the list    *)
(*              at time of invocation will be unlinked from the list,   *)
(*              possibly lost...                                        *)
(*                                                                      *)
(*  PARAMETER   SL -- The SymList to clear out                          *)
(*----------------------------------------------------------------------*)

PROCEDURE Destroy(VAR SL: SymList);

VAR
    Temp: SymList;
BEGIN
    WHILE SL # NIL DO
        Temp:=SL;
        SL:=SL^.Next;
        FStorage.DEALLOCATE(Temp,SymRecSize);
    END;
END Destroy;

(*----------------------------------------------------------------------*)
(*  INSERT      Add a symbol to the front of the linked list.  Please   *)
(*              see the documentation above for the correct format of   *)
(*              of the Symbol Entry                                     *)
(*                                                                      *)
(*  PARAMETERS  SL     -- the linked list                               *)
(*              Symbol -- the symbol                                    *)
(*----------------------------------------------------------------------*)

PROCEDURE Insert(VAR SL: SymList ; Symbol: SYSTEM.ADDRESS);

VAR
    Temp: SymList;
BEGIN
    FStorage.ALLOCATE(Temp,SymRecSize);
    Temp^.Next:=SL;
    Temp^.Symbol:=Symbol;
    SL:=Temp;
END Insert;

(*----------------------------------------------------------------------*)
(*  DELETE      Remove a symbol from the linked list.  If the symbol    *)
(*              was not present this has no effect.                     *)
(*                                                                      *)
(*  PARAMETERS  SL     -- the linked list                               *)
(*              Symbol -- the symbol                                    *)
(*----------------------------------------------------------------------*)



PROCEDURE Delete(VAR SL: SymList; Symbol: ARRAY OF CHAR);

VAR
    Temp: SymList;
BEGIN
    IF Search(SL,Symbol) # NIL THEN
        Temp:=SL;               (* Recall that search always    *)
        SL:=Temp^.Next;         (* moves the symbol to the      *)
        FStorage.DEALLOCATE(Temp,SymRecSize);
                    (* front of the list if found*)
    END;
END Delete;

(*----------------------------------------------------------------------*)
(*  SEARCH      Find a symbol in the linked list and return a pointer   *)
(*              to the record which it is found in.  It will also move  *)
(*              the symbol to the front of the list.                    *)
(*                                                                      *)
(*  PARAMETERS  SL     -- the linked list                               *)
(*              Symbol -- the symbol                                    *)
(*----------------------------------------------------------------------*)



PROCEDURE Search(VAR SL: SymList; Symbol: ARRAY OF CHAR): SYSTEM.ADDRESS;

VAR
    Leader: SymList;
    Shadow: SymList;
BEGIN
    IF SL # NIL THEN
        Leader:=SL;
        Shadow:=Leader;
        WHILE Leader # NIL DO
            IF Strings.Equal(Symbol,Leader^.Symbol^.Symbol^) THEN
                IF Leader # SL THEN
                    Shadow^.Next:=Leader^.Next;
                    Leader^.Next:=SL;
                    SL:=Leader;
                END;
                RETURN Leader^.Symbol;
            ELSE
                Shadow:=Leader;
                Leader:=Leader^.Next;
            END;
        END;
    END;
    RETURN NIL;
END Search;

(*----------------------------------------------------------------------*)
(*  EMPTY       Tells whether a SymLists is empty OR NOT                *)
(*                                                                      *)
(*  PARAMETERS  SL -- The symbol list to look at                        *)
(*                                                                      *)
(*  RETURNS     TRUE if SL is NIL                                       *)
(*----------------------------------------------------------------------*)

PROCEDURE Empty(SL: SymList):BOOLEAN;
BEGIN
    RETURN SL = NIL;
END Empty;

(*----------------------------------------------------------------------*)
(*  FIRST       Returns the first symbol on a SymList.                  *)
(*                                                                      *)
(*  PARAMETERS  SL -- The symbol list to look at                        *)
(*                                                                      *)
(*  RETURNS     NIL if the SymList is empty, otherwise the first symbol *)
(*----------------------------------------------------------------------*)

PROCEDURE First(SL: SymList):SYSTEM.ADDRESS;
BEGIN
    IF SL # NIL THEN
        RETURN SL^.Symbol;
    END;
END First;

(*----------------------------------------------------------------------*)
(*  NEXT        SymLists are recursively defined, so each SymList is    *)
(*              actually a (symbol,SymList) pair.  This procedure is    *)
(*              used to access the SymList part of that pair.           *)
(*                                                                      *)
(*  PARAMETERS  SL   -- The SymList                                     *)
(*                                                                      *)
(*  RETURNS     The next SymList, NIL if none.                          *)
(*----------------------------------------------------------------------*)

PROCEDURE Next(SL: SymList):SymList;
BEGIN
    IF SL # NIL THEN
        RETURN SL^.Next;
    END;
END Next;

(*----------------------------------------------------------------------*)
(*  ConCat      Appends two SymLists together and returns as a new      *)
(*              symlist.                                                *)
(*                                                                      *)
(*  PARAMETERS  SL1 -- the first SymList                                *)
(*              SL2 -- the second SymList                               *)
(*                                                                      *)
(*  RETURNS     A copy of SL1 appended to SL2                           *)
(*----------------------------------------------------------------------*)

PROCEDURE ConCat(SL1,SL2: SymList):SymList;

VAR
    SL: SymList;
    NX: POINTER TO SymList;
BEGIN
    Create(SL);
    NX:=SYSTEM.ADR(SL);
    WHILE SL1 # NIL DO
        FStorage.ALLOCATE(NX^,SymRecSize);
        NX^^.Next:=NIL;
        NX^^.Symbol:=SL1^.Symbol;
        NX:=SYSTEM.ADR(NX^^.Next);
        SL1:=SL1^.Next;
    END;
    WHILE SL2 # NIL DO
        FStorage.ALLOCATE(NX^,SymRecSize);
        NX^^.Next:=NIL;
        NX^^.Symbol:=SL2^.Symbol;
        SL2:=SL2^.Next;
        NX:=SYSTEM.ADR(NX^^.Next) END;
    RETURN SL;
END ConCat;

(*----------------------------------------------------------------------*)
(*  MERGE       Merges two sorted SymLists into one sorted SymList.  If *)
(*              the two input lists are not presorted, it will not      *)
(*              return a well sorted list.                              *)
(*                                                                      *)
(*  PARAMETERS  SL1 -- the first sorted SymList                         *)
(*              SL2 -- the second sorted SymList                        *)
(*                                                                      *)
(*  RETURNS     A merged SymList                                        *)
(*----------------------------------------------------------------------*)

PROCEDURE Merge(SL1,SL2: SymList):SymList;

VAR
    SL: SymList;
    NX: POINTER TO SymList;

BEGIN
    Create(SL);
    NX:=SYSTEM.ADR(SL);
    LOOP
        IF (SL1 = NIL) OR (SL2 = NIL) THEN
            NX^:=ConCat(SL1,SL2);
            RETURN SL;
        END;
        FStorage.ALLOCATE(NX^,SymRecSize);
        NX^^.Next:=NIL;
        IF Strings.Compare(SL1^.Symbol^.Symbol^, SL2^.Symbol^.Symbol^) = Strings.less THEN
            NX^^.Symbol:=SL1^.Symbol;
            SL1:=SL1^.Next;
        ELSE
            NX^^.Symbol:=SL2^.Symbol;
            SL2:=SL2^.Next;
        END;
        NX:=SYSTEM.ADR(NX^^.Next);
    END;
END Merge;

(*----------------------------------------------------------------------*)
(*  SORT        Performs mergesort upon a symlist, placing it in        *)
(*              lexicographic order.                                    *)
(*                                                                      *)
(*  PARAMETERS  SL -- the SymList to sort.                              *)
(*----------------------------------------------------------------------*)

PROCEDURE Sort(VAR SL: SymList);

VAR
    SL1,SL2: SymList;

BEGIN
    IF (SL # NIL) AND (SL^.Next # NIL) THEN
                    (* 2 or more nodes      *)
        SL1:=SL;
        SL2:=SL;
        LOOP
            SL2:=SL2^.Next; (* Split the list in    *)
            IF SL2=NIL THEN
                EXIT;
            END;            (* half by traversing   *)
            SL2:=SL2^.Next; (* with two pointers,   *)
            IF SL2=NIL THEN
                EXIT;
            END;            (* one at full speed,   *)
            SL1:=SL1^.Next; (* and one at half speed*)
        END;
        SL2:=SL1^.Next;         (* SL2 is second half   *)
        SL1^.Next:=NIL;         (* SL1 is first half    *)
        SL1:=SL;
        Sort(SL1);              (* Sort both halves     *)
        Sort(SL2);
        SL:=Merge(SL1,SL2);     (* Merge 'em together   *)
        Destroy(SL1);           (* destroy the orginals *)
        Destroy(SL2);
    END;
END Sort;

(*----------------------------------------------------------------------*)
(*  REVERSE     Reverses a symlist.                                     *)
(*                                                                      *)
(*  PARAMETERS  SL -- the SymList to reverse.                           *)
(*----------------------------------------------------------------------*)

PROCEDURE Reverse(VAR SL: SymList);

VAR
    temp: SymList;
    trav: SymList;
BEGIN
    trav:=SL;
    SL:=NIL;
    WHILE trav # NIL DO
        temp:=trav;
        trav:=trav^.Next;
        temp^.Next:=SL;
        SL:=temp;
    END;
END Reverse;

(************************************************************************)
(*  MAIN inititalization code                                           *)
(************************************************************************)

BEGIN
END SymLists.