AmpersandContextImpl.mesa
Copyright Ó 1990 by Xerox Corporation. All rights reserved.
Sturgis, March 16, 1989 9:29:11 am PST
Last changed by Theimer on June 11, 1989 1:42:09 pm PDT
Hopcroft July 26, 1989 10:22:58 am PDT
Last tweaked by Mike Spreitzer on January 9, 1992 2:28 pm PST
Laurie Horton, September 16, 1991 12:53 pm PDT
DIRECTORY
AmpersandContext USING[],
CCTypes USING[BinaryTargetTypes, CCError, CCErrorCase, CCTypeProcs, CheckConformance, ConformanceCheck, Conforms, CreateCedarType, DoObject, GetAmpersandContextType, GetAmpersandVarType, GetIndirectType, GetLTargetType, GetTargetTypeOfIndirect, GetNodeType, GetRTargetType, GetTypeClass, GetWrongType, LR, GetGroundTypeClass, sia],
CedarCode USING[BreakShowNode, CodeToLoadThroughIndirect, ConcatCode, CodeToDoApply, CodeToDoBinaryOp, CodeToDoIndex, CodeToDoUnaryOp, CodeToExtractField, CodeToLoadContentsOfAMNode, CodeToSelectField, CodeToStoreUnpopped, CreateCedarNode, ExamineParseTree, GetCurrentTypeOfNode, GetDataFromNode, GetTypeOfNode, Interpret, OperationsBody, Operator, ShowNodeBracketed],
CedarOtherPureTypes USING[CreateParseTreeNode],
CirioSyntacticOperations USING[CreateParseTree, ParseTreeFunctions, ParseTree, LHSapply, LHSFieldIdentifier, RHSApply, RHSAssignment, RHSConstructor, RHSBinaryOp, RHSFieldIdentifier, RHSUnaryOp],
CirioTypes USING[Code, CompilerContext, ConformanceCheck, Node, Type, TypeClass, TypedCode],
IO,
Rope,
StructuredStreams,
SymTab USING[Create, Fetch, Insert, Ref, Key, Val, Pairs];
AmpersandContextImpl:
CEDAR
PROGRAM
IMPORTS CCTypes, CedarCode, CedarOtherPureTypes, CirioSyntacticOperations, IO, Rope, StructuredStreams, SymTab
EXPORTS AmpersandContext, CedarCode
= BEGIN OPEN CCTypes, CedarCode, CirioTypes, CSO:CirioSyntacticOperations, SS:StructuredStreams;
CC: TYPE = CirioTypes.CompilerContext;
CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE ← NIL] ← CCTypes.CCError;
this module contains both the type information and the implementation of the op codes
Type information
CreateAmpersandContextType:
PUBLIC
PROC[cc:
CC]
RETURNS[CirioTypes.Type] =
BEGIN
nominal: Type ← CCTypes.GetAmpersandContextType[cc];
IF nominal # NIL THEN RETURN[nominal];
RETURN[CCTypes.GetIndirectType[CCTypes.CreateCedarType[$ampersandContext, AmpersandContextDirectTypeProcs, AmpersandContextIndirectTypeProcs, cc]]];
END;
the only kind of ampersandContext values that can appear on an expression stack (or in a Node) are indirects to ampersandContexts.
the only legal operation on an ampersandContext is to select a field named by an ampersand identifier.
AmpersandContextDirectTypeProcs:
REF CCTypeProcs ←
NEW[CCTypeProcs ←[
checkConformance: AmpersandContextCheckConformance]];
AmpersandContextIndirectTypeProcs:
REF CCTypeProcs ←
NEW[CCTypeProcs ←[
selectIdField: AmpersandContextSelectIdField,
getScopeIndex: AmpersandContextGetScopeIndex]];
AmpersandContextCheckConformance:
PROC[valType, varType: Type, cc:
CC, procData:
REF
ANY]
RETURNS[ConformanceCheck] ~ {
IF GetTypeClass[varType] = $ampersandContext
THEN RETURN [yes]
ELSE RETURN [no];
};
AmpersandContextSelectIdField:
PROC[id: Rope.
ROPE, fieldIndirectContext: Type, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
SELECT Rope.Fetch[id, 0] FROM
'&, '← => {
-- we are expected to look into the ampersand context
an ampersand name is always defined and always has type AmpersandVar
(AmpersandVars always contain Nodes)
code: Code ← CedarCode.CodeToSelectField[id, GetAmpersandContextType[cc]];
type: Type ← GetAmpersandVarType[cc];
RETURN[[code, type]]};
ENDCASE => CCE[cirioError];
END;
AmpersandContextGetScopeIndex:
PROC [type: Type, cc:
CC, procData:
REF
ANY]
RETURNS [
CARD] =
BEGIN
RETURN [0];
END;
interpretation time
CreateAnAmpersandContext:
PUBLIC
PROC [cc:
CC]
RETURNS[CirioTypes.Node] =
BEGIN
table: SymTab.Ref ← SymTab.Create[];
t: Type ← GetAmpersandContextType[cc];
RETURN[CreateCedarNode[AmpersandContextOps, t, table]];
END;
AmpersandContextOps:
REF OperationsBody ←
NEW[OperationsBody←[
getCurrentType: AmpersandContextGetCurrentType,
selectField: AmpersandContextSelectField,
show: AmpersandContextShow]];
This is the default version. It assumes that the target type is not a union type.
AmpersandContextGetCurrentType:
PROC[node: Node, cc:
CC]
RETURNS[Type] =
{RETURN[GetTypeOfNode[node]]};
AmpersandContextSelectField:
PROC[id: Rope.
ROPE, indirectType: Type, indirectNode: Node, cc:
CC]
RETURNS[Node] =
BEGIN
table: SymTab.Ref ← NARROW[CedarCode.GetDataFromNode[indirectNode]];
t: Type ← GetAmpersandVarType[cc];
var: AmpersandVar ← NARROW[SymTab.Fetch[table, id].val];
ict: Type ← GetAmpersandContextType[cc];
ct: Type ← GetTargetTypeOfIndirect[ict];
IF var =
NIL
THEN
BEGIN
var ← NEW[AmpersandVarBody←[table, NIL]];
IF NOT SymTab.Insert[table, id, var] THEN CCE[cirioError];
END;
<<IF CedarCode.GetTypeOfNode[indirectNode] # GetAmpersandContextType[cc] THEN CCE[cirioError]; -- should be a generalized Conforms test>>
IF NOT CCTypes.Conforms[ct, CedarCode.GetTypeOfNode[indirectNode], cc] THEN CCE[cirioError, "an ampersand context vs. CC mismatch"];
RETURN[CreateCedarNode[AmpersandVarOps, t, var]];
END;
AmpersandContextShow:
PROC[to:
IO.
STREAM, node: Node, depth:
INT, width:
INT, cc:
CC] = {
table: SymTab.Ref ← NARROW[CedarCode.GetDataFromNode[node]];
ShowAmpersandVar:
PROC [key: SymTab.Key, val: SymTab.Val]
RETURNS [quit:
BOOL ←
FALSE] = {
var: AmpersandVar ← NARROW[val];
PrintVar:
PROC ~ {
to.PutRope[key];
to.PutChar[':];
SS.Bp[to, width, CCTypes.sia, " "];
IF var.val#
NIL
THEN CedarCode.ShowNodeBracketed[to, var.val, depth, width, cc]
ELSE to.PutRope["--no value--"];
RETURN};
SS.Bp[to, always, CCTypes.sia];
CCTypes.DoObject[to, PrintVar];
RETURN};
to.PutChar['{];
[] ← SymTab.Pairs[table, ShowAmpersandVar];
to.PutChar['}];
RETURN};
AmpersandVars are components of an Ampersand Context (i.e., SymTab.Ref)
AmpersandVars are indirects to nodes
question: can AmpersandVars be made by the default indirect to type mechanism?
AmpersandVarCCTypeProcs:
REF CCTypeProcs ←
NEW[CCTypeProcs ←[
checkConformance: AmpersandVarCheckConformance,
binaryOperandTypes: AmpersandVarBinaryOperandTypes,
operand: AmpersandVarOperand,
store: AmpersandVarStore,
load: AmpersandVarLoad]];
valType is the standard control parameter
AmpersandVarCheckConformance:
PROC[valType, varType: Type, cc:
CC, procData:
REF
ANY]
RETURNS[CCTypes.ConformanceCheck] =
BEGIN
This code should have some how been executed as a result of some sort of default.
I don't at the moment know why I have to put it here.
it should be true of any indirect type
upon modification for LTargetType/RTargetType logic, we treat the target type as a singleton.
valTarget: Type ← CCTypes.GetRTargetType[valType, cc];
varTarget: Type ← CCTypes.GetRTargetType[varType, cc];
conforms1: CCTypes.ConformanceCheck;
conforms2: CCTypes.ConformanceCheck;
conforms1 ← CCTypes.CheckConformance[valTarget, varTarget, cc];
IF conforms1 = no THEN RETURN[no];
conforms2 ← CCTypes.CheckConformance[varTarget, valTarget, cc];
IF conforms2 = no THEN RETURN[no];
IF conforms1 = yes AND conforms2 = yes THEN RETURN[yes];
RETURN[dontKnow];
END;
AmpersandVarBinaryOperandTypes:
PROC[op: Operator, left, right: Type, cc:
CC, procData:
REF
ANY]
RETURNS[BinaryTargetTypes] =
BEGIN
rightClass: CirioTypes.TypeClass ← GetGroundTypeClass[right, cc];
SELECT op
FROM
$assign =>
SELECT rightClass
FROM
$wrong => RETURN[[right, right]];
ENDCASE => RETURN[[left, CCTypes.GetRTargetType[left, cc]]];
ENDCASE => CCE[cirioError];
AmpersandVarOperand:
PROC[op: Operator, lr:
LR, tc: TypedCode, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
SELECT op
FROM
$plus, $minus, $div, $mult, $mod, $le, $lt, $eq, $gt, $ge, $max, $min, $and, $or, $not, $index =>
BEGIN
code: Code ← ConcatCode[tc.code, CodeToLoadThroughIndirect[tc.type]];
type: Type ← GetNodeType[cc];
RETURN[[code, type]];
END;
ENDCASE => CCE[cirioError]; -- shouldn't happen
END;
AmpersandVarStore:
PROC[value: TypedCode, indirect: TypedCode, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
code: Code ← CedarCode.ConcatCode[
indirect.code,
CedarCode.ConcatCode[
value.code,
CedarCode.CodeToStoreUnpopped[indirect.type, value.type]]];
type: Type ← value.type;
we really should make a last ditch type check
RETURN[[code, type]];
END;
AmpersandVarLoad:
PROC[indirect: TypedCode, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
code: Code ← CedarCode.ConcatCode[
indirect.code,
CedarCode.CodeToLoadThroughIndirect[indirect.type]];
type: Type ← CCTypes.GetRTargetType[indirect.type, cc];
RETURN[[code, type]];
END;
There is some question as to who should build the node holding an AmpersandVar. The create node call requires the operations and the type. That would be here? as it stands it is in the Select implementation up above.
AmpersandVar: TYPE = REF AmpersandVarBody;
AmpersandVarBody:
TYPE =
RECORD[
table: SymTab.Ref,
val: Node];
AmpersandVarOps:
REF OperationsBody ←
NEW[OperationsBody←[
load: LoadFromAmpersandVar,
store: StoreToAmpersandVar]];
we get here by an object proc from the indirectNode
AmpersandVars hold only Nodes
we should have to package that node into a containing node for the interpreter.
however, the store routine was careful not to remove the original packaging used by the interpreter, so we do not have to re-install it
other object load routines would have to install such node packaging
LoadFromAmpersandVar:
PROC[indirectType: Type, indirectNode: Node, cc:
CC]
RETURNS[Node] =
BEGIN
var: AmpersandVar ← NARROW[GetDataFromNode[indirectNode]];
IF indirectType # GetTypeOfNode[indirectNode] THEN CCE[cirioError]; -- should be a generalized Conforms test
IF var.val = NIL THEN CCE[operation, "attempt to load from an uninitialized ampersandVar"];
RETURN[var.val];
END;
we get here by an object proc from the indirectNode
valType had better be Node, as well as the type of valNode
by an agreement with the above load routine, we do not strip off the outer layer of node packaging used by the interpreter. However, we would expect to find a node inside this package. Thus, the real value should be at least two node levels deep.
StoreToAmpersandVar:
PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc:
CC] =
BEGIN
var: AmpersandVar ← NARROW[GetDataFromNode[indirectNode]];
IF indirectType # GetTypeOfNode[indirectNode] THEN CCE[cirioError]; -- should be a generalized Conforms test
var.val ← valNode;
END;
Since ampersand vars are really indirects on Nodes, we need node types. (The node operations are currently in CedarCodeImpl.) We put the node type stuff here for the time being.
CreateNodeType:
PUBLIC
PROC[cc:
CC]
RETURNS[CirioTypes.Type] =
BEGIN
nominal: Type ← CCTypes.GetNodeType[cc];
IF nominal # NIL THEN RETURN[nominal];
RETURN[CreateCedarType[$amnode, NodeCCTypeProcs, AmpersandVarCCTypeProcs, cc]];
END;
NodeCCTypeProcs:
REF CCTypeProcs ←
NEW[CCTypeProcs ←[
storable: NodeStorable,
getRTargetType: NodeGetRTargetType,
binaryOperandTypes: NodeBinaryOperandTypes,
operand: NodeOperand,
applyOperand: NodeApplyOperand,
indexOperand: NodeIndexOperand,
coerceToType: NodeCoerceToType,
binaryOp: NodeBinaryOp,
unaryOp: NodeUnaryOp,
store: NodeStore,
extractIdField: NodeExtractIdField,
selectIdField: NodeSelectIdField,
apply: NodeApply,
index: NodeIndex,
printType: NodePrintType]];
NodeStorable:
PROC[valType, indirectType: Type, cc:
CC, procData:
REF
ANY]
RETURNS[
BOOLEAN] =
BEGIN
indirectTypeClass: TypeClass ← GetGroundTypeClass[indirectType, cc];
SELECT indirectTypeClass
FROM
$amnode => RETURN[TRUE];
ENDCASE => RETURN[CCTypes.Conforms[valType, CCTypes.GetLTargetType[indirectType, cc], cc]];
END;
The presumption is that we are compiling some ambiguous text, so the lefthand side of an assignment has produced an indirect packaged inside a node. We are to request that the right hand side also produce its value packaged inside a node. Thus, if the right hand side is a request to load the contents of an AmpersandVar or through a REF ANY, the right thing will happen.
Maybe at some time I should have a type called "packagedInsideANode". I don't know if that can be carried out. This would be similar to have a type called "DeferedLoadRecord".
NodeGetRTargetType:
PROC[type: Type, cc:
CC, procData:
REF
ANY]
RETURNS[Type] =
{RETURN[GetNodeType[cc]]};
the target type must be node
NodeBinaryOperandTypes:
PROC[op: Operator, left, right: Type, cc:
CC, procData:
REF
ANY]
RETURNS[BinaryTargetTypes] =
BEGIN
SELECT op
FROM
$assign => RETURN[[left, left]]; -- is thsi right?
ENDCASE => RETURN[[left, left]];
END;
NodeOperand:
PROC[op: Operator, lr:
LR, tc: TypedCode, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
{RETURN[tc]};
NodeApplyOperand:
PROC[operatorType: Type, operand: CirioSyntacticOperations.ParseTree, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
node: Node ← CedarOtherPureTypes.CreateParseTreeNode[operand, cc];
code: CirioTypes.Code ← CedarCode.CodeToLoadContentsOfAMNode[node];
type: Type ← CCTypes.GetNodeType[cc];
RETURN[[code, type]];
END;
NodeIndexOperand:
PROC[operatorType: Type, operand: CirioSyntacticOperations.ParseTree, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
node: Node ← CedarOtherPureTypes.CreateParseTreeNode[operand, cc];
code: CirioTypes.Code ← CedarCode.CodeToLoadContentsOfAMNode[node];
type: Type ← CCTypes.GetNodeType[cc];
RETURN[[code, type]];
END;
NodeCoerceToType:
PROC[targetType: Type, tc: TypedCode, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
targetClass: TypeClass ← GetGroundTypeClass[targetType, cc];
SELECT targetClass
FROM
$wrong => RETURN[[tc.code, GetWrongType[cc]]];
$amnode => RETURN[tc];
ENDCASE => CCE[cirioError]; -- shouldn't happen (or can it occur due to a client type error?)
END;
NodeBinaryOp:
PROC[op: Operator, left, right: TypedCode, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
code: Code ←
ConcatCode[
left.code,
ConcatCode[
right.code,
CodeToDoBinaryOp[op, left.type, right.type]]];
RETURN[[code, left.type]];
END;
NodeUnaryOp:
PROC[op: Operator, arg: TypedCode, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
code: Code ←
ConcatCode[
arg.code,
CodeToDoUnaryOp[op, arg.type]];
RETURN[[code, arg.type]];
END;
NodeStore:
PROC[value: TypedCode, indirect: TypedCode, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
code: Code ← CedarCode.ConcatCode[
indirect.code,
CedarCode.ConcatCode[
value.code,
CedarCode.CodeToStoreUnpopped[indirect.type, value.type]]];
type: Type ← value.type;
RETURN[[code, type]];
END;
NodeExtractIdField:
PROC[id: Rope.
ROPE, fieldContext: Type, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
code: Code ← CedarCode.CodeToExtractField[id, fieldContext];
RETURN[[code, fieldContext]];
END;
NodeSelectIdField:
PROC[id: Rope.
ROPE, fieldIndirectContext: Type, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
code: Code ← CedarCode.CodeToSelectField[id, fieldIndirectContext];
RETURN[[code, fieldIndirectContext]];
END;
NodeApply:
PROC[operator: TypedCode, operand: TypedCode, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
code: Code ←
CedarCode.ConcatCode[
operator.code,
CedarCode.ConcatCode[
operand.code,
CodeToDoApply[operator.type, operand.type]]];
type: Type ← CCTypes.GetNodeType[cc];
RETURN[[code, type]];
END;
NodeIndex:
PROC[operator: TypedCode, operand: TypedCode, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
code: Code ←
CedarCode.ConcatCode[
operator.code,
CedarCode.ConcatCode[
operand.code,
CodeToDoIndex[operator.type, operand.type]]];
type: Type ← CCTypes.GetNodeType[cc];
RETURN[[code, type]];
END;
NodePrintType:
PROC [to:
IO.
STREAM, type: Type, printDepth:
INT, printWidth:
INT, cc:
CC, procData:
REF
ANY]
= {to.PutRope["Node"]};
Now for the node routines
NodeHolder: TYPE = RECORD[nd: Node];
MakeNodeFromNode:
PUBLIC
PROC[node: Node, cc:
CC]
RETURNS[Node] =
{RETURN[CreateCedarNode[AMNodeOps, CCTypes.GetNodeType[cc], NEW[NodeHolder←[node]]]]};
AMNodeOps:
REF OperationsBody ←
NEW[OperationsBody ←[
makeAMNode: AMNodeMakeAMNode,
examineBoolean: AMNodeExamineBoolean,
coerce: AMNodeCoerce,
binaryOp: AMNodeBinaryOp,
unaryOp: AMNodeUnaryOp,
store: AMNodeStore,
extractField: AMNodeExtractField,
selectField: AMNodeSelectField,
apply: AMNodeApply,
index: AMNodeIndex,
show: AMNodeShow
]];
AMNodeParseTreeFunctions:
REF
CSO.ParseTreeFunctions ←
NEW[
CSO.ParseTreeFunctions ← [
AMNodeCompileForRHS,
AMNodeCompileForLHS]];
CreateAMNodeParseTree:
PROC[node: Node, cc:
CC]
RETURNS[
CSO.ParseTree] =
{RETURN[CSO.CreateParseTree[AMNodeParseTreeFunctions, NEW[NodeHolder←[node]]]]};
AMNodeMakeAMNode:
PROC[sourceType: Type, node: Node, cc:
CC]
RETURNS[Node] =
{RETURN[MakeNodeFromNode[node, cc]]};
AMNodeExamineBoolean:
PROC[node: Node, cc:
CC]
RETURNS[
BOOLEAN] =
{CCE[cirioError]}; -- shouldnt happen
AMNodeCoerce:
PROC[sourceType, targetType: Type, node: Node, cc:
CC]
RETURNS[Node] =
{CCE[cirioError]}; -- shouldnt happen ???
AMNodeBinaryOp:
PROC[op: CedarCode.Operator, leftType, rightType: Type, leftNode, rightNode: Node, cc:
CC]
RETURNS[Node] =
BEGIN -- do what we would have done at compile time if we knew the contents
I am sure I am not getting the levels of stripping and adding right on this coding pass
left: Node ← StripAMNode[leftNode];
right: Node ← StripAMNode[rightNode];
leftPT: CSO.ParseTree ← CreateAMNodeParseTree[left, cc];
rightPT: CSO.ParseTree ← CreateAMNodeParseTree[right, cc];
tc: TypedCode ← CSO.RHSBinaryOp[op, leftPT, rightPT, cc];
RETURN[MakeNodeFromNode[CedarCode.Interpret[tc.code, cc], cc]];
END;
AMNodeUnaryOp:
PROC[op: CedarCode.Operator, type: Type, node: Node, cc:
CC]
RETURNS[Node] =
BEGIN
item: Node ← StripAMNode[node];
itemPT: CSO.ParseTree ← CreateAMNodeParseTree[item, cc];
tc: TypedCode ← CSO.RHSUnaryOp[op, itemPT, cc];
RETURN[MakeNodeFromNode[Interpret[tc.code, cc], cc]]
END;
this should be an object proc of something
AMNodeConstructRecordNode:
PUBLIC
PROC[rcdType: Type, fields:
LIST
OF Node, cc:
CC]
RETURNS[Node] =
BEGIN
treeList: LIST OF CSO.ParseTree ← NIL;
lastCell: LIST OF CSO.ParseTree ← NIL;
tc: TypedCode;
FOR fl:
LIST
OF Node ← fields, fl.rest
WHILE fl #
NIL
DO
node: Node ← StripAMNode[fl.first];
pt: CSO.ParseTree ← CreateAMNodeParseTree[node, cc];
cell: LIST OF CSO.ParseTree ← LIST[pt];
IF treeList = NIL THEN treeList ← cell ELSE lastCell.rest ← cell;
lastCell ← cell;
ENDLOOP;
tc ← CSO.RHSConstructor[treeList, rcdType, cc];
RETURN[Interpret[tc.code, cc]];
notice that we did not package this inside a node. We are called by a run time instruction that knows that we are about to produce a rcdType value. The compiler knew that when it generated the code. So code that uses this value assumes that it is of type rcdType, and not a record packaged inside a node.
END;
this should be an object proc of something
AMNodeConstructArrayNode:
PUBLIC
PROC[arrayType: Type, entries:
LIST
OF Node, cc:
CC]
RETURNS[Node] =
BEGIN
treeList: LIST OF CSO.ParseTree ← NIL;
lastCell: LIST OF CSO.ParseTree ← NIL;
tc: TypedCode;
FOR el:
LIST
OF Node ← entries, el.rest
WHILE el #
NIL
DO
node: Node ← StripAMNode[el.first];
pt: CSO.ParseTree ← CreateAMNodeParseTree[node, cc];
cell: LIST OF CSO.ParseTree ← LIST[pt];
IF treeList = NIL THEN treeList ← cell ELSE lastCell.rest ← cell;
lastCell ← cell;
ENDLOOP;
tc ← CSO.RHSConstructor[treeList, arrayType, cc];
RETURN[Interpret[tc.code, cc]];
notice that we did not package this inside a node. We are called by a run time instruction that knows that we are about to produce an arrayType value. The compiler knew that when it generated the code. So code that uses this value assumes that it is of type arrayType, and not a record packaged inside a node.
END;
AMNodeStore:
PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc:
CC] =
BEGIN
valItem: Node ← StripAMNode[valNode];
valItemPT: CSO.ParseTree ← CreateAMNodeParseTree[valItem, cc];
indirectItem: Node ← StripAMNode[indirectNode];
indirectItemPT: CSO.ParseTree ← CreateAMNodeParseTree[indirectItem, cc];
tc: TypedCode ← CSO.RHSAssignment[indirectItemPT, valItemPT, cc];
[] ← Interpret[tc.code, cc];
END;
AMNodeExtractField:
PROC[id: Rope.
ROPE, type: Type, node: Node, cc:
CC]
RETURNS[Node] =
BEGIN
item: Node ← StripAMNode[node];
itemType: Type ← GetTypeOfNode[item];
finaltc: TypedCode ← CSO.RHSFieldIdentifier[id, itemType, cc];
code: Code ← ConcatCode[
CodeToLoadContentsOfAMNode[item],
finaltc.code];
RETURN[MakeNodeFromNode[Interpret[code, cc], cc]];
END;
AMNodeSelectField:
PROC[id: Rope.
ROPE, indirectType: Type, indirectNode: Node, cc:
CC]
RETURNS[Node] =
BEGIN
note: The value, currentIndirectItemType, can be a very fleeting value. That is, if the indirect is to a union type, then the type of the current value in the field pointed to by the indirect is (in principle) constantly changing. Thus, in general, this code can only be executed by an interpreter while the world is sufficiently frozen. There are at least two safe exceptions. (1) If the indirect is to a variant record, then because of the current Cedar rule that the actual type can not change once it has been initialized, we need not freeze the world. (2) If the indirect is part of a REF, then we don't really have to call GetCurrentTargetType, because this would have been called as part of loading the REF value itself, hence GetType[indirectItem] would have had the same effect as GetIndirectType[GetCurrentTargetType[indirectItem], cc].
I have changed the code to use GetCurrentType. This applies both to indirect types and to REF types. For indirect types is should be implemented as (roughly) GetIndirectType[GetCurrentTargetType[indirectItem], cc].
indirectItem: Node ← StripAMNode[indirectNode];
currentIndirectItemType: Type ← CedarCode.GetCurrentTypeOfNode[indirectItem, cc];
finaltc: TypedCode ← CSO.LHSFieldIdentifier[id, currentIndirectItemType, cc];
code: Code ← ConcatCode[
CodeToLoadContentsOfAMNode[indirectItem],
finaltc.code];
RETURN[MakeNodeFromNode[Interpret[code, cc], cc]];
END;
AMNodeApply:
PROC[operatorType: Type, operandType: Type, operator: Node, operand: Node, cc:
CC]
RETURNS[Node] =
BEGIN
operatorPT: CSO.ParseTree ← CreateAMNodeParseTree[StripAMNode[operator], cc];
operandPT: CSO.ParseTree ← CedarCode.ExamineParseTree[operand, cc];
tc: TypedCode ← CSO.RHSApply[operatorPT, operandPT, cc];
RETURN[MakeNodeFromNode[Interpret[tc.code, cc], cc]];
END;
AMNodeIndex:
PROC[indirectOperatorType: Type, operandType: Type, indirectOperator: Node, operand: Node, cc:
CC]
RETURNS[Node] =
BEGIN
Warning: I am not sure how this should be coded. Using Apply as a model, I would expect to find parse trees all over the place. Using Select as a model, I should be examining current type etc. I shall attempt to combine these two models. However, I don't see how to use currentIndirectOperatorType.
See AMNodeSelectField comments concerning the fleeting nature of currentIndirectOperatorType.
indirectOperatorItem: Node ← StripAMNode[indirectOperator];
currentIndirectOperatorType: Type ← CedarCode.GetCurrentTypeOfNode[indirectOperatorItem, cc];
indirectOperatorPT: CSO.ParseTree ← CreateAMNodeParseTree[indirectOperatorItem, cc];
operandPT: CSO.ParseTree ← CedarCode.ExamineParseTree[operand, cc];
tc: TypedCode ← CSO.LHSapply[indirectOperatorPT, operandPT, cc];
RETURN[MakeNodeFromNode[Interpret[tc.code, cc], cc]];
END;
AMNodeShow:
PROC[to:
IO.
STREAM, node: Node, depth:
INT, width:
INT, cc:
CC] = {
item: Node ← StripAMNode[node];
to.PutRope["Node["];
CedarCode.BreakShowNode[to, item, depth-1, width, cc];
to.PutChar[']]};
StripAMNode:
PUBLIC
PROC[node: Node]
RETURNS[Node] =
BEGIN -- strips off one layer of node
innerNode: Node ← NARROW[CedarCode.GetDataFromNode[node], REF NodeHolder].nd;
RETURN[innerNode];
END;
AMNodeCompileForRHS:
PROC[tree:
CSO.ParseTree, nominalTarget: Type, cc:
CC, data:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
node: Node ← NARROW[data, REF NodeHolder].nd;
RETURN[[CodeToLoadContentsOfAMNode[node], CedarCode.GetTypeOfNode[node]]];
END;
AMNodeCompileForLHS:
PROC[tree:
CSO.ParseTree, cc:
CC, data:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
node: Node ← NARROW[data, REF NodeHolder].nd;
RETURN[[CodeToLoadContentsOfAMNode[node], CedarCode.GetTypeOfNode[node]]];
END;
END..