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