ArraysImpl.mesa
Copyright Ó 1990 by Xerox Corporation. All rights reserved.
Sturgis, March 4, 1989 1:22:52 pm PST
Last changed by Theimer on May 25, 1989 3:11:53 pm PDT
Hopcroft July 26, 1989 10:41:38 am PDT
Spreitze, January 9, 1992 9:52 am PST
DIRECTORY
Arrays USING[ArrayIndirectNodeInfo, ArrayTypeProcs],
CCTypes USING[AsIndexSet, BinaryTargetTypes, BreakPrintType, CCError, CCErrorCase, CCTypeProcs, CheckConformance, CheckFamilyInclusion, CoerceToType, ConformanceCheck, ContainsVariance, CreateCedarType, GetIndirectType, GetNElements, GetProcDataFromGroundType, GetRTargetType, LR, GetGroundTypeClass, sia],
CirioSyntacticOperations USING[CompileForRHS, ParseTree],
CirioTypes USING[CompilerContext, Mem, Node, Type, TypedCode],
CedarCode USING[AMNodeConstructArrayNode, Code, CodeToDoApply, CodeToDoIndex, CodeToExtractField, ConcatCode, CreateCedarNode, ForceNodeIn, GetDataFromNode, GetTypeOfNode, LoadThroughIndirectNode, NodeAsIndex, OperationsBody, Operator, ShowNode, ShowNodeBracketed, StoreThroughIndirectNode],
IO,
Records USING[CreateRecordType, RecordTypeProcs],
Rope,
StructuredStreams;
ArraysImpl: CEDAR PROGRAM
IMPORTS CCTypes, CedarCode, CirioSyntacticOperations, IO, Records, Rope, StructuredStreams
EXPORTS Arrays
= BEGIN OPEN CSO: CirioSyntacticOperations, SS: StructuredStreams;
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;
Array types
ArrayTypeInfo: TYPE = REF ArrayTypeInfoBody;
ArrayTypeInfoBody: TYPE = RECORD[
containsVariance: VarianceInfo,
procs: REF Arrays.ArrayTypeProcs,
suppliedndexSet: Type,
actualIndexSet: Type,
indexRecord: Type,
self: Type,
indirectType: Type,
data: REF ANY];
VarianceInfo: TYPE = {dontKnow, deciding, yes, no};
CreateArrayType: PUBLIC PROC[indexSet: Type, procs: REF Arrays.ArrayTypeProcs, cc: CC, data: REF ANY] RETURNS[Type] =
BEGIN
ati: ArrayTypeInfo ← NEW[ArrayTypeInfoBody ← [dontKnow, procs, indexSet, CCTypes.AsIndexSet[indexSet, cc], NIL, NIL, NIL, data]];
type: Type ← ati.self ← CCTypes.CreateCedarType[$array, ArrayTypeCCTypeProcs, IndirectArrayCCTypeProcs, cc, ati];
ati.indexRecord ← Records.CreateRecordType[IndexRecordTypeProcs, cc, ati];
RETURN[type];
END;
ArrayTypeCCTypeProcs: REF CCTypes.CCTypeProcs ← NEW[CCTypes.CCTypeProcs ←[
checkConformance: ArrayCCTypesCheckConformance,
checkFamilyInclusion: ArrayCCTypesCheckFamilyInclusion,
isASingleton: ArrayCCTypesIsASingleton,
binaryOperandTypes: ArrayCCTypesBinaryOperandTypes,
containsVariance: ArrayCCTypesContainsVariance,
operand: ArrayCCTypesOperand,
applyOperand: ArrayCCTypesApplyOperand,
apply: ArrayCCTypesApply,
printType: ArrayCCTypesPrintType]];
ArrayCCTypesCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck]
=
BEGIN
valInfo: ArrayTypeInfo ← NARROW[procData];
WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROM
varInfo: ArrayTypeInfo =>
BEGIN
indexCheck1: CCTypes.ConformanceCheck ← CCTypes.CheckConformance[varInfo.actualIndexSet, valInfo.actualIndexSet, cc];
indexCheck2: CCTypes.ConformanceCheck ← CCTypes.CheckConformance[valInfo.actualIndexSet, varInfo.actualIndexSet, cc];
entryCheck: CCTypes.ConformanceCheck ← CCTypes.CheckConformance[valInfo.procs.getEntryType[cc, valInfo.data], varInfo.procs.getEntryType[cc, varInfo.data], cc];
IF indexCheck1 = no OR indexCheck2 = no OR entryCheck = no THEN RETURN[no];
IF indexCheck1 = dontKnow OR indexCheck2 = dontKnow OR entryCheck = dontKnow THEN RETURN[dontKnow];
RETURN[yes];
END;
ENDCASE => RETURN[no];
END;
ArrayCCTypesCheckFamilyInclusion: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[BOOLEAN]
=
BEGIN
valInfo: ArrayTypeInfo ← NARROW[procData];
WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROM
varInfo: ArrayTypeInfo =>
BEGIN
IF NOT CCTypes.CheckFamilyInclusion[valInfo.actualIndexSet, varInfo.actualIndexSet, cc] THEN RETURN[FALSE]; -- NOTE we know that the actualIndexSet will be a singleton Cedar Type family, hence we need not check in the opposite direction.
IF NOT CCTypes.CheckFamilyInclusion[valInfo.procs.getEntryType[cc, valInfo.data], varInfo.procs.getEntryType[cc, varInfo.data], cc] THEN RETURN[FALSE];
RETURN[TRUE];
END;
ENDCASE => RETURN[FALSE];
END;
ArrayCCTypesIsASingleton: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[BOOLEAN]
= {RETURN [ArrayCCTypesContainsVariance[type, cc, procData]=oldCrocky]};
oldCrocky: BOOL ← FALSE;
ArrayCCTypesContainsVariance: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[BOOLEAN] =
BEGIN
info: ArrayTypeInfo ← NARROW[procData];
BEGIN
ENABLE UNWIND =>
BEGIN
IF info.containsVariance = deciding THEN info.containsVariance ← dontKnow;
END;
IF info.containsVariance = deciding THEN CCE[cirioError]; -- shouldnt happen
IF info.containsVariance = dontKnow THEN
BEGIN
info.containsVariance ← deciding;
IF CCTypes.ContainsVariance[info.procs.getEntryType[cc, info.data], cc] THEN
info.containsVariance ← yes ELSE info.containsVariance ← no;
END;
RETURN[info.containsVariance = yes];
END;
END;
by the time we get here left should an array type
ArrayCCTypesBinaryOperandTypes: PROC[op: Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.BinaryTargetTypes] =
BEGIN
info: ArrayTypeInfo ← NARROW[procData];
RETURN[[left, info.actualIndexSet]];
END;
ArrayCCTypesOperand: PROC[op: Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: ArrayTypeInfo ← NARROW[procData];
SELECT op FROM
$apply =>
SELECT lr FROM
left => RETURN[tc];
ENDCASE => CCE[operation];
ENDCASE => CCE[operation];
END;
ArrayCCTypesApplyOperand: PROC[operatorType: Type, operand: CirioSyntacticOperations.ParseTree, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: ArrayTypeInfo ← NARROW[procData];
tc1: TypedCode ← CSO.CompileForRHS[operand, info.indexRecord, cc];
tc2: TypedCode ← CCTypes.CoerceToType[info.indexRecord, tc1, cc];
code: Code ← CedarCode.ConcatCode[
tc2.code,
CedarCode.CodeToExtractField["", tc2.type]];
RETURN[[code, info.actualIndexSet]];
END;
ArrayCCTypesApply: PROC[operator: TypedCode, operand: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: ArrayTypeInfo ← NARROW[procData];
code: Code ← CedarCode.ConcatCode[
operator.code,
CedarCode.ConcatCode[
operand.code,
CedarCode.CodeToDoApply[operator.type, operand.type]]];
type: Type ← info.procs.getEntryType[cc, info.data];
RETURN[[code, type]];
END;
ArrayCCTypesPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] = {
info: ArrayTypeInfo ← NARROW[procData];
to.PutRope["ARRAY"];
CCTypes.BreakPrintType[to, info.actualIndexSet, 1, printWidth, cc, " "];
to.PutRope[" OF"];
CCTypes.BreakPrintType[to, info.procs.getEntryType[cc, info.data], printDepth-1, printWidth, cc, " "];
RETURN};
record type for index
IndexRecordTypeProcs: REF Records.RecordTypeProcs ← NEW[Records.RecordTypeProcs ← [
getPaint: IndexRecordGetPaint,
comparePaint: IndexRecordComparePaint,
nFields: IndexRecordnFields,
fieldIndexToName: IndexRecordFieldIndexToName,
nameToFieldIndex: IndexRecordNameToFieldIndex,
fieldIndexToType: IndexRecordFieldIndexToType]];
IndexRecordGetPaint: PROC[data: REF ANY] RETURNS[REF ANY] =
{RETURN[NIL]};
IndexRecordComparePaint: PROC[data: REF ANY, otherPaint: REF ANY] RETURNS[BOOLEAN] =
{RETURN[otherPaint = NIL]};
IndexRecordnFields: PROC[data: REF ANY] RETURNS[INT] =
{RETURN[1]};
IndexRecordFieldIndexToName: PROC[index: INT, data: REF ANY] RETURNS[Rope.ROPE] =
{RETURN[IF index = 0 THEN "" ELSE CCE[operation]]};
IndexRecordNameToFieldIndex: PROC[name: Rope.ROPE, data: REF ANY] RETURNS[INT] =
{RETURN[IF Rope.Equal[name, ""] THEN 0 ELSE CCE[operation]]};
IndexRecordFieldIndexToType: PROC[index: INT, cc: CC, data: REF ANY] RETURNS[CirioTypes.Type] =
BEGIN
info: ArrayTypeInfo ← NARROW[data];
RETURN[info.actualIndexSet];
END;
indirect array types
IndirectArrayCCTypeProcs: REF CCTypes.CCTypeProcs ← NEW[CCTypes.CCTypeProcs ←[
createIndirectNode: CreateIndirectArray,
getBitSize: ArrayBitSize,
operand: IndirectArrayCCTypesOperand,
indexOperand: ArrayCCTypesApplyOperand, -- code was identical, so used the same procedure
index: IndirectArrayCCTypesIndex,
printType: ArrayCCTypesPrintType]];
CreateIndirectArray: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
info: ArrayTypeInfo ← NARROW[procData];
RETURN info.procs.createIndirectNode[cc, info.data, indirectType, targetType, mem]};
ArrayBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ {
info: ArrayTypeInfo ← NARROW[procData];
RETURN info.procs.getBitSize[indirectType, cc, info.data]};
IndirectArrayCCTypesOperand: PROC[op: Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
SELECT op FROM
$index =>
SELECT lr FROM
left => RETURN[tc];
ENDCASE => CCE[operation];
$address => RETURN [tc];
ENDCASE => CCE[operation, "illegal operation"]; -- client error, illegal operation
END;
IndirectArrayCCTypesIndex: PROC[operator: TypedCode, operand: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: ArrayTypeInfo ← NARROW[procData];
code: Code ← CedarCode.ConcatCode[
operator.code,
CedarCode.ConcatCode[
operand.code,
CedarCode.CodeToDoIndex[operator.type, operand.type]]];
type: Type ← info.procs.getEntryType[cc, info.data];
RETURN[[code, CCTypes.GetIndirectType[type]]];
END;
indirect array nodes
CreateArrayIndirectNode: PUBLIC PROC[type: Type, info: Arrays.ArrayIndirectNodeInfo] RETURNS[Node] =
BEGIN
RETURN[CedarCode.CreateCedarNode[ArrayIndirectOps, type, info]];
END;
ArrayIndirectOps: REF CedarCode.OperationsBody ← NEW[CedarCode.OperationsBody ←[
unaryOp: ArrayIndirectUnaryOp,
store: ArrayIndirectStore,
load: ArrayIndirectLoad,
index: ArrayIndirectIndex,
show: ArrayIndirectShow
]];
ArrayIndirectUnaryOp: PROC [op: CedarCode.Operator, type: CirioTypes.Type, node: CirioTypes.Node, cc: CC] RETURNS [CirioTypes.Node] =
BEGIN
indirectNodeData: Arrays.ArrayIndirectNodeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
RETURN[indirectNodeData.getPointer[indirectNodeData.data, cc]];
END;
ArrayIndirectStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] =
BEGIN
valTypeInfo: ArrayTypeInfo ← NARROW[CCTypes.GetProcDataFromGroundType[valType, cc]];
valNodeData: REF ArrayData ← NARROW[CedarCode.GetDataFromNode[valNode]];
indirectNodeData: Arrays.ArrayIndirectNodeInfo ← NARROW[CedarCode.GetDataFromNode[indirectNode]];
nEntries: CARD ← CCTypes.GetNElements[valTypeInfo.actualIndexSet, cc];
FOR I: CARD IN [0..nEntries) DO
indirectField: Node ← indirectNodeData.selectEntry[I, cc, indirectNodeData.data];
indirectFieldType: Type ← CedarCode.GetTypeOfNode[indirectField];
valField: Node ← valNodeData.procs.extractEntry[I, cc, valNodeData.data];
valFieldType: Type ← CedarCode.GetTypeOfNode[valField];
CedarCode.StoreThroughIndirectNode[valFieldType, valField, indirectFieldType, indirectField, cc];
ENDLOOP;
END;
ArrayIndirectLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] =
BEGIN
targetType: Type ← CCTypes.GetRTargetType[indirectType, cc];
data: Arrays.ArrayIndirectNodeInfo ← NARROW[CedarCode.GetDataFromNode[indirectNode]];
RETURN[CreateArrayNode[targetType, DeferedLoadArrayProcs, data, cc, FALSE]]
END;
ArrayIndirectIndex: PROC[indirectOperatorType: Type, operandType: Type, indirectOperator: Node, operand: Node, cc: CC] RETURNS[Node] =
BEGIN
aiData: Arrays.ArrayIndirectNodeInfo ← NARROW[CedarCode.GetDataFromNode[indirectOperator]];
index: CARD ← CedarCode.NodeAsIndex[operandType, operand, cc];
RETURN[aiData.selectEntry[index, cc, aiData.data]];
END;
ArrayIndirectShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {
aiData: Arrays.ArrayIndirectNodeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
iaType: Type ← CedarCode.GetTypeOfNode[node];
array: Node ← CedarCode.LoadThroughIndirectNode[iaType, node, cc];
to.PutChar['^];
CedarCode.ShowNode[to, array, depth, width, cc];
RETURN};
DeferedLoadArrayProcs: REF ArrayNodeProcs ← NEW[ArrayNodeProcs ←[
extractEntry: DeferedLoadArrayExtractEntry]];
DeferedLoadArrayExtractEntry: PROC[index: CARD, cc: CC, data: REF ANY] RETURNS[Node] =
BEGIN
info: Arrays.ArrayIndirectNodeInfo ← NARROW[data];
indirectEntry: Node ← info.selectEntry[index, cc, info.data];
indirectEntryType: Type ← CedarCode.GetTypeOfNode[indirectEntry];
RETURN[CedarCode.LoadThroughIndirectNode[indirectEntryType, indirectEntry, cc]];
END;
Array Nodes
ArrayData: TYPE = RECORD[
type: Type,
alreadyLoaded: BOOLEAN,
procs: REF ArrayNodeProcs,
data: REF ANY];
ArrayNodeProcs: TYPE = RECORD[
extractEntry: PROC[index: CARD, cc: CC, data: REF ANY] RETURNS[Node]];
ArrayOps: REF CedarCode.OperationsBody ← NEW[CedarCode.OperationsBody←[
forceIn: ArrayForceIn,
apply: ArrayApply,
show: ArrayShow]];
CreateArrayNode: PROC[arrayType: CirioTypes.Type, procs: REF ArrayNodeProcs, data: REF ANY, cc: CC, alreadyLoaded: BOOLEAN] RETURNS[CirioTypes.Node] =
BEGIN
node: Node ← CedarCode.CreateCedarNode[ArrayOps, arrayType, NEW[ArrayData ← [arrayType, alreadyLoaded, procs, data]]];
RETURN[node];
END;
ArrayForceIn: PROC[type: Type, node: Node, cc: CC] RETURNS[Node] =
BEGIN
data: REF ArrayData ← NARROW[CedarCode.GetDataFromNode[node]];
IF data.alreadyLoaded THEN RETURN[node]
ELSE
BEGIN
typeInfo: ArrayTypeInfo ← NARROW[CCTypes.GetProcDataFromGroundType[type, cc]];
nEntries: CARD ← CCTypes.GetNElements[typeInfo.actualIndexSet, cc];
entries: LIST OF CirioTypes.Node ← NIL;
FOR I: CARD DECREASING IN [0..nEntries) DO
nominalEntry: CirioTypes.Node ← data.procs.extractEntry[I, cc, data.data];
entryType: CirioTypes.Type ← CedarCode.GetTypeOfNode[nominalEntry];
entry: CirioTypes.Node ← CedarCode.ForceNodeIn[entryType, nominalEntry, cc];
entries ← CONS[entry, entries];
ENDLOOP;
RETURN[ConstructArrayNode[type, entries, cc]];
END;
END;
ArrayApply: PROC[operatorType: Type, operandType: Type, operator: Node, operand: Node, cc: CC] RETURNS[Node] =
BEGIN
data: REF ArrayData ← NARROW[CedarCode.GetDataFromNode[operator]];
typeInfo: ArrayTypeInfo ← NARROW[CCTypes.GetProcDataFromGroundType[operatorType, cc]];
index: CARD ← CedarCode.NodeAsIndex[operandType, operand, cc];
RETURN[data.procs.extractEntry[index, cc, data.data]];
END;
ArrayShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {
data: REF ArrayData ← NARROW[CedarCode.GetDataFromNode[node]];
typeInfo: ArrayTypeInfo ← NARROW[CCTypes.GetProcDataFromGroundType[data.type, cc]];
nEntries: CARD ← CCTypes.GetNElements[typeInfo.actualIndexSet, cc];
cWidth: INT ← width;
iwidth: INT ← IF nEntries>1 THEN (width*2)/3 ELSE width;
to.PutF["(%g)[", [cardinal[nEntries]] ];
IF depth < 1 THEN to.PutRope["..."]
ELSE FOR I: CARD IN [0..nEntries) DO
entry: Node ← data.procs.extractEntry[I, cc, data.data];
IF I>0
THEN {to.PutChar[',]; SS.Bp[to, lookLeft, CCTypes.sia, " "]}
ELSE SS.Bp[to, lookLeft, CCTypes.sia];
IF cWidth < 0 THEN {to.PutRope["..."]; EXIT}
ELSE CedarCode.ShowNodeBracketed[to, entry, depth-1, iwidth, cc];
cWidth ← cWidth-1;
ENDLOOP;
to.PutChar[']];
RETURN};
Constructed Arrays
ConstructArrayNode: PUBLIC PROC[arrayType: CirioTypes.Type, entries: LIST OF CirioTypes.Node, cc: CC] RETURNS[CirioTypes.Node] =
BEGIN
there is a possibility that we did not have full information about the entires at compile time.
if so, the first entry will be of class $amnode. [we never permit amnodes to appear in arrays?]
this is a lousy design. There should be a more explicity decision at compile time that this is what we are going to do, and compile time should have generated a different operation. But this will do for now.
this design is copied from RecordsImpl, in which one will find similar remarks.
Both should be fixed at the same time
IF entries = NIL OR CCTypes.GetGroundTypeClass[CedarCode.GetTypeOfNode[entries.first], cc] # $amnode THEN
BEGIN
typeInfo: ArrayTypeInfo ← NARROW[CCTypes.GetProcDataFromGroundType[arrayType, cc]];
nEntries: CARD ← CCTypes.GetNElements[typeInfo.actualIndexSet, cc];
ca: ConstructedArray ← NEW[ConstructedArrayBody[nEntries]];
entryIndex: CARD ← 0;
FOR ln: LIST OF CirioTypes.Node ← entries, ln.rest WHILE ln # NIL DO
ca[entryIndex] ← ln.first;
entryIndex ← entryIndex + 1;
ENDLOOP;
IF entryIndex # nEntries THEN CCE[operation, "not enough entries supplied"];
RETURN[CreateArrayNode[arrayType, ConstructedArrayProcs, ca, cc, TRUE]];
END
ELSE
BEGIN -- first entry is an amnode. We assume that they all are. We uncrate them and recompile. BUT, somehow this code should be in the Node implmentation. (See similar remarks in RecordsImpl.)
RETURN[CedarCode.AMNodeConstructArrayNode[arrayType, entries, cc]];
END;
END;
ConstructedArray: TYPE = REF ConstructedArrayBody;
ConstructedArrayBody: TYPE = RECORD[
SEQUENCE nEntries: CARDINAL OF Node];
ConstructedArrayProcs: REF ArrayNodeProcs ← NEW[ArrayNodeProcs←[
extractEntry: CAExtractEntry]];
CAExtractEntry: PROC[index: CARD, cc: CC, data: REF ANY] RETURNS[CirioTypes.Node] =
BEGIN
ca: ConstructedArray ← NARROW[data];
RETURN[ca[index]];
END;
END.