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]; 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 }; 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. ²ListImpl.mesa "List" routines: facilities for creating objects which carry an indication of their type along with them, especially typed lists. Edited by Teitelman on October 29, 1982 5:53 pm Edited by Paul Rovner on May 13, 1983 10:21 am Types Predicates: Eq, IsAList, IsAListOfRefAny, EqLists, Member constructors of lists: Append, Reverse, Remove, Union, Intersection, ListDifference, LDiff all elements in l1 not in l2 tailOfx must be a tail of x, i.e. eq to some number of cdrs of x, or else an error is raised. Returns a x of those elements in x up to tailOfx. If tailOfx is NIL, returns x. Otherwise, always returns new structure like some constructors, but destructive to structure: Nconc, DReverse, DRemove, DSubst. destructivell2 reverses list. copied from Lisp DREVERSE function extractors: NthTail NthElement AssocList operations: DotCons Assoc PutAssoc key not found on x miscellaneous: Length Map Subst Sorting: The sort is destructive and NOT stable, that is, the relative positions in the result of nodes with equal keys is unpredictible. For a nondestructive sort, copy l first. The sort does one CONS. lists[0] is a sorted list of length 2 or NIL, lists[1] is a sorted list of length 4 or NIL, lists[2] is a sorted list of length 8 or NIL, etc. When Sort returns, lists = ALL [NIL] again (we do some extra work to assure this). make each pair of consecutive elements of l into a sorted list of length 2, then merge it into lists. xMax now contains the largest x such that lists[x] # NIL. if l's length was even, a = NIL; if l's length was odd, a = single element list. merge a and elements of lists into result (held in a). try to make a # NIL. a # NIL OR x > xMax. a#NIL AND b#NIL Κψ– "Cedar" style˜J˜J™ JšΟc‚™‚Jš0™0Jšœ™/J˜J˜šΟk ˜ Jšœžœ ˜JšœžœR˜\Jšœ žœ ˜Jšœžœžœ ˜J˜—J˜JšΠlnœžœž˜J˜Jšžœ˜J˜Jšžœ ˜J˜Jšžœžœ˜head™JšΠknœžœžœ˜J˜JšΟnœžœžœžœžœžœžœžœžœžœžœžœžœ˜\—šœ Ρnpr-™9Jš‘œžœžœžœžœžœžœžœ ˜Dš‘œžœž œ žœžœžœžœžœžœž˜IJšžœ žœžœžœ˜Jšžœžœžœžœžœžœžœ˜+šžœžœž˜Jš žœžœžœžœžœ˜Jš žœžœžœžœžœžœ˜7J˜ J˜ Jšžœ˜—Jšžœžœ˜Jšžœ ˜—J˜—šœΠprC™ZJ˜š"‘œžœž œžœžœžœžœžœžœžœžœžœžœžœžœžœžœ˜kJš œžœžœžœžœžœ˜J˜ Jšžœžœžœžœ˜J˜J˜šžœžœž˜J˜ J˜ Jšžœ˜—Jšžœ˜ Jšœ ˜—J˜š‘œžœž œžœžœžœžœžœžœžœžœžœ˜SJšœžœ˜ šžœžœž˜J˜J˜Jšžœ˜—Jšžœ˜ Jšœ ˜—J˜š‘œžœž œžœžœžœžœžœžœžœžœžœžœžœ˜aJš œžœžœžœžœžœ˜Jšœžœ˜ šžœžœž˜šžœž˜Jš œžœžœžœžœ ˜9Jšžœ2˜6——J˜Jšžœ˜ Jšœ˜—J˜š‘œžœž œ žœžœžœžœžœžœžœžœžœ˜NJš œžœžœžœžœ˜šžœžœž˜Jšžœžœ˜1J˜ Jšžœ˜—Jšžœ˜ Jšœ ˜—J˜š‘ œžœž œ žœžœžœžœžœžœžœžœžœ˜UJš œžœžœžœžœžœ˜šžœžœž˜Jšžœžœ˜1J˜ Jšžœ˜—Jšžœ˜ Jšœ˜—J˜š‘œžœž œ žœžœžœžœžœžœžœžœžœ˜WJšœ™Jš œžœžœžœžœžœ˜Jšžœžœžœžœ˜šžœžœž˜Jšžœžœ˜4J˜ Jšžœ˜—Jšžœ˜ Jšœ˜—J˜š‘œžœž œžœžœžœžœžœžœžœžœžœ˜XJšœΥ™ΥJš œ žœžœžœžœžœ˜!Jšžœžœžœžœ˜&šžœžœž˜Jšžœžœžœ˜$šžœ žœžœžœ˜