<> <> <> <> <> 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] = { <<... destructively sorts the given list in increasing order according to compareProc. The sort is not stable, so order of equal elements is not preserved.>> 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] = { <<... 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.>> <> <> 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.