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];
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?
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];
this creates the union type
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;
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
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"]};
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!!
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;
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.
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];
IndirectSROps:
REF CedarCode.OperationsBody ←
NEW[CedarCode.OperationsBody←[
unaryOp: IndirectSRUnaryOp,
load: IndirectSRLoad,
selectField: IndirectSRSelectField,
IndirectSR
UnaryOp:
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;
Indirect Sequence Tails
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];
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.
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;
Sequence Record Nodes
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};
Sequence Record Tail nodes
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,
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];
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.
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};