<<>> <> <> <> <> <> <> <> 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.