DIRECTORY AMExtras USING [], AMTypes USING [Coerce, IndexToTV, IsNil, IsAtom, IsRefAny, IsRope, Referent, Range, New, Assign, TVType, TypeClass, UnderType], AMBridge USING [TVForReferent, RefFromTV], Rope USING [ROPE], RTBasic USING [TV, Type], RTTypesBasic USING [EquivalentTypes] ; AMExtrasImpl: CEDAR PROGRAM IMPORTS AMTypes, AMBridge, RTTypesBasic EXPORTS AMExtras = BEGIN OPEN RTBasic, AMTypes, AMBridge, RTTypesBasic; IsAListOfT: PUBLIC PROC [list: TV, T: Type] RETURNS[BOOL] = { WHILE NOT IsNil[list] DO node: TV = Referent[list]; element: TV = IndexToTV[node, 1]; IF NOT IsOfTypeT[element, T] THEN RETURN[FALSE]; list _ IndexToTV[node, 2]; ENDLOOP; RETURN[TRUE]; }; IsARefType: PUBLIC PROC [type: Type] RETURNS[BOOL] = { SELECT TypeClass[UnderType[type]] FROM ref, rope, atom => RETURN[TRUE]; ENDCASE => RETURN[FALSE]; }; IsOfTypeT: PUBLIC PROC [tv: TV, T: Type] RETURNS[BOOL] ={ type: Type = UnderType[TVType[tv]]; IF EquivalentTypes[T, type] THEN RETURN[TRUE] ELSE IF NOT IsRefAny[type] THEN RETURN[FALSE] ELSE IF EquivalentTypes[T, CODE[ATOM]] THEN RETURN[IsAtom[tv]] ELSE IF EquivalentTypes[T, CODE[Rope.ROPE]] THEN RETURN[IsRope[tv]] ELSE RETURN[EquivalentTypes[Range[T], TVType[Referent[tv]]]]; }; Cons: PUBLIC PROC[element: TV-- for a T--, list: TV-- for a LIST OF T--] RETURNS[TV-- for a LIST OF T--] = TRUSTED { listType: Type = TVType[list]; node: TV = New[Range[listType]]; Assign[IndexToTV[node, 1], element]; -- may raise Error with reason rangeFault. Should we check IfOfTypeT first? Assign[IndexToTV[node, 2], list]; RETURN[Coerce[TVForReferent[NEW[REF _ RefFromTV[node]]], listType]]; }; List: PUBLIC PROC[listType: Type -- LIST OF T --, first, second, third, fourth: TV _ NIL] RETURNS[TV-- for a LIST OF T--] = { list: TV _ New[listType]; IF fourth # NIL THEN list _ Cons[fourth, list]; IF third # NIL THEN list _ Cons[third, list]; IF second # NIL THEN list _ Cons[second, list]; IF first # NIL THEN list _ Cons[first, list]; RETURN[list]; }; END. -- of AMExtrasImpl Κ– "Cedar" style˜šΟk ˜ Jšœ œ˜Jšœœr˜Jšœ*˜*Jšœœœ˜Jšœœœ˜Jšœ œ˜$J˜—J˜JšΠbl œœ˜J˜Jšœ ˜'Jšœ ˜Jšœœœ,˜9J˜J˜š Οn œ œœ œœ˜=šœœ ˜Jšœœ˜Jšœ œ˜!Jš œœœœœ˜1Jšœ˜Jšœ˜—Jšœœ˜ Jšœ˜J˜—šŸ œ œœœ˜6šœ˜&Jšœœœ˜ Jšœœœ˜J˜——J˜š Ÿ œ œœ œœ˜9Jšœ$˜$Jšœ˜-Jš œœœœœœ˜-Jšœœœœœœœ ˜?Jšœœœœœœœ ˜DJšœœœ˜=J˜—J˜š Ÿœ œ Οc œ œ˜HJšœ œœ˜+Jšœ˜Jšœœ˜ Jšœ& K˜qJ˜!Jšœœœ!˜DJ˜J˜—š Ÿœ œ œ œœ˜YJšœ œ˜#Jšœœ˜Jšœ œœ˜/Jšœ œœ˜-Jšœ œœ˜/Jšœ œœ˜-Jšœ˜ J˜J˜—Jšœ ˜J˜—…—ή