<> <> <> <> DIRECTORY AllocatorOps, AMTypes, GList, Rope, SafeStorage; GListImpl: CEDAR PROGRAM IMPORTS AllocatorOps, AMTypes, Rope, SafeStorage EXPORTS GList = BEGIN OPEN GList; <> LORA: TYPE = LIST OF REF ANY; Type: TYPE = SafeStorage.Type; <> IncompatibleType: PUBLIC ERROR [ref: REF ANY] = CODE; <<>> NotAListType: PUBLIC ERROR = CODE; <> CheckedTypesArray: TYPE = PACKED ARRAY SafeStorage.TypeIndex OF Type _ ALL [SafeStorage.nullType]; checkedTypesArray: REF CheckedTypesArray _ NEW [CheckedTypesArray]; < T.>> sizeOfListObjects: CARDINAL = 4; <> CheckListType: PROC [type: Type] = { IF checkedTypesArray[type]#SafeStorage.nullType THEN RETURN; BEGIN sonType: Type; -- REF T IF AMTypes.UnderClass[type]#structure OR AMTypes.NComponents[type]#2 OR ~Rope.Equal[AMTypes.IndexToName[type, 1], "first"] OR ~Rope.Equal[AMTypes.IndexToName[type, 2], "rest"] OR AMTypes.Size[type]#sizeOfListObjects THEN ERROR NotAListType[]; sonType _ AMTypes.IndexToType[type, 1]; sonType _ SafeStorage.GetCanonicalType[sonType]; checkedTypesArray[type] _ SafeStorage.GetCanonicalType[AMTypes.Range[sonType]]; -- we store T END; }; CheckIsSon: PROC [ref: REF ANY, type: Type] RETURNS [same: REF ANY] = { IF ref=NIL THEN RETURN [NIL]; IF SafeStorage.GetCanonicalReferentType[ref]#checkedTypesArray[type] THEN ERROR IncompatibleType[ref]; same _ ref; }; CheckIsList: PROC [list: List, type: Type] RETURNS [lora: LORA] = { IF list=NIL THEN RETURN [NIL]; IF SafeStorage.GetCanonicalReferentType[list]#SafeStorage.GetCanonicalType[type] THEN ERROR IncompatibleType[list]; TRUSTED {lora _ LOOPHOLE [list]}; }; UnCheckedCons: PROC [ref: REF ANY, list: LORA, type: Type] RETURNS [cons: LORA] = TRUSTED { cons _ LOOPHOLE [AllocatorOps.NewObject[type, sizeOfListObjects]]; cons.first _ ref; cons.rest _ list; }; GetType: PROC [list: List] RETURNS [type: Type] = { IF list=NIL THEN RETURN [SafeStorage.nullType]; type _ SafeStorage.GetCanonicalReferentType[list]; CheckListType[type]; }; <> Eq: PROC [x, y: REF ANY] RETURNS [BOOL] = INLINE {RETURN [x = y]}; EqLists: PUBLIC PROC [l1, l2: List] RETURNS [BOOL] = { IF l1 = l2 THEN RETURN [TRUE]; IF l1 = NIL OR l2 = NIL THEN RETURN [FALSE]; BEGIN type: Type _ GetType[l1]; lora1: LORA _ CheckIsList[l1, type]; lora2: LORA _ CheckIsList[l2, type]; UNTIL lora1 = NIL DO IF lora2 = NIL THEN RETURN [FALSE]; IF Eq[lora1.first, lora2.first] THEN NULL ELSE RETURN [FALSE]; lora1 _ lora1.rest; lora2 _ lora2.rest; ENDLOOP; RETURN [lora2 = NIL]; END; }; LoraMember: 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]; }; Member: PUBLIC PROC [ref: REF ANY, list: List] RETURNS [BOOL] = { type: Type _ GetType[list]; RETURN [LoraMember[ref, CheckIsList[list, type]]]; }; <> Append: PUBLIC PROC [l1: List, l2: List _ NIL] RETURNS [List] = { IF l1=NIL THEN RETURN [l2]; BEGIN type: Type _ GetType[l1]; val: LORA; lora1: LORA _ CheckIsList[l1, type]; lora2: LORA _ CheckIsList[l2, type]; z: LORA _ NIL; val _ UnCheckedCons[lora1.first, lora2, type]; z _ val; UNTIL (lora1 _ lora1.rest) = NIL DO z.rest _ UnCheckedCons[lora1.first, z.rest, type]; z _ z.rest; ENDLOOP; RETURN [val]; END; }; -- of Append Copy: PUBLIC PROC [list: List] RETURNS [List] = { RETURN [Append[list, NIL]]; }; Reverse: PUBLIC PROC [list: List] RETURNS [List] = { type: Type _ GetType[list]; val: LORA _ NIL; lora: LORA _ CheckIsList[list, type]; UNTIL lora = NIL DO val _ UnCheckedCons[lora.first, val, type]; lora _ lora.rest ENDLOOP; RETURN [val]; }; -- of Reverse Remove: PUBLIC PROC [ref: REF ANY, list: List] RETURNS [List] = { type: Type _ GetType[list]; val: LORA; lora: LORA _ CheckIsList[list, type]; z: LORA _ NIL; UNTIL lora = NIL DO IF ~Eq[lora.first, ref] THEN {IF val = NIL THEN {val _ UnCheckedCons[lora.first, NIL, type]; z _ val} ELSE {z.rest _ UnCheckedCons[lora.first, z.rest, type]; z _ z.rest}}; lora _ lora.rest; ENDLOOP; RETURN [val]; }; -- of Remove Union: PUBLIC PROC [l1, l2: List] RETURNS [List] = { type: Type _ GetType[IF l1=NIL THEN l2 ELSE l1]; lora1: LORA _ CheckIsList[l1, type]; lora2: LORA _ CheckIsList[l2, type]; list: LORA _ lora2; UNTIL lora1 = NIL DO IF ~LoraMember[lora1.first, list] THEN list _ UnCheckedCons[lora1.first, list, type]; lora1 _ lora1.rest; ENDLOOP; RETURN [list]; }; -- of Union Intersection: PUBLIC PROC [l1, l2: List] RETURNS [List] = { type: Type _ GetType[IF l1=NIL THEN l2 ELSE l1]; lora1: LORA _ CheckIsList[l1, type]; lora2: LORA _ CheckIsList[l2, type]; list: LORA _ NIL; UNTIL lora1 = NIL DO IF LoraMember[lora1.first, lora2] THEN list _ UnCheckedCons[lora1.first, list, type]; lora1 _ lora1.rest; ENDLOOP; RETURN [list]; }; -- of Intersection ListDifference: PUBLIC PROC [l1, l2: List] RETURNS [List] = { type: Type _ GetType[IF l1=NIL THEN l2 ELSE l1]; lora1: LORA _ CheckIsList[l1, type]; lora2: LORA _ CheckIsList[l2, type]; list: LORA _ NIL; IF lora2 = NIL THEN RETURN [lora1]; UNTIL lora1 = NIL DO IF ~LoraMember[lora1.first, lora2] THEN list _ LoraNconc[list, UnCheckedCons[lora1.first, NIL, type]]; lora1 _ lora1.rest; ENDLOOP; RETURN [list]; }; -- of ListDifference <> LoraNconc: 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]; }; Nconc: PUBLIC PROC [l1, l2: List] RETURNS [List] = { type: Type _ GetType[IF l1=NIL THEN l2 ELSE l1]; lora1: LORA _ CheckIsList[l1, type]; lora2: LORA _ CheckIsList[l2, type]; RETURN [LoraNconc[lora1, lora2]]; }; DReverse: PUBLIC PROC [list: List] RETURNS [List] = { type: Type _ GetType[list]; lora: LORA _ CheckIsList[list, type]; l1, l2, l3: LORA _ NIL; IF list = NIL THEN RETURN [NIL]; l3 _ lora; 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: List] RETURNS [List] = { type: Type _ GetType[list]; lora: LORA _ CheckIsList[list, type]; l, l1: LORA _ NIL; l _ lora; 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 [lora]; }; l1 _ l; l _ l.rest; ENDLOOP; RETURN [lora]; }; -- of Dremove; DSubst: PUBLIC PROC [new, old: REF ANY, list: List] RETURNS [List] = { type: Type _ GetType[list]; lora: LORA _ CheckIsList[list, type]; IF lora = NIL THEN RETURN [NIL]; new _ CheckIsSon[new, type]; FOR l: LORA _ lora, l.rest UNTIL l = NIL DO IF Eq[l.first, old] THEN l.first _ new; ENDLOOP; RETURN [lora]; }; -- of DSubst <> NthTail: PUBLIC PROC [list: List, n: INT] RETURNS [List] = { type: Type _ GetType[list]; lora: LORA _ CheckIsList[list, type]; IF n=0 THEN RETURN [lora]; IF lora = NIL THEN RETURN [NIL]; IF n > 0 THEN THROUGH [0..n) DO lora _ lora.rest; IF lora = NIL THEN RETURN [NIL]; REPEAT FINISHED => RETURN [lora]; ENDLOOP ELSE {lead: LORA _ CheckIsList[NthTail[lora, -n], type]; UNTIL lead = NIL DO lead _ lead.rest; lora _ lora.rest ENDLOOP; RETURN [lora]; }; }; -- of NthTail NthElement: PUBLIC PROC [list: List, n: INT] RETURNS [REF ANY] = { type: Type _ GetType[list]; tail: List; IF n=0 THEN ERROR; tail _ NthTail[list, IF n > 0 THEN n-1 ELSE n]; IF tail = NIL THEN ERROR; RETURN [CheckIsList[tail, type].first]; }; -- of NthElement <> Length: PUBLIC PROC [list: List] RETURNS [n: INT _ 0] = { type: Type _ GetType[list]; lora: LORA _ CheckIsList[list, type]; UNTIL lora = NIL DO n _ n+1; lora _ lora.rest ENDLOOP; }; Subst: PUBLIC PROC [new, old: REF ANY, list: List] RETURNS [List] = { type: Type _ GetType[list]; lora: LORA _ CheckIsList[list, type]; head, tail: LORA _ NIL; new _ CheckIsSon[new, type]; WHILE lora # NIL DO cons: LORA _ UnCheckedCons[IF lora.first = old THEN new ELSE lora.first, NIL, type]; IF tail = NIL THEN head _ cons ELSE tail.rest _ cons; tail _ cons; lora _ lora.rest; ENDLOOP; RETURN [head]; }; Kill: PUBLIC PROC [list: List] = { type: Type _ GetType[list]; lora: LORA _ CheckIsList[list, type]; WHILE lora # NIL DO next: LORA _ lora.rest; lora.rest _ NIL; lora.first _ NIL; lora _ next ENDLOOP; }; <> Sort: PUBLIC PROC [list: List, compareProc: CompareProc] RETURNS [List] = { <<... 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 _ LoraMerge[new, mid, compareProc]; IF next = NIL THEN RETURN; <> FOR depth: NAT IN [2..max) DO [mid, next] _ InnerSort[next, depth]; new _ LoraMerge[new, mid, compareProc]; IF next = NIL THEN RETURN; ENDLOOP; }; type: Type _ GetType[list]; lora: LORA _ CheckIsList[list, type]; IF lora = NIL OR lora.rest = NIL THEN RETURN [lora]; RETURN [InnerSort[lora, 32].new]; }; LoraMerge: 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: List, compareProc: CompareProc] RETURNS [List] = { type: Type _ GetType[list]; lora: LORA _ CheckIsList[list, type]; lag: LORA _ lora _ CheckIsList[Sort[lora, compareProc], type]; 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 [lora]; }; Merge: PROC [x, y: LORA, compareProc: CompareProc] RETURNS [List] = { type: Type _ GetType[IF x=NIL THEN y ELSE x]; RETURN [LoraMerge[CheckIsList[x, type], CheckIsList[y, type], compareProc]]; }; END.