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.PutF["(%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 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

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

™
codeš
œ™K™<Kš
œ)™)K™7K™&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š
œp˜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šœ
˜—…—[.{ύ