<> <<"List" routines: facilities for creating objects which carry an indication of their type along with them, especially typed lists. >> <> <> DIRECTORY Atom USING [GetPName], List USING [AList, DottedPair, DottedPairNode, Comparison, CompareProc, Cons, Memb, Nconc1], PrincOps USING [zDCOMP], Rope USING [ROPE, Compare] ; ListImpl: CEDAR PROGRAM IMPORTS Atom, List, Rope EXPORTS List = BEGIN OPEN List; <> ROPE: TYPE = Rope.ROPE; NotATail: PUBLIC SIGNAL [list, tailOfList: LIST OF REF ANY] RETURNS[LIST OF REF ANY] = CODE; <> Eq: PROC [x, y: REF ANY] RETURNS[BOOLEAN] = INLINE {RETURN[x = y]}; EqLists: PUBLIC PROCEDURE [l1, l2: LIST OF REF ANY] RETURNS [BOOLEAN] = { IF l1 = l2 THEN RETURN[TRUE]; IF l1 = NIL OR l2 = NIL THEN RETURN[FALSE]; UNTIL l1 = NIL DO IF l2 = NIL THEN RETURN[FALSE]; IF Eq[l1.first, l2.first] THEN NULL ELSE RETURN[FALSE]; l1 _ l1.rest; l2 _ l2.rest; ENDLOOP; RETURN[l2 = NIL]; }; -- of EqLists <> Append: PUBLIC PROCEDURE [l1: LIST OF REF ANY, l2: LIST OF REF ANY _ NIL] RETURNS[val: LIST OF REF ANY] = { z: LIST OF REF ANY _ NIL; val _ l2; IF l1 = NIL THEN RETURN[val]; val _ Cons[l1.first, val]; z _ val; UNTIL (l1 _ l1.rest) = NIL DO z.rest _ Cons[l1.first, z.rest]; z _ z.rest; ENDLOOP; RETURN[val]; }; -- of Append Reverse: PUBLIC PROCEDURE [list: LIST OF REF ANY] RETURNS[val: LIST OF REF ANY] = { val _ NIL; UNTIL list = NIL DO val _ Cons[list.first, val]; list _ list.rest; ENDLOOP; RETURN[val]; }; -- of Reverse Remove: PUBLIC PROCEDURE [ref: REF ANY, list: LIST OF REF ANY] RETURNS[val: LIST OF REF ANY] = { z: LIST OF REF ANY _ NIL; val _ NIL; UNTIL list = NIL DO IF ~Eq[list.first, ref] THEN {IF val = NIL THEN {val _ Cons[list.first, NIL]; z _ val} ELSE {z.rest _ Cons[list.first, z.rest]; z _ z.rest}}; list _ list.rest; ENDLOOP; }; -- of Remove Union: PUBLIC PROCEDURE [l1, l2: LIST OF REF ANY] RETURNS[LIST OF REF ANY] = { l: LIST OF REF ANY _ l2; UNTIL l1 = NIL DO IF ~Memb[l1.first, l] THEN l _ Cons[l1.first, l]; l1 _ l1.rest; ENDLOOP; RETURN[l]; }; -- of Union Intersection: PUBLIC PROCEDURE [l1, l2: LIST OF REF ANY] RETURNS[LIST OF REF ANY] = { l: LIST OF REF ANY _ NIL; UNTIL l1 = NIL DO IF Memb[l1.first, l2] THEN l _ Cons[l1.first, l]; l1 _ l1.rest; ENDLOOP; RETURN[l]; }; -- of Intersection ListDifference: PUBLIC PROCEDURE [l1, l2: LIST OF REF ANY] RETURNS[LIST OF REF ANY] = { <> l: LIST OF REF ANY _ NIL; IF l2 = NIL THEN RETURN[l1]; UNTIL l1 = NIL DO IF ~Memb[l1.first, l2] THEN l _ Nconc1[l, l1.first]; l1 _ l1.rest; ENDLOOP; RETURN[l]; }; -- of ListDifference LDiff: PUBLIC PROCEDURE [list, tailOfList: LIST OF REF ANY] RETURNS[LIST OF REF ANY] = { <> endOfL, l: LIST OF REF ANY _ NIL; IF tailOfList = NIL THEN RETURN[list]; UNTIL list = NIL DO IF list = tailOfList THEN RETURN[l]; IF endOfL = NIL THEN {l _ Cons[list.first, NIL]; endOfL _ l} ELSE {endOfL.rest _ Cons[list.first, NIL]; endOfL _ endOfL.rest}; list _ list.rest; ENDLOOP; RETURN[SIGNAL NotATail[list, tailOfList]]; }; -- of LDiff <> Nconc: PUBLIC PROCEDURE [l1, l2: LIST OF REF ANY] RETURNS[LIST OF REF ANY] = { z: LIST OF REF ANY _ l1; IF z = NIL THEN RETURN[l2]; UNTIL z.rest = NIL DO z _ z.rest; ENDLOOP; z.rest _ l2; RETURN[l1]; }; -- of Nconc DReverse: PUBLIC PROCEDURE [list: LIST OF REF ANY] RETURNS[LIST OF REF ANY] = { <> l1, l2, l3: LIST OF REF ANY _ NIL; IF list = NIL THEN RETURN[NIL]; l3 _ list; UNTIL (l1 _ l3) = NIL DO l3 _ l3.rest; l1.rest _ l2; l2 _ l1; ENDLOOP; RETURN[l2]; }; -- of Dreverse DRemove: PUBLIC PROCEDURE [ref: REF ANY, list: LIST OF REF ANY] RETURNS[LIST OF REF ANY] = { l, l1: LIST OF REF ANY _ NIL; l _ list; UNTIL l = NIL DO IF Eq[l.first, ref] THEN { IF l1 = NIL THEN RETURN[l.rest]; -- ref was first object on list l1.rest _ l.rest; RETURN[list]; }; l1 _ l; l _ l.rest; ENDLOOP; RETURN [list]; }; -- of Dremove; DSubst: PUBLIC PROC [new, old: REF ANY, expr: LIST OF REF ANY] RETURNS[LIST OF REF ANY] = { IF expr = NIL THEN RETURN[NIL]; FOR l: LIST OF REF ANY _ expr, l.rest UNTIL l = NIL DO IF Eq[l.first, old] THEN l.first _ new; WITH l.first SELECT FROM z: LIST OF REF ANY => l.first _ DSubst[new,old,z]; ENDCASE; ENDLOOP; RETURN[expr]; }; -- of DSubst <> <<>> NthTail: PUBLIC PROCEDURE[list: LIST OF REF ANY, n: INT] RETURNS[LIST OF REF ANY] = { IF n=0 THEN RETURN[list]; IF list = NIL THEN RETURN[NIL]; IF n > 0 THEN THROUGH [0..n) DO list _ list.rest; IF list = NIL THEN RETURN[NIL]; REPEAT FINISHED => RETURN[list]; ENDLOOP ELSE {lead: LIST OF REF ANY _ NthTail[list, -n]; UNTIL lead = NIL DO lead _ lead.rest; list _ list.rest; ENDLOOP; RETURN[list]; }; }; -- of NthTail NthElement: PUBLIC PROCEDURE[list: LIST OF REF ANY, n: INT] RETURNS[REF ANY] = { tail: LIST OF REF ANY; IF n=0 THEN ERROR; IF n > 0 THEN {tail _ NthTail[list, n-1]; IF tail = NIL THEN ERROR; RETURN[tail.first]; } ELSE tail _ NthTail[list, n]; IF tail = NIL THEN ERROR; RETURN[tail.first]; }; -- of NthElement <> DotCons: PUBLIC PROCEDURE [key, val: REF ANY] RETURNS [DottedPair] = { RETURN[NEW[DottedPairNode _ [key, val]]]; }; -- of DotCons Assoc: PUBLIC PROCEDURE [key: REF ANY, aList: AList] RETURNS[REF ANY] = { UNTIL aList = NIL DO IF Eq[aList.first.key , key] THEN RETURN[aList.first.val]; aList _ aList.rest; ENDLOOP; RETURN[NIL]; }; -- of Assoc PutAssoc: PUBLIC PROCEDURE [key: REF ANY, val: REF ANY, aList: AList] RETURNS[AList] = { x, x1: AList _ NIL; x _ aList; UNTIL x = NIL DO IF Eq[x.first.key, key] THEN BEGIN x.first.val _ val; RETURN[aList]; END; x1_x; x _ x.rest; ENDLOOP; <> x _ CONS[DotCons[key, val], NIL]; IF x1 = NIL THEN RETURN[x] ELSE IF x1.rest = NIL THEN x1.rest _ x -- add at end ELSE ERROR ; -- defensive programming RETURN[aList]; }; -- of PutAssoc <> Length: PUBLIC PROCEDURE [list: LIST OF REF ANY] RETURNS[INT] = { n: INT _ 0; UNTIL list = NIL DO n _ n+1; list _ list.rest; ENDLOOP; RETURN[n]; }; -- of Length Map: PUBLIC PROC [list: LIST OF REF ANY, proc: PROCEDURE[REF ANY, LIST OF REF ANY] ] = { FOR l: LIST OF REF ANY _ list, l.rest UNTIL l = NIL DO proc[l.first, l]; ENDLOOP; }; -- of Map Subst: PUBLIC PROC [new, old: REF ANY, expr: LIST OF REF ANY] RETURNS[LIST OF REF ANY] = { IF expr = NIL THEN RETURN[NIL] ELSE RETURN[Cons [ IF Eq[old, expr.first] THEN new ELSE WITH expr.first SELECT FROM l: LIST OF REF ANY => Subst[new, old, l], ENDCASE => expr.first, -- should copy IF expr.rest = NIL THEN NIL ELSE Subst[new, old, expr.rest] ] ]; }; -- of Subst <> Sort: PUBLIC PROC [list: LIST OF REF ANY, compareProc: CompareProc] RETURNS [LIST OF REF ANY] = { <> <> <> a, b, mergeTo: LIST OF REF ANY; mergeToCons: LIST OF REF ANY = CONS[NIL, NIL]; max: CARDINAL = 22; --number of bits in word-address space minus 2 lists: ARRAY [0..max) OF LIST OF REF ANY _ ALL [NIL]; <> <<4 or NIL, lists[2] is a sorted list of length 8 or NIL, etc.>> <> x: CARDINAL; --[0..max] xMax: CARDINAL _ 0; --[0..max) <> <> UNTIL (a _ list) = NIL OR (b _ a.rest) = NIL DO list _ b.rest; IF compareProc[a.first, b.first] = less THEN { a.rest _ b; b.rest _ NIL; } ELSE { b.rest _ a; a.rest _ NIL; a _ b; }; x _ 0; DO IF (b _ lists[x]) = NIL THEN { lists[x] _ a; EXIT } ELSE { --merge (equal length) lists a and b lists[x] _ NIL; mergeTo _ mergeToCons; DO --assert a#NIL, b#NIL IF compareProc[a.first, b.first] = less THEN { mergeTo.rest _ a; mergeTo _ a; IF (a _ a.rest) = NIL THEN { mergeTo.rest _ b; EXIT } } ELSE { mergeTo.rest _ b; mergeTo _ b; IF (b _ b.rest) = NIL THEN { mergeTo.rest _ a; EXIT } } ENDLOOP; a _ mergeToCons.rest; x _ x+1; IF x > xMax AND (xMax _ x) = max THEN ERROR } ENDLOOP; ENDLOOP; <> <> <> x _ 0; IF a = NIL THEN { <> UNTIL (lists[x] # NIL OR x = xMax) DO x _ x+1 ENDLOOP; a _ lists[x]; lists[x] _ NIL; x _ x+1 }; < xMax.>> UNTIL x > xMax DO IF (b _ lists[x]) # NIL THEN { lists[x] _ NIL; mergeTo _ mergeToCons; DO <> IF compareProc[a.first, b.first] = less THEN { mergeTo.rest _ a; mergeTo _ a; IF (a _ a.rest) = NIL THEN { mergeTo.rest _ b; EXIT } } ELSE { mergeTo.rest _ b; mergeTo _ b; IF (b _ b.rest) = NIL THEN { mergeTo.rest _ a; EXIT } } ENDLOOP; a _ mergeToCons.rest }; x _ x+1; ENDLOOP; RETURN [a] }; --Sort UniqueSort: PUBLIC PROC [list: LIST OF REF ANY, compareProc: CompareProc] RETURNS[LIST OF REF ANY] = { l: LIST OF REF ANY; IF list = NIL THEN RETURN[NIL]; l _ list _ Sort[list, compareProc]; DO IF l.rest = NIL THEN EXIT; IF compareProc[l.first, l.rest.first] = equal THEN l.rest _ l.rest.rest ELSE l _ l.rest; ENDLOOP; RETURN[list]; }; Compare: PUBLIC CompareProc = { IF ref1 = NIL THEN RETURN[Rope.Compare[s1: NARROW[ref1, ROPE], s2: NARROW[ref2, ROPE], case: TRUE]]; WITH ref1 SELECT FROM rope: ROPE => RETURN[Rope.Compare[s1: rope, s2: NARROW[ref2, ROPE], case: TRUE]]; rli: REF INT => RETURN[CompareINT[rli^, NARROW[ref2, REF INT]^]]; atom: ATOM => RETURN[Rope.Compare[s1: Atom.GetPName[atom], s2: Atom.GetPName[NARROW[ref2, ATOM]], case: TRUE]]; ENDCASE => ERROR }; CompareINT: PROC [int1, int2: INT] RETURNS [Comparison] = TRUSTED MACHINE CODE { PrincOps.zDCOMP }; END.