DIRECTORY Atom USING [GetPName], Basics USING [CompareINT], List USING [AList, DottedPair, DottedPairNode, Comparison, CompareProc, LORA], Rope USING [ROPE, Compare]; ListImpl: CEDAR PROGRAM IMPORTS Atom, Basics, Rope EXPORTS List = BEGIN OPEN List, Rope; NotATail: PUBLIC SIGNAL [list, tailOfList: LORA] RETURNS[LORA] = CODE; Eq: PROC [x, y: REF ANY] RETURNS[BOOL] = INLINE {RETURN[x = y]}; EqLists: PUBLIC PROC [l1, l2: LORA] RETURNS [BOOL] = { 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]; }; Memb: PUBLIC PROC [ref: REF ANY, list: LORA] RETURNS [BOOL] = { UNTIL list = NIL DO IF list.first = ref THEN RETURN[TRUE]; list _ list.rest; ENDLOOP; RETURN[FALSE]; }; Append: PUBLIC PROC [l1: LORA, l2: LORA _ NIL] RETURNS[val: LORA] = { z: LORA _ 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 PROC [list: LORA] RETURNS[val: LORA] = { val _ NIL; UNTIL list = NIL DO val _ CONS[list.first, val]; list _ list.rest; ENDLOOP; RETURN[val]; }; -- of Reverse Remove: PUBLIC PROC [ref: REF ANY, list: LORA] RETURNS[val: LORA] = { z: LORA _ 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 PROC [l1, l2: LORA] RETURNS[LORA] = { l: LORA _ 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 PROC [l1, l2: LORA] RETURNS[LORA] = { l: LORA _ 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 PROC [l1, l2: LORA] RETURNS[LORA] = { l: LORA _ 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 PROC [list, tailOfList: LORA] RETURNS[LORA] = { endOfL, l: LORA _ 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]]; }; Nconc: PUBLIC PROC [l1, l2: LORA] RETURNS[LORA] = { z: LORA _ l1; IF z = NIL THEN RETURN[l2]; UNTIL z.rest = NIL DO z _ z.rest; ENDLOOP; z.rest _ l2; RETURN[l1]; }; Nconc1: PUBLIC PROC [list: LORA, ref: REF ANY] RETURNS[LORA] = { z: LORA _ list; new: LORA = LIST[ref]; IF z = NIL THEN RETURN[new]; UNTIL z.rest = NIL DO z _ z.rest; ENDLOOP; z.rest _ new; RETURN[list]; }; DReverse: PUBLIC PROC [list: LORA] RETURNS[LORA] = { l1, l2, l3: LORA _ 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 PROC [ref: REF ANY, list: LORA] RETURNS[LORA] = { l, l1: LORA _ 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: LORA] RETURNS[LORA] = { IF expr = NIL THEN RETURN[NIL]; FOR l: LORA _ expr, l.rest UNTIL l = NIL DO IF Eq[l.first, old] THEN l.first _ new; WITH l.first SELECT FROM z: LORA => l.first _ DSubst[new,old,z]; ENDCASE; ENDLOOP; RETURN[expr]; }; -- of DSubst NthTail: PUBLIC PROC[list: LORA, n: INT] RETURNS[LORA] = { 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: LORA _ NthTail[list, -n]; UNTIL lead = NIL DO lead _ lead.rest; list _ list.rest; ENDLOOP; RETURN[list]; }; }; -- of NthTail NthElement: PUBLIC PROC[list: LORA, n: INT] RETURNS[REF ANY] = { tail: LORA; 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 PROC [key, val: REF ANY] RETURNS [DottedPair] = { RETURN[NEW[DottedPairNode _ [key, val]]]; }; Assoc: PUBLIC PROC [key: REF ANY, aList: AList] RETURNS[REF ANY _ NIL] = { UNTIL aList = NIL DO IF aList.first.key = key THEN RETURN[aList.first.val]; aList _ aList.rest; ENDLOOP; }; PutAssoc: PUBLIC PROC [key: REF ANY, val: REF ANY, aList: AList] RETURNS[AList] = { lag: AList _ NIL; new: AList _ NIL; FOR each: AList _ aList, each.rest WHILE each # NIL DO IF each.first.key = key THEN {each.first.val _ val; RETURN [aList]}; lag _ each; ENDLOOP; new _ LIST[DotCons[key, val]]; IF lag = NIL THEN aList _ new ELSE lag.rest _ new; RETURN [aList]; }; Length: PUBLIC PROC [list: LORA] RETURNS[n: INT _ 0] = { UNTIL list = NIL DO n _ n+1; list _ list.rest; ENDLOOP; }; Map: PUBLIC PROC [list: LORA, proc: PROC[REF ANY, LORA] ] = { WHILE list # NIL DO proc[list.first, list]; list _ list.rest; ENDLOOP; }; Subst: PUBLIC PROC [new, old: REF ANY, expr: LORA] RETURNS[head: LORA _ NIL] = { tail: LORA _ NIL; WHILE expr # NIL DO first: REF _ expr.first; cons: LORA _ LIST[IF first = old THEN new ELSE old]; IF tail = NIL THEN head _ cons ELSE tail.rest _ cons; tail _ cons; expr _ expr.rest; ENDLOOP; }; Kill: PUBLIC PROC [list: LORA] = { WHILE list # NIL DO next: LORA _ list.rest; list.rest _ NIL; list.first _ NIL; list _ next; ENDLOOP; }; Sort: PUBLIC PROC [list: LORA, compareProc: CompareProc] RETURNS [LORA] = { innerSort: PROC [head: LORA, max: NAT] RETURNS [new, next: LORA] = { mid: LORA _ (new _ head).rest; IF mid = NIL THEN RETURN; next _ mid.rest; IF compareProc[new.first, mid.first] = greater THEN { mid.rest _ new; new _ mid; mid _ head; }; mid.rest _ NIL; IF next = NIL THEN RETURN; next _ (mid _ next).rest; IF next # NIL THEN { temp: LORA _ next; next _ temp.rest; temp.rest _ NIL; IF compareProc[mid.first, temp.first] = greater THEN { mid.rest _ NIL; temp.rest _ mid; mid _ temp} }; new _ Merge[new, mid, compareProc]; IF next = NIL THEN RETURN; FOR depth: NAT IN [2..max) DO [mid, next] _ innerSort[next, depth]; new _ Merge[new, mid, compareProc]; IF next = NIL THEN RETURN; ENDLOOP; }; IF list = NIL OR list.rest = NIL THEN RETURN [list]; RETURN [innerSort[list, 32].new]; }; Merge: PUBLIC PROC [x,y: LORA, compareProc: CompareProc] RETURNS [new: LORA] = { tail: LORA _ NIL; IF x = NIL THEN RETURN [y]; IF y = NIL THEN RETURN [x]; new _ x; IF compareProc[x.first, y.first] = greater THEN {new _ y; y _ x; x _ new}; DO DO tail _ x; x _ x.rest; IF x = NIL THEN {tail.rest _ y; RETURN}; IF compareProc[x.first, y.first] = greater THEN EXIT; ENDLOOP; tail.rest _ y; DO tail _ y; y _ y.rest; IF y = NIL THEN {tail.rest _ x; RETURN}; IF compareProc[x.first, y.first] = less THEN EXIT; ENDLOOP; tail.rest _ x; ENDLOOP; }; UniqueSort: PUBLIC PROC [list: LORA, compareProc: CompareProc] RETURNS[LORA] = { lag: LORA _ list _ Sort[list, compareProc]; WHILE lag # NIL DO rest: LORA _ lag.rest; IF rest = NIL THEN EXIT; IF compareProc[lag.first, rest.first] = equal THEN lag.rest _ rest.rest ELSE lag _ rest; ENDLOOP; RETURN[list]; }; Compare: PUBLIC CompareProc = { WITH ref1 SELECT FROM rope: ROPE => RETURN[Rope.Compare[s1: rope, s2: NARROW[ref2], case: TRUE]]; rli: REF INT => RETURN[Basics.CompareINT[rli^, NARROW[ref2, REF INT]^]]; atom: ATOM => RETURN[Rope.Compare[s1: Atom.GetPName[atom], s2: Atom.GetPName[NARROW[ref2]], case: TRUE]]; ENDCASE => IF ref1 = NIL THEN RETURN[Rope.Compare[s1: NARROW[ref1], s2: NARROW[ref2], case: TRUE]] ELSE ERROR; }; END. ¨ListImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Teitelman on October 29, 1982 5:53 pm Rovner on May 13, 1983 10:21 am Russ Atkinson (RRA) June 18, 1985 1:37:19 am PDT Signals: NotATail Predicates: Eq, IsAList, IsAListOfRefAny, EqLists, Member constructors of lists: Append, Reverse, Remove, Union, Intersection, ListDifference, LDiff all elements in l1 not in l2 tailOflist must be a tail of list, i.e. eq to some number of cdrs of list, or else an error is raised. Returns a list of those elements in list up to tailOflist. If tailOflist is NIL, returns list. 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 miscellaneous: Length Map Subst Sorting ... destructively sorts the given list in increasing order according to compareProc. The sort is not stable, so order of equal elements is not preserved. First, grab the first pair of elements off the head of the list and make sure that they are sorted. If there is only one element, we return it immediately. If there are only two elements in the list first sort them, then return them. The first two nodes are in the wrong order, so swap them, leaving new pointing at the lesser of the two, and mid pointing at the greater. Second, grab the second pair of elements off the list. We have already checked, and there is at least one. There are two elements for the second pair, so we need to put them in order. The first two nodes are in the wrong order, so swap them. Third, merge the two lead lists. If this exhausts the original list, then return. Finally, build up the tree by progressively building small lists and merging them into larger lists. The size doubles at each level. We start with new holding onto a list of 4 elements, and next holding onto the remainder of the list. ... destructively merges two lists according to compareProc. If the input lists are sorted in increasing order, then the output list will be sorted in increasing order. Implementation notes: RC assignments are limited by preserving runs of elements in order. Test for empty lists Start from y, which we do by swapping x and y. We first assume that we have just appended from x, but need to advance x to the next element and check for emptiness. Once this is done we try to stay within x as long as the predicate allows. By doing this we reduce the amount of RC assignments of the form "tail.rest _ ...", which speeds things up considerably. We have just appended from y, so append to the list from y as long as reasonable. ΚΡ– "Cedar" style˜code™ Kšœ Οmœ1™Ÿœ˜NKšœŸœŸœ ˜—K˜šΠlnœŸœŸ˜KšŸœ˜KšŸœ ˜KšŸœŸœ ˜K˜—šœ™K˜KšΟnœŸœŸœŸœŸœŸœŸœ˜FK˜—šœ Ρnpr-™9K™Kš‘œŸœŸœŸœŸœŸœŸœŸœ ˜Aš ‘œŸœŸœ ŸœŸœŸœŸ˜6KšŸœ ŸœŸœŸœ˜KšŸœŸœŸœŸœŸœŸœŸœ˜+šŸœŸœŸ˜Kš ŸœŸœŸœŸœŸœ˜Kš ŸœŸœŸœŸœŸœŸœ˜7K˜ K˜ KšŸœ˜—KšŸœŸœ˜KšŸœ˜K˜—š‘œŸœŸœŸœŸœŸœŸœŸœ˜?šŸœŸœŸ˜KšŸœŸœŸœŸœ˜&Kšœ˜KšŸœ˜—KšŸœŸœ˜Kšœ˜K˜——šœΠprC™ZK˜š‘œŸœŸœŸœŸœŸœŸœŸœ˜EKšœŸœŸœ˜K˜ KšŸœŸœŸœŸœ˜KšœŸœ˜K˜šŸœŸœŸ˜Kšœ Ÿœ˜ K˜ KšŸœ˜—KšŸœ˜ Kšœž ˜—K˜š ‘œŸœŸœŸœŸœŸœ˜8KšœŸœ˜ šŸœŸœŸ˜KšœŸœ˜K˜KšŸœ˜—KšŸœ˜ Kšœž ˜—K˜š‘œŸœŸœŸœŸœŸœŸœŸœ˜FKšœŸœŸœ˜KšœŸœ˜ šŸœŸœŸ˜šŸœŸ˜Kš œŸœŸœŸœŸœ Ÿœ ˜9KšŸœ Ÿœ#˜6——K˜KšŸœ˜ Kšœž˜—K˜š ‘œŸœŸœ ŸœŸœŸœ˜3KšœŸœ˜ šŸœŸœŸ˜KšŸœŸœŸœ˜1K˜ KšŸœ˜—KšŸœ˜ Kšœž ˜—K˜š ‘ œŸœŸœ ŸœŸœŸœ˜:KšœŸœŸœ˜šŸœŸœŸ˜KšŸœŸœŸœ˜1K˜ KšŸœ˜—KšŸœ˜ Kšœž˜—K˜š ‘œŸœŸœ ŸœŸœŸœ˜