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