DIRECTORY
CCTypes USING[Apply, ApplyOperand, IndexOperand, BinaryOperandTypes, BinaryTargetTypes, BreakObject, CCError, CCErrorCase, CCTypeProcs, CheckConformance, CheckFamilyInclusion, ConformanceCheck, CreateCedarType, ExtractIdField, GetIndirectType, GetProcDataFromGroundType, GetProcDataFromType, HasIdField, Index, LR, SelectIdField, PrintType],
CedarCode USING[BreakShowNode, Code, CodeToExtractField, CodeToSelectField, ConcatCode, CreateCedarNode, GetDataFromNode, GetTypeOfNode, LoadThroughIndirectNode, NodeAsIndex, OperationsBody, Operator, ShowNode],
CirioSyntacticOperations USING[ParseTree],
CirioTypes USING[CompilerContext, Mem, Node, Type, TypedCode],
IO,
Rope,
Sequences USING[SequenceTypeProcs, IndirectSRProcs];

SequencesImpl: CEDAR PROGRAM
IMPORTS CCTypes, CedarCode, IO, Rope
EXPORTS Sequences
= BEGIN

CC: TYPE = CirioTypes.CompilerContext;
Code: TYPE = CedarCode.Code;
Type: TYPE = CirioTypes.Type;
TypedCode: TYPE = CirioTypes.TypedCode;
Mem: TYPE = CirioTypes.Mem;
Node: TYPE = CirioTypes.Node;
CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE ¬ NIL] ¬ CCTypes.CCError;
Operator: TYPE = CedarCode.Operator;



SRInfo: TYPE = REF SRInfoBody;
SRInfoBody: TYPE = RECORD[
self: Type,
indirect: Type,
procs: REF Sequences.SequenceTypeProcs,
preamble: Type,
tailName: Rope.ROPE,
tailType: Type,
data: REF ANY];

CreateSequenceRecordType: PUBLIC PROC[preamble: Type, tailName: Rope.ROPE, tagName: Rope.ROPE, indexType: Type, procs: REF Sequences.SequenceTypeProcs, cc: CC, data: REF ANY] RETURNS[Type] =
BEGIN
unionTailType: Type ¬ CreateUnionTailType[tagName, indexType, procs, cc, data];
info: SRInfo ¬ NEW[SRInfoBody¬[NIL, NIL, procs, preamble, tailName, unionTailType, data]];
type: Type ¬ CCTypes.CreateCedarType[$sequence, SequenceCCTypeProcs, IndirectSequenceCCTypeProcs, cc, info];
info.self ¬ type;
RETURN[type];
END;



SequenceCCTypeProcs: REF CCTypes.CCTypeProcs ¬ NEW[CCTypes.CCTypeProcs ¬[
checkConformance: SRCCTypesCheckConformance,
checkFamilyInclusion: SRCCTypesCheckFamilyInclusion,
getFieldsType: SRCCTypesGetFieldsType,
containsVariance: SRCCTypesContainsVariance,
operand: SRCCTypesOperand,
applyOperand: SRCCTypesApplyOperand,
binaryOperandTypes: SRCCTypesBinaryOperandTypes,
extractIdField: SRCCTypesExtractIdField,
apply: SRCCTypesApply,
printType: SRCCTypesPrintType]];

SRCCTypesCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck]
=
BEGIN
valInfo: SRInfo ¬ NARROW[procData];

WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROM
varInfo: SRInfo =>
BEGIN
conforms1: CCTypes.ConformanceCheck;
conforms2: CCTypes.ConformanceCheck;

conforms1 ¬ CCTypes.CheckConformance[valInfo.preamble, varInfo.preamble, cc];
IF conforms1 = no THEN RETURN[no];

conforms2 ¬ CCTypes.CheckConformance[valInfo.tailType, varInfo.tailType, cc];
IF conforms2 = no THEN RETURN[no];

IF conforms1 = yes AND conforms2 = yes THEN RETURN[yes];
RETURN[dontKnow];

END;
ENDCASE => RETURN[no];
END;

SRCCTypesCheckFamilyInclusion: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[BOOLEAN]
=
BEGIN
valInfo: SRInfo ¬ NARROW[procData];

WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROM
varInfo: SRInfo =>
BEGIN

IF NOT CCTypes.CheckFamilyInclusion[valInfo.preamble, varInfo.preamble, cc] THEN RETURN[FALSE];

IF NOT CCTypes.CheckFamilyInclusion[valInfo.tailType, varInfo.tailType, cc] THEN RETURN[FALSE];

RETURN[TRUE];

END;
ENDCASE => RETURN[FALSE];
END;


SRCCTypesGetFieldsType: PROC[rcdType: Type, cc: CC, procData: REF ANY] RETURNS[Type] =
BEGIN
info: SRInfo ¬ NARROW[procData];
RETURN[info.preamble];
END;

SRCCTypesContainsVariance: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[BOOLEAN] = {RETURN[TRUE]};

SRCCTypesOperand: PROC[op: CedarCode.Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
SELECT op FROM
$dot, $extractId => RETURN[tc];
$apply =>
SELECT lr FROM
left => RETURN[tc];
ENDCASE => CCE[operation];
ENDCASE => CCE[operation]; -- client error, invalid operation
END;

SRCCTypesApplyOperand: PROC[operatorType: Type, operand: CirioSyntacticOperations.ParseTree, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: SRInfo ¬ NARROW[procData];
RETURN[CCTypes.ApplyOperand[info.tailType, operand, cc]];
END;

SRCCTypesBinaryOperandTypes: PROC[op: Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.BinaryTargetTypes] =
BEGIN
info: SRInfo ¬ NARROW[procData];
subTypes: CCTypes.BinaryTargetTypes ¬ CCTypes.BinaryOperandTypes[op, info.tailType, right, cc];
RETURN[[left, subTypes.tRight]];
END;

SRCCTypesExtractIdField: PROC[id: Rope.ROPE, fieldContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: SRInfo ¬ NARROW[procData];

IF CCTypes.HasIdField[id, info.preamble, cc] = yes THEN
BEGIN -- note: it should be impossible to return possible
code1: Code ¬ CedarCode.CodeToExtractField["&Preamble", fieldContext];
tc2: TypedCode ¬ CCTypes.ExtractIdField[id, info.preamble, cc];
code: Code ¬ CedarCode.ConcatCode[code1, tc2.code];
RETURN[[code, tc2.type]];
END
ELSE IF Rope.Equal[id, info.tailName] THEN
BEGIN
code: Code ¬ CedarCode.CodeToExtractField["&Tail", fieldContext];
RETURN[[code, info.tailType]];
END
ELSE CCE[operation, Rope.Cat["field ", id, " does not exist"]]; -- client error, no such field name
END;

SRCCTypesApply: PROC[operator: TypedCode, operand: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: SRInfo ¬ NARROW[procData];
code1: Code ¬ CedarCode.ConcatCode[
operator.code,
CedarCode.CodeToExtractField["&Tail", info.self]];
RETURN[CCTypes.Apply[[code1, info.tailType], operand, cc]]; 
END;

SRCCTypesPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] = {
info: SRInfo ¬ NARROW[procData];
tailInfo: SRTailInfo ¬ NARROW[CCTypes.GetProcDataFromType[info.tailType]];
PrintTail: PROC ~ {
to.PutRope[info.tailName];
to.PutChar[':];
CCTypes.BreakObject[to, PrintIndex, " "];
CCTypes.BreakObject[to, PrintRange, " "]};
PrintIndex: PROC ~ {
to.PutRope["SEQUENCE "];
CCTypes.PrintType[to, tailInfo.indexType, printDepth-1, printWidth, cc]};
PrintRange: PROC ~ {
to.PutRope["OF "];
CCTypes.PrintType[to, tailInfo.procs.getEntryType[cc, tailInfo.data], printDepth-1, printWidth, cc]};
to.PutChar['[];
CCTypes.PrintType[to, info.preamble, printDepth-1, printWidth, cc];
to.PutChar[',];
IF info.tailName.Length[]>0 THEN CCTypes.BreakObject[to, PrintTail, " "]
ELSE {
CCTypes.BreakObject[to, PrintIndex, " "];
CCTypes.BreakObject[to, PrintRange, " "]};
to.PutChar[']];
RETURN};


IndirectSequenceCCTypeProcs: REF CCTypes.CCTypeProcs ¬ NEW[CCTypes.CCTypeProcs ¬[
createIndirectNode: SequenceCreateIndirect,
getBitSize: SequenceBitSize,
operand: ISRCCTypesOperand,
indexOperand: SRCCTypesApplyOperand,
store: ISRCCTypesStore,
selectIdField: ISRCCTypesSelectIdField,
index: ISRCCTypesIndex,
printType: SRCCTypesPrintType]];

SequenceCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
info: SRInfo ~ NARROW[procData];
RETURN info.procs.createIndirectNode[cc, info.data, indirectType, targetType, mem]};

SequenceBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ {
info: SRInfo ~ NARROW[procData];
RETURN info.procs.getBitSize[indirectType, cc, info.data]};

ISRCCTypesOperand: PROC[op: Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
SELECT op FROM
$selectId, $address => RETURN[tc];
$index => 
SELECT lr FROM
left => RETURN[tc];
ENDCASE => CCE[operation];
ENDCASE => CCE[operation]; -- client error; invalid operation
END;

ISRCCTypesStore: PROC[value: TypedCode, indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
{CCE[operation, "attempt to store a sequence"]};


ISRCCTypesSelectIdField: PROC[id: Rope.ROPE, fieldIndirectContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: SRInfo ¬ NARROW[procData];

IF CCTypes.HasIdField[id, info.preamble, cc] = yes THEN
BEGIN -- note: it should be impossible to return possible
code1: Code ¬ CedarCode.CodeToSelectField["&Preamble", fieldIndirectContext];
tc2: TypedCode ¬ CCTypes.SelectIdField[id, CCTypes.GetIndirectType[info.preamble], cc];
code: Code ¬ CedarCode.ConcatCode[code1, tc2.code];
RETURN[[code, tc2.type]];
END
ELSE IF Rope.Equal[id, info.tailName] THEN
BEGIN
code: Code ¬ CedarCode.CodeToSelectField["&Tail", fieldIndirectContext];
RETURN[[code, info.tailType]];
END
ELSE CCE[operation, Rope.Cat["field ", id, " does not exist"]]; -- client error, no such field name
END;

ISRCCTypesIndex: PROC[operator: TypedCode, operand: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: SRInfo ¬ NARROW[procData];
code1: Code ¬ CedarCode.ConcatCode[
operator.code,
CedarCode.CodeToSelectField["&Tail", info.self]];
RETURN[CCTypes.Index[[code1, CCTypes.GetIndirectType[info.tailType]], operand, cc]]; 
END;


SRTailInfo: TYPE = REF SRTailInfoBody;
SRTailInfoBody: TYPE = RECORD[
self: Type,
indirect: Type,
tagName: Rope.ROPE,
indexType: Type,
procs: REF Sequences.SequenceTypeProcs,
data: REF ANY];

CreateUnionTailType: PROC[tagName: Rope.ROPE, indexType: Type, procs: REF Sequences.SequenceTypeProcs, cc: CC, data: REF ANY] RETURNS[Type] =
BEGIN
tailInfo: SRTailInfo ¬ NEW[SRTailInfoBody¬[NIL, NIL, tagName, indexType, procs, data]];
tailType: Type ¬ CCTypes.CreateCedarType[$sequenceUnionTail, SRUTailCCTypeProcs, ISRUTailCCTypeProcs, cc, tailInfo];
tailInfo.self ¬ tailType;
RETURN[tailType];
END;

SRUTailCCTypeProcs: REF CCTypes.CCTypeProcs ¬ NEW[CCTypes.CCTypeProcs ¬[
checkConformance: SRUTCCTypesCheckConformance,
operand: SRUTCCTypesOperand,
applyOperand: SRUTCCTypesApplyOperand,
indexOperand: SRUTCCTypesIndexOperand,
binaryOperandTypes: SRUTCCTypesBinaryOperandTypes,
extractIdField: SRUTCCTypesExtractIdField,
apply: SRUTCCTypesApply,
index: SRUTCCTypesIndex]];

SRUTCCTypesCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck]
=
BEGIN
valTailInfo: SRTailInfo ¬ NARROW[procData];
WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROM
varTailInfo: SRTailInfo =>
BEGIN
conforms1: CCTypes.ConformanceCheck;
conforms2: CCTypes.ConformanceCheck;

IF NOT Rope.Equal[valTailInfo.tagName, varTailInfo.tagName] THEN RETURN[no];
conforms1 ¬ CCTypes.CheckConformance[valTailInfo.indexType, varTailInfo.indexType, cc];
IF conforms1 = no THEN RETURN[no];

conforms2 ¬ CCTypes.CheckConformance[valTailInfo.procs.getEntryType[cc, valTailInfo.data], varTailInfo.procs.getEntryType[cc, varTailInfo.data], cc];
IF conforms2 = no THEN RETURN[no];

IF conforms1 = yes AND conforms2 = yes THEN RETURN[yes];
RETURN[dontKnow];

END;
ENDCASE => RETURN[no];
END;

SRUTCCTypesOperand: PROC[op: CedarCode.Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
SELECT op FROM
$apply, $index =>
SELECT lr FROM
left => RETURN[tc];
ENDCASE => CCE[operation];
ENDCASE => CCE[operation]; -- client error, invalid operation
END;

SRUTCCTypesApplyOperand: PROC[operatorType: Type, operand: CirioSyntacticOperations.ParseTree, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
tailInfo: SRTailInfo ¬ NARROW[procData];
RETURN[CCTypes.ApplyOperand[operatorType, operand, cc, tailInfo.procs.getNominalArrayType[cc, tailInfo.data]]];
END;

SRUTCCTypesIndexOperand: PROC[operatorType: Type, operand: CirioSyntacticOperations.ParseTree, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
tailInfo: SRTailInfo ¬ NARROW[procData];
RETURN[CCTypes.IndexOperand[operatorType, operand, cc, CCTypes.GetIndirectType[tailInfo.procs.getNominalArrayType[cc, tailInfo.data]]]];
END;

SRUTCCTypesBinaryOperandTypes: PROC[op: Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.BinaryTargetTypes] =
BEGIN
tailInfo: SRTailInfo ¬ NARROW[procData];
RETURN[CCTypes.BinaryOperandTypes[op, left, right, cc, tailInfo.procs.getNominalArrayType[cc, tailInfo.data]]];
END;

SRUTCCTypesExtractIdField: PROC[id: Rope.ROPE, fieldContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
tailInfo: SRTailInfo ¬ NARROW[procData];
IF Rope.Equal[id, tailInfo.tagName] THEN
BEGIN
code: Code ¬ CedarCode.CodeToExtractField["&Tag", fieldContext];
RETURN[[code, tailInfo.indexType]];
END
ELSE CCE[operation, Rope.Cat["field ", id, " does not exist"]] -- client type error, no such field
END;

SRUTCCTypesApply: PROC[operator: TypedCode, operand: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
tailInfo: SRTailInfo ¬ NARROW[procData];
RETURN[CCTypes.Apply[operator, operand, cc, tailInfo.procs.getNominalArrayType[cc, tailInfo.data]]];
END;

SRUTCCTypesIndex: PROC[operator: TypedCode, operand: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
tailInfo: SRTailInfo ¬ NARROW[procData];
RETURN[CCTypes.Index[operator, operand, cc, CCTypes.GetIndirectType[tailInfo.procs.getNominalArrayType[cc, tailInfo.data]]]];
END;

ISRUTailCCTypeProcs: REF CCTypes.CCTypeProcs ¬ NEW[CCTypes.CCTypeProcs ¬[
store: ISRUTCCTypesStore,
selectIdField: ISRUTCCTypesSelectIdField,
index: ISRUTCCTypesIndex]];

ISRUTCCTypesStore: PROC[value: TypedCode, indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
{CCE[operation, "attempt to store a sequence"]};
ISRUTCCTypesSelectIdField: PROC[id: Rope.ROPE, fieldIndirectContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
tailInfo: SRTailInfo ¬ NARROW[procData];
IF Rope.Equal[id, tailInfo.tagName] THEN
BEGIN
code: Code ¬ CedarCode.CodeToSelectField["&Tag", fieldIndirectContext];
RETURN[[code, tailInfo.indexType]];
END
ELSE CCE[operation, Rope.Cat["field ", id, " does not exist"]] -- client type error, no such field
END;

ISRUTCCTypesIndex: PROC[operator: TypedCode, operand: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
tailInfo: SRTailInfo ¬ NARROW[procData];
indirectNominalArrayType: Type ¬ CCTypes.GetIndirectType[tailInfo.procs.getNominalArrayType[cc, tailInfo.data]];
RETURN[CCTypes.Index[operator, operand, cc, indirectNominalArrayType]];
END;


IndirectSRProcs: TYPE = Sequences.IndirectSRProcs;

IndirectSRData: TYPE = REF IndirectSRDataBody;
IndirectSRDataBody: TYPE = RECORD[
targetSeqType: Type,
procs: REF IndirectSRProcs,
procsData: REF ANY,
indirectTail: CirioTypes.Node];


CreateIndirectSequenceNode: PUBLIC PROC[targetSeqType: Type, procs: REF IndirectSRProcs, procsData: REF ANY, cc: CC] RETURNS[Node] =
BEGIN
srTypeInfo: SRInfo ¬ NARROW[CCTypes.GetProcDataFromGroundType[targetSeqType, cc]];
isrData: IndirectSRData ¬ NEW[IndirectSRDataBody ¬ [targetSeqType, procs, procsData, NIL]];
node: Node ¬ CedarCode.CreateCedarNode[IndirectSROps, CCTypes.GetIndirectType[targetSeqType], isrData];
isrData.indirectTail ¬ CreateIndirectSequenceTail[srTypeInfo.tailType, isrData, cc];
RETURN[node];
END;

IndirectSROps: REF CedarCode.OperationsBody ¬ NEW[CedarCode.OperationsBody¬[
unaryOp: IndirectSRUnaryOp,
load: IndirectSRLoad,
selectField: IndirectSRSelectField,
show: IndirectSRShow]];

IndirectSRUnaryOp: PROC [op: CedarCode.Operator, type: CirioTypes.Type, node: CirioTypes.Node, cc: CC] RETURNS [CirioTypes.Node] =
BEGIN
indirectNodeData: IndirectSRData ¬ NARROW[CedarCode.GetDataFromNode[node]];
RETURN[indirectNodeData.procs.getPointer[indirectNodeData.procsData, cc]];
END;

IndirectSRLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[CirioTypes.Node] =
BEGIN
isrData: IndirectSRData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];
RETURN[CreateSequenceRecordNode[isrData.targetSeqType, DLSRProcs, isrData, cc, FALSE]];
END;

IndirectSRSelectField: PROC[id: Rope.ROPE, indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] =
BEGIN
isrData: IndirectSRData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];
SELECT TRUE FROM
Rope.Equal[id, "&Preamble"] => RETURN[isrData.procs.selectPreamble[isrData.procsData, cc]];
Rope.Equal[id, "&Tail"] => RETURN[isrData.indirectTail];
ENDCASE => CCE[cirioError]; -- shouldn't happen
END;

IndirectSRShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {
to.PutChar['^];
IF depth = 0 THEN {to.PutRope["[...]"]; RETURN};
{
isrType: Type ¬ CedarCode.GetTypeOfNode[node];
sr: Node ¬ CedarCode.LoadThroughIndirectNode[isrType, node, cc];
CedarCode.ShowNode[to, sr, depth-1, width, cc];
RETURN}};

DLSRProcs: REF SRNodeProcs ¬ NEW[SRNodeProcs¬[
extractPreamble: DLSRExtractPreamble,
extractTag: DLSRExtractTag,
extractTailEntry: DLSRExtractTailEntry]];


DLSRExtractPreamble: PROC[procsData: REF ANY, cc: CC] RETURNS[CirioTypes.Node] =
BEGIN
isrData: IndirectSRData ¬ NARROW[procsData];
indirectPreamble: Node ¬ isrData.procs.selectPreamble[isrData.procsData, cc];
indirectPreambleType: Type ¬ CedarCode.GetTypeOfNode[indirectPreamble];
RETURN[CedarCode.LoadThroughIndirectNode[indirectPreambleType, indirectPreamble, cc]];
END;

DLSRExtractTag: PROC[procsData: REF ANY, cc: CC] RETURNS[CirioTypes.Node] =
BEGIN
isrData: IndirectSRData ¬ NARROW[procsData];
indirectTag: Node ¬ isrData.procs.selectTag[isrData.procsData, cc];
indirectTagType: Type ¬ CedarCode.GetTypeOfNode[indirectTag];
RETURN[CedarCode.LoadThroughIndirectNode[indirectTagType, indirectTag, cc]];
END;

DLSRExtractTailEntry: PROC[index: CARD, procsData: REF ANY, cc: CC] RETURNS[CirioTypes.Node] =
BEGIN
isrData: IndirectSRData ¬ NARROW[procsData];
indirectEntry: Node ¬ isrData.procs.selectTailEntry[index, isrData.procsData, cc];
indirectEntryType: Type ¬ CedarCode.GetTypeOfNode[indirectEntry];
RETURN[CedarCode.LoadThroughIndirectNode[indirectEntryType, indirectEntry, cc]];
END;


CreateIndirectSequenceTail: PROC[stType: Type, isrData: IndirectSRData, cc: CC] RETURNS[Node] =
BEGIN
node: Node ¬ CedarCode.CreateCedarNode[IndirectSTOps, CCTypes.GetIndirectType[stType], isrData];
RETURN[node];
END;

IndirectSTOps: REF CedarCode.OperationsBody ¬ NEW[CedarCode.OperationsBody¬[
load: IndirectSTLoad,
selectField: IndirectSTSelectField,
index: IndirectSTIndex,
show: IndirectSTShow]];

IndirectSTLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] =
BEGIN
CCE[cirioError];  -- one should always load the whole sequence record then extract the tail.
END;

IndirectSTSelectField: PROC[id: Rope.ROPE, indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] =
BEGIN
isrData: IndirectSRData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];
SELECT TRUE FROM
Rope.Equal[id, "&Tag"] => RETURN[isrData.procs.selectTag[isrData.procsData, cc]];
ENDCASE => CCE[cirioError]; -- shouldn't happen
END;

IndirectSTIndex: PROC[indirectOperatorType: Type, operandType: Type, indirectOperator: Node, operand: Node, cc: CC] RETURNS[Node] =
BEGIN
isrData: IndirectSRData ¬ NARROW[CedarCode.GetDataFromNode[indirectOperator]];
index: CARD ¬ CedarCode.NodeAsIndex[operandType, operand, cc];
indirectTag: Node ¬ isrData.procs.selectTag[isrData.procsData, cc];
indirectTagType: Type ¬ CedarCode.GetTypeOfNode[indirectTag];
tag: Node ¬ CedarCode.LoadThroughIndirectNode[indirectTagType, indirectTag, cc];
limit: CARD ¬ CedarCode.NodeAsIndex[operandType, tag, cc];

IF index >= limit THEN CCE[operation, "bounds check"];
RETURN[isrData.procs.selectTailEntry[index, isrData.procsData, cc]];
END;

IndirectSTShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] =
BEGIN
CCE[cirioError]; -- can this happen?    VariantRecordsImpl provides a procedure here.  However, it calls LoadThroughIndirect, which should in turn call IndirectVTLoad.  But, VariantRecordsImpl does not provide IndirectVTLoad.  So, I am unsure.
END;


SRData: TYPE = REF SRDataBody;
SRDataBody: TYPE = RECORD[
procs: REF SRNodeProcs,
procsData: REF ANY,
tail: Node];

SRNodeProcs: TYPE = RECORD[
extractPreamble: PROC[procsData: REF ANY, cc: CC] RETURNS[CirioTypes.Node],
extractTag: PROC[procsData: REF ANY, cc: CC] RETURNS[CirioTypes.Node],
extractTailEntry: PROC[index: CARD, procsData: REF ANY, cc: CC] RETURNS[CirioTypes.Node]];

CreateSequenceRecordNode: PROC[type: Type, procs: REF SRNodeProcs, procsData: REF ANY, cc: CC, alreadyLoaded: BOOLEAN] RETURNS[Node] =
BEGIN
srData: SRData ¬ NEW[SRDataBody¬[procs, procsData, NIL]];
srTypeInfo: SRInfo ¬ NARROW[CCTypes.GetProcDataFromGroundType[type, cc]];
srData.tail ¬ CreateSequenceRecordTailNode[srTypeInfo.tailType, srData, cc];
RETURN[CedarCode.CreateCedarNode[SequenceRecordOps, type, srData]];
END;

SequenceRecordOps: REF CedarCode.OperationsBody ¬ NEW[CedarCode.OperationsBody¬[
forceIn: SRForceIn,
extractField: SRExtractField,
show: SRShow]];

SRForceIn: PROC[type: Type, node: Node, cc: CC] RETURNS[Node] =
{CCE[unimplemented, "can not force in a sequence record"]};

SRExtractField: PROC[id: Rope.ROPE, type: Type, node: Node, cc: CC] RETURNS[Node] =
BEGIN
srData: SRData ¬ NARROW[CedarCode.GetDataFromNode[node]];
SELECT TRUE FROM
Rope.Equal[id, "&Preamble"] => RETURN[srData.procs.extractPreamble[srData.procsData, cc]];
Rope.Equal[id, "&Tail"] => RETURN[srData.tail];
ENDCASE => CCE[cirioError]; -- shouldn't happen
END;

SRShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {
srData: SRData ¬ NARROW[CedarCode.GetDataFromNode[node]];
to.PutChar['[];
IF depth = 0 THEN to.PutRope["..."] ELSE {
CedarCode.ShowNode[to, srData.procs.extractPreamble[srData.procsData, cc], depth-1, width, cc];
to.PutChar[',];
CedarCode.BreakShowNode[to, srData.tail, depth-1, width, cc, " "]};
to.PutChar[']];
RETURN};


CreateSequenceRecordTailNode: PROC[tailType: Type, srData: SRData, cc: CC] RETURNS[Node] =
BEGIN
node: Node ¬ CedarCode.CreateCedarNode[SRTOps, tailType, srData];
RETURN[node];
END;

SRTOps: REF CedarCode.OperationsBody ¬ NEW[CedarCode.OperationsBody¬[
forceIn: SRTForceIn,
extractField: SRTExtractField,
apply: SRTApply,
show: SRTShow]];

SRTForceIn: PROC[type: Type, node: Node, cc: CC] RETURNS[Node] =
{CCE[unimplemented, "can not force in a sequence record"]};

SRTExtractField: PROC[id: Rope.ROPE, type: Type, node: Node, cc: CC] RETURNS[Node] =
BEGIN
srData: SRData ¬ NARROW[CedarCode.GetDataFromNode[node]];
SELECT TRUE FROM
Rope.Equal[id, "&Tag"] => RETURN[srData.procs.extractTag[srData.procsData, cc]];
ENDCASE => CCE[cirioError]; -- shouldn't happen
END;

SRTApply: PROC[operatorType: Type, operandType: Type, operator: Node, operand: Node, cc: CC] RETURNS[Node] =
BEGIN
srData: SRData ¬ NARROW[CedarCode.GetDataFromNode[operator]];
index: CARD ¬ CedarCode.NodeAsIndex[operandType, operand, cc];
tag: Node ¬ srData.procs.extractTag[srData.procsData, cc];
limit: CARD ¬ CedarCode.NodeAsIndex[operandType, tag, cc];

IF index >= limit THEN CCE[operation, "bounds check"];
RETURN[srData.procs.extractTailEntry[index, srData.procsData, cc]];
END;

SRTShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {
srData: SRData ¬ NARROW[CedarCode.GetDataFromNode[node]];
tag: Node ¬ srData.procs.extractTag[srData.procsData, cc];
tagType: Type ¬ CedarCode.GetTypeOfNode[tag];
limit: CARD ¬ CedarCode.NodeAsIndex[tagType, tag, cc];
to.PutF1["(%g)[", [cardinal[limit]] ];
IF depth = 0 THEN to.PutRope["..."] ELSE {
cWidth: INT ¬ width;
FOR I: CARD IN [0..limit) DO
entry: Node ¬ srData.procs.extractTailEntry[I, srData.procsData, cc];
IF I>0 THEN to.PutChar[',];
IF cWidth < 0 THEN {to.PutRope["..."]; EXIT};
CedarCode.BreakShowNode[to, entry, depth-1, width, cc, " "];
cWidth ¬ cWidth-1;
ENDLOOP;
};
to.PutChar[']];
RETURN};


END.
Ϊ
SequencesImpl.mesa
Copyright Σ 1991, 1992 by Xerox Corporation.  All rights reserved.
Sturgis: February 22, 1989 2:40:32 pm PST
Last changed by Theimer on May 25, 1989 10:38:28 pm PDT
Hopcroft July 26, 1989 10:58:46 am PDT
Spreitze, January 9, 1992 9:05 pm PST
Willie-s, May 14, 1992 12:29 pm PDT

Sequence Record Types

Sequences are a union type.  I have modeled this implementation after that of VariantRecords in VariantRecordsImpl (as of February 8, 1989).

Perhaps here (and there) I should have different type implementations for the union types and the discriminated types?
this creates the union type
Union Tail Type
we use the same info record types for both the union and discriminated types
hopefully this will allow the use of some common procedures


How do I make this a read-only selection?  The run time will prevent any stores, but I should catch them at compile time.  Similarly for the tag fields of variant records!!
Indirect Sequence Nodes

This code is modeled after the code for indirect variant record nodes in VariantRecordsImpl, and the comments there apply here.

Remark: I first attempted to treat these nodes as implemented using record nodes.  This ran into trouble when I tried to create the appropriate record node.  Such a creation requested the appropriate record type.  I have not created such a type.  It is not clear whether I should be supplying a record type, or the indirect sequence type.  It is not clear whether either would have been correct.  I have to re-examine the conventions before I can get away with this.  However, I should do so.


Indirect Sequence Tails
note: this only checks that the supplied operand is within the bounds of the index type of the sequence type (a union type).  We must still perfrom the bounds check for the actual array type supplied.  Perhaps I should in fact make it look like an array type.  But that is not how I have coded it.

Sequence Record Nodes
Sequence Record Tail nodes
note: this only checks that the supplied operand is within the bounds of the index type of the sequence type (a union type).  We must still perfrom the bounds check for the actual array type supplied.  Perhaps I should in fact make it look like an array type.  But that is not how I have coded it.

Κ;•NewlineDelimiter

–
(cedarcode) style™
codeš
œ™Kšœ
Οe
œ7™BKš
œ)™)K™7K™&K™%K™#—K˜š
Οk	˜	Kšœžœͺžœ˜ΥKšœ
žœΔ
˜Σ
Kšœžœ˜*Kšœžœ.˜>Kšžœ
˜Kš
œ˜Kšœ
žœ%˜4—K˜šΟn
œžœ
ž˜Kšžœžœ˜$Kšžœ
˜—Kšœž˜K˜Kšžœžœ˜&Kšœžœ˜Kšœžœ˜Kšœžœ˜'Kšœžœ˜Kšœžœ˜Kšžœžœ&žœžœ˜NKšœ
žœ˜$K˜K™Kš
œ™™Kš
œŒ
™Œ
K™Kš
œv™vK˜K˜Kšœžœžœ˜šœžœžœ
˜K˜K˜Kšœžœ˜'K˜Kšœžœ
˜Kš
œ˜Kšœžœ
žœ˜—˜Kš
œ™—šŸœžœ
žœ žœžœžœ"žœžœ
žœžœ˜Ύ
Kš
ž˜K˜OKšœžœ
žœžœ3˜ZK˜lK˜Kšžœ˜
Kšžœ
˜—K˜K˜K˜šŸœžœžœ˜IK˜,K˜4K˜&K˜,K˜K˜$K˜0K˜(K˜K˜ —K˜šŸœžœžœžœ
žœžœ˜t˜
Kš
ž˜Kšœžœ˜#K˜šžœ0žœ
ž˜?˜Kš
ž˜K˜$K˜$K˜K˜MKšžœžœ
žœ˜"K˜K˜MKšžœžœ
žœ˜"K˜Kšžœžœžœ
žœ˜8Kšžœ˜K˜Kšžœ
˜—Kšžœžœ˜—Kšžœ
˜K˜——šŸœžœžœžœ
žœžœ
žœ
˜g˜
Kš
ž˜Kšœžœ˜#K˜šžœ0žœ
ž˜?˜Kš
ž˜K˜Kš
žœ
žœFžœ
žœ
žœ˜_K˜Kš
žœ
žœFžœ
žœ
žœ˜_K˜Kšžœ
žœ˜
K˜Kšžœ
˜—Kšžœžœ
žœ˜—Kšžœ
˜——K˜K˜šŸœžœžœžœ
žœžœ˜VKš
ž˜Kšœžœ˜ Kšžœ˜Kšžœ
˜K˜—šŸœžœžœžœ
žœžœ
žœžœ
žœ˜iK˜—šŸœžœ%žœžœžœ
žœžœ
˜}Kš
ž˜šžœž˜Kšœžœ˜˜	šžœž˜Kšœžœ˜Kšžœžœ˜——Kšžœžœ
Οc"˜=—Kšžœ
˜K˜—šŸœžœFžœžœ
žœžœ
˜Œ
Kš
ž˜Kšœžœ˜ Kšžœ3˜9Kšžœ
˜K˜—šŸœžœ&žœžœ
žœžœ˜‚
Kš
ž˜Kšœžœ˜ K˜_Kšžœ˜ Kšžœ
˜K˜—šŸœžœ
žœžœžœ
žœžœ
˜pKš
ž˜Kšœžœ˜ K˜šžœ1ž˜7Kšžœ
 3˜9K˜FK˜?K˜3Kšžœ˜Kš
ž˜—šžœ
žœž˜*Kš
ž˜K˜AKšžœ˜Kš
ž˜—Kšžœ
žœ8 #˜cKšžœ
˜—K˜šŸœžœ.žœžœ
žœžœ
˜mKš
ž˜Kšœžœ˜ ˜#K˜K˜2—Kšžœ6˜<Kšžœ
˜—K˜šŸœžœžœ
žœžœžœžœžœ
žœ˜uKšœžœ˜ Kšœžœ-˜JšŸ	œžœ˜Kš
œ˜K˜Kš
œ)˜)Kš
œ*˜*—šŸ
œžœ˜K˜Kš
œI˜I—šŸ
œžœ˜K˜Kš
œe˜e—K˜Kš
œC˜CK˜Kšžœžœ(˜Hšžœ˜Kš
œ)˜)Kš
œ*˜*—K˜Kšžœ˜—K˜K˜šŸœžœžœ˜QK˜+K˜K˜K˜$K˜K˜'K˜K˜ —K˜šŸœžœžœžœ
žœ,žœ˜uKšœžœ˜ KšžœN˜T—K˜šŸœžœ%žœžœ
žœžœ
žœ˜bKšœžœ˜ Kšžœ5˜;—K˜šŸœžœžœžœžœ
žœžœ
˜tKš
ž˜šžœž˜Kšœžœ˜"˜
šžœž˜Kšœžœ˜Kšžœžœ˜——Kšžœžœ
 "˜=—Kšžœ
˜—K˜šŸœžœ,žœžœ
žœžœ
˜lKšœ
žœ,˜0—K˜K˜šŸœžœ
žœ"žœžœ
žœžœ
˜xKš
ž˜Kšœžœ˜ K˜šžœ1ž˜7Kšžœ
 3˜9K˜MK˜WK˜3Kšžœ˜Kš
ž˜šžœ
žœž˜*Kš
ž˜K˜HKšžœ˜Kš
ž˜——Kšžœ
žœ8 #˜cKšžœ
˜—K˜šŸœžœ.žœžœ
žœžœ
˜nKš
ž˜Kšœžœ˜ ˜#K˜K˜1—KšžœO˜UKšžœ
˜—K˜—š
œ™˜Kš
œL™LKš
œ;™;K™—Kšœžœžœ˜&šœžœžœ
˜K˜K˜Kšœžœ
˜K˜Kšœžœ˜'Kšœžœ
žœ˜—K˜šŸœžœžœžœ"žœžœ
žœžœ˜
Kš
ž˜Kšœžœžœžœ$˜WK˜tK˜Kšžœ˜Kšžœ
˜—K˜šŸœžœžœ˜HK˜.K˜K˜&K˜&K˜2K˜*K˜K˜—K˜šŸœžœžœžœ
žœžœ˜v˜
Kš
ž˜Kšœžœ˜+šžœ0žœ
ž˜?˜Kš
ž˜K˜$K˜$K˜Kšžœ
žœ6žœ
žœ˜LK˜WKšžœžœ
žœ˜"K˜K˜•
Kšžœžœ
žœ˜"K˜Kšžœžœžœ
žœ˜8Kšžœ˜K˜Kšžœ
˜—Kšžœžœ˜—Kšžœ
˜——K˜šŸœžœ%žœžœžœ
žœžœ
˜Kš
ž˜šžœž˜˜šžœž˜Kšœžœ˜Kšžœžœ˜——Kšžœžœ
 "˜=—Kšžœ
˜—K˜šŸœžœFžœžœ
žœžœ
˜Ž
Kš
ž˜Kšœžœ˜(Kšžœi˜oKšžœ
˜—K˜šŸœžœFžœžœ
žœžœ
˜Ž
Kš
ž˜Kšœžœ˜(Kšžœ‚
˜ˆ
Kšžœ
˜—K˜šŸœžœ&žœžœ
žœžœ˜„
Kš
ž˜Kšœžœ˜(Kšžœi˜oKšžœ
˜—K˜šŸœžœ
žœžœžœ
žœžœ
˜rKš
ž˜Kšœžœ˜(šžœ"ž˜(Kš
ž˜K˜@Kšžœ˜#Kš
ž˜Kšžœ
žœ7 #˜b—Kšžœ
˜—K˜šŸœžœ.žœžœ
žœžœ
˜oKš
ž˜Kšœžœ˜(Kšžœ^˜dKšžœ
˜—K˜šŸœžœ.žœžœ
žœžœ
˜oKš
ž˜Kšœžœ˜(Kšžœw˜}Kšžœ
˜—K˜šŸœžœžœ˜IK˜K˜)K˜—K˜šŸœžœ,žœžœ
žœžœ
˜nKšœ
žœ,˜0K™Kš
œ¬
™¬
—šŸœžœ
žœ"žœžœ
žœžœ
˜zKš
ž˜Kšœžœ˜(šžœ"ž˜(Kš
ž˜K˜GKšžœ˜#Kš
ž˜Kšžœ
žœ7 #˜b—Kšžœ
˜—K˜šŸœžœ.žœžœ
žœžœ
˜pKš
ž˜Kšœžœ˜(K˜pKšžœA˜GKšžœ
˜——K˜š
œ™K™Kš
œ™K™Kš
œμ™μK˜Kšœžœ˜2K˜Kšœžœžœ˜.šœžœžœ
˜"K˜Kšœžœ˜Kšœžœ
žœ
˜K˜—K˜K˜šŸœžœ
žœžœžœ
žœžœžœ˜„
Kš
ž˜Kšœžœ7˜RKšœžœ8žœ˜[K˜gK˜TKšžœ˜
šžœ
˜K˜——šŸ
œžœžœ˜LK˜K˜K˜#˜K˜——K™š	Ÿ
ΟbœžœLžœžœ˜‚
Kš
ž˜Kšœ#žœ"˜KKšžœD˜JKšžœ
˜—K˜šŸœžœ-žœžœ˜_Kš
ž˜Kšœžœ*˜JKšžœIžœ˜WKšžœ
˜—K˜š
Ÿœžœ
žœ.žœžœ˜jKš
ž˜Kšœžœ*˜Jšžœ
žœ
ž˜Kšœžœ6˜[Kšœžœ˜8Kšžœžœ ˜/—Kšžœ
˜—K˜šŸœžœžœ
žœžœ	žœžœ˜SK˜Kšžœžœžœ˜0Kš
œ
˜
K˜.K˜@K˜/Kšžœ˜	—K˜šŸ	œžœžœ˜.K˜%K˜K˜)—K˜K˜šŸœžœžœ
žœžœžœ˜PKš
ž˜Kšœžœ˜,K˜MK˜GKšžœP˜VKšžœ
˜—K˜šŸœžœžœ
žœžœžœ˜KKš
ž˜Kšœžœ˜,K˜CK˜=KšžœF˜LKšžœ
˜—K˜šŸœžœžœ
žœ
žœžœžœ˜^Kš
ž˜Kšœžœ˜,K˜RK˜AKšžœJ˜PKšžœ
˜——K˜K™š
œ™K˜šŸœžœ,žœžœ˜_Kš
ž˜K˜`Kšžœ˜
Kšžœ
˜—K˜šŸ
œžœžœ˜LK˜K˜#K˜K˜—K˜šŸœžœ-žœžœ˜TKš
ž˜Kšžœ J˜\Kšžœ
˜—K˜š
Ÿœžœ
žœ.žœžœ˜jKš
ž˜Kšœžœ*˜Jšžœ
žœ
ž˜Kšœžœ1˜QKšžœžœ ˜/—Kšžœ
˜—K˜šŸœžœ[žœžœ˜ƒ
Kš
ž˜Kšœžœ.˜Nšœžœ3˜>Kš
œ©™©—K˜CK˜=K˜PKšœžœ/˜:K˜Kšžœžœ
žœ˜6Kšžœ>˜DKšžœ
˜—K˜šŸœžœžœ
žœžœ	žœžœ˜QKš
ž˜Kšžœ β
˜σ
Kšžœ
˜——K™š
œ™K˜K˜Kšœžœžœ˜šœžœžœ
˜Kšœžœ
˜Kšœžœ
žœ
˜K˜—K˜šœ
žœžœ
˜Kšœžœžœ
žœžœžœ˜KKšœžœžœ
žœžœžœ˜FKš
œžœžœ
žœ
žœžœžœ˜Z—K˜šŸœžœžœžœ
žœžœžœžœ˜†
Kš
ž˜Kšœžœžœ˜9Kšœžœ.˜IK˜LKšžœ=˜CKšžœ
˜K˜—šŸœžœžœ˜PK˜K˜K˜—K˜šŸ	œžœžœžœ˜?Kšœ
žœ7˜;—K˜š
Ÿœžœ
žœžœžœ˜SKš
ž˜Kšœžœ"˜9šžœ
žœ
ž˜Kšœžœ5˜ZKšœžœ˜/Kšžœžœ ˜/—Kšžœ
˜—K˜šŸœžœžœ
žœžœ	žœžœ˜KKšœžœ"˜9K˜šžœžœžœ˜*K˜_K˜Kš
œC˜C—K˜Kšžœ˜—K˜—š
œ™K˜šŸœžœ%žœžœ˜ZKš
ž˜K˜AKšžœ˜
Kšžœ
˜—K˜šŸœžœžœ˜EK˜K˜K˜˜K˜——šŸ
œžœžœžœ˜@Kšœ
žœ7˜;—K˜š
Ÿœžœ
žœžœžœ˜TKš
ž˜Kšœžœ"˜9šžœ
žœ
ž˜Kšœžœ0˜PKšžœžœ ˜/—Kšžœ
˜—K˜šŸœžœKžœžœ˜lKš
ž˜Kšœžœ&˜=šœžœ3˜>Kš
œ©™©—K˜:Kšœžœ/˜:K˜Kšžœžœ
žœ˜6Kšžœ=˜CKšžœ
˜—K˜šŸœžœžœ
žœžœ	žœžœ˜LKšœžœ"˜9K˜:K˜-Kšœžœ+˜6K˜&šžœžœžœ˜*Kšœžœ	˜š	žœ
Ÿ
œžœ
žœž˜K˜EKšžœžœ˜Kšžœžœžœ˜-Kš
œ<˜<K˜Kšžœ
˜—Kš
œ˜—K˜Kšžœ˜K˜—K˜—K™Kšžœ
˜—…—[0|E