DIRECTORY AMBridge USING [TVForReferent], AMList USING [], AMTypes USING [Class, IndexToType, NComponents, Range, TVType, TypeClass, UnderType], RefAnyOps USING [EqualRefs], SafeStorage USING [Type, EquivalentTypes, nullType] ; AMListImpl: CEDAR PROGRAM IMPORTS AMBridge, AMTypes, RefAnyOps, SafeStorage EXPORTS AMList = BEGIN OPEN SafeStorage; Eq: PROC [x, y: REF ANY] RETURNS[BOOLEAN] = INLINE {RETURN[x = y]}; IsAList: PUBLIC PROC [ref: REF ANY _ NIL, underType: Type _ nullType] RETURNS [result: BOOLEAN] = { IF ref = NIL AND underType = nullType THEN RETURN[TRUE]; TRUSTED { OPEN AMTypes; IF underType = nullType THEN underType _ UnderType[TVType[AMBridge.TVForReferent[ref]]]; RETURN[TypeClass[underType] = structure AND (NComponents[underType] = 2) AND EquivalentTypes[Range[IndexToType[underType, 2]], underType] -- checks whether the rest field points to an object whose type is the same as the referrent of ref. Note that it is nnecessary to check to see whether TypeClass[IndexToType[underType, 2]] = list since this is a stronger test, i.e. that it is equivalent to the type of the first list node. ]; }; }; -- of IsAList IsAListOfRefAny: PUBLIC PROC [ref: REF ANY, underType: Type _ nullType] RETURNS [result: BOOLEAN, list: LIST OF REF ANY ] = { IF ref = NIL THEN RETURN[TRUE, NIL]; WITH ref SELECT FROM l: LIST OF REF ANY => RETURN[TRUE, l]; -- most common case. worth a special check ENDCASE => TRUSTED { OPEN AMTypes; IF underType = nullType THEN underType _ UnderType[TVType[AMBridge.TVForReferent[ref]]]; IF TypeClass[underType] = structure AND (NComponents[underType] = 2) AND EquivalentTypes[Range[IndexToType[underType, 2]], underType] -- checks whether the rest field points to an object whose type is the same as the referrent of ref. Note that it is nnecessary to check to see whether TypeClass[IndexToType[underType, 2]] = list since this is a stronger test, i.e. that it is equivalent to the type of the first list node. AND TypeClass[UnderType[IndexToType[underType,1]]] = ref -- LIST OF INTEGER would satisfy all of the tests up to here but is not polymorphic to LIST OF REF ANY THEN RETURN[TRUE, LOOPHOLE[ref, LIST OF REF ANY]]; }; RETURN[FALSE, NIL]; }; -- of IsAListOfRefAny EqLists: PUBLIC PROCEDURE [l1, l2: LIST OF REF ANY, compareLists: BOOLEAN _ FALSE] 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 IF compareLists THEN BEGIN flg1, flg2: BOOLEAN; l1, l2: LIST OF REF ANY; [flg1, l1] _ IsAListOfRefAny[l1.first]; IF ~flg1 THEN RETURN[FALSE]; [flg2, l2] _ IsAListOfRefAny[l2.first]; IF ~flg2 OR ~EqLists[l1, l2] THEN RETURN[FALSE]; END ELSE RETURN[FALSE]; l1 _ l1.rest; l2 _ l2.rest; ENDLOOP; RETURN[l2 = NIL]; }; -- of EqLists Member: PUBLIC PROCEDURE [ref: REF ANY, list: LIST OF REF ANY] RETURNS[BOOLEAN] = { UNTIL list = NIL DO IF RefAnyOps.EqualRefs[list.first, ref] THEN RETURN[TRUE]; list _ list.rest; ENDLOOP; RETURN[FALSE]; }; -- of Member END. τAMListImpl.mesa "List" routines that use the Cedar Abstract Machine. Edited by Teitelman on October 29, 1982 5:53 pm Edited by Paul Rovner on May 13, 1983 10:36 am Predicates: IsAList, IsAListOfRefAny, EqLists, Member uses TVs Interface to test whthere or not ref is a list type. UnderType is the type of the referent of ref. If underType is supplied, ref is ignored. If UnderType=NIL and ref is not-NIL, undertype will be computed. If both ref and undertype are NIL, IsAList returns True. ΚΉ– "Cedar" style˜J˜JšΟc™Jš5™5Jš0™0Jš/™/J˜J˜šΟk ˜ Jšœ žœ˜Jšœžœ˜JšœžœH˜UJšœ žœ ˜Jšœ žœ"˜3J˜—J˜JšΠln œžœž˜J˜Jšžœ*˜1J˜Jšžœ ˜J˜Jšž œ ž˜headšœ Ρnpr)™5JšΟnœžœžœžœžœžœžœžœ ˜Dš‘œžœžœžœžœžœžœ žœ˜dJšœ™Jš žœžœžœžœžœžœ˜8Jšž˜šž˜Jšžœ ˜ Jšžœžœ<˜Xšžœ"ž˜+Jšœž˜ Jšœ=˜=Jš’˜’J˜—Jšžœ˜—Jšžœ ˜—J˜š‘œžœžœžœžœžœ žœžœžœžœžœžœ˜~Jš žœžœžœžœžœžœ˜$šžœžœž˜Jšœžœžœžœžœžœžœ*˜Qšžœž ˜Jšžœ ˜ Jšžœžœ<˜Xšžœ"ž˜'Jšœž˜ Jšœ=’˜ίJšž˜Jšœ6i˜ŸJšžœžœžœžœžœžœžœžœ˜2—Jšžœ˜——Jšžœžœžœ˜Jšžœ˜—J˜š‘œžœž œ žœžœžœžœžœžœžœžœž˜hJšžœ žœžœžœ˜Jšžœžœžœžœžœžœžœ˜+šžœžœž˜Jš žœžœžœžœžœ˜Jšžœžœž˜#šžœžœžœ˜Jšž˜Jšœ žœ˜Jš œžœžœžœžœ˜J˜'Jšžœžœžœžœ˜J˜'Jš žœžœžœžœžœ˜0Jšž˜—Jšžœžœžœ˜J˜ J˜ Jšžœ˜—Jšžœžœ˜Jšžœ ˜—J˜š‘œžœž œžœžœžœžœžœžœžœžœž˜Sšžœžœž˜Jšžœ&žœžœžœ˜:J˜Jšžœ˜—Jšžœžœ˜Jšžœ ˜——J˜Jšžœ˜J˜—…— ςŸ