home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
549a.lha
/
M2P_v1.0
/
mods.lzh
/
SymLists.mod
< prev
next >
Wrap
Text File
|
1991-08-10
|
14KB
|
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.
