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;



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;




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
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;
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]];

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};




AmpersandVarCCTypeProcs: REF CCTypeProcs ¬ NEW[CCTypeProcs ¬[
checkConformance: AmpersandVarCheckConformance,
binaryOperandTypes: AmpersandVarBinaryOperandTypes,
operand: AmpersandVarOperand,
store: AmpersandVarStore,
load: AmpersandVarLoad]];

AmpersandVarCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] =
BEGIN
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];
END;

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;
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;

AmpersandVar: TYPE = REF AmpersandVarBody;
AmpersandVarBody: TYPE = RECORD[
table: SymTab.Ref,
val: Node];

AmpersandVarOps: REF OperationsBody ¬ NEW[OperationsBody¬[
load: LoadFromAmpersandVar,
store: StoreToAmpersandVar]];


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;

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;




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;

NodeGetRTargetType: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[Type] =
{RETURN[GetNodeType[cc]]};

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"]};



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
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;

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]];
END;

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]];
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
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
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..
>
AmpersandContextImpl.mesa
Copyright Σ 1990, 1992 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
this module contains both the type information and the implementation of the op codes
Type information
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.
an ampersand name is always defined and always has type AmpersandVar
(AmpersandVars always contain Nodes)
interpretation time

This is the default version.  It assumes that the target type is not a union type.

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?
valType is the standard control parameter
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.
we really should make a last ditch type check
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.

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
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.
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.
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".
the target type must be node
Now for the node routines
I am sure I am not getting the levels of stripping and adding right on this coding pass
this should be an object proc of something
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.
this should be an object proc of something
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.
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].

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.

Κ±–
(cedarcode) style•NewlineDelimiter

™
codeš
œ™Kšœ
Οe
œ7™BKš
œ&™&K™7K™&K™=K™.—K˜š
Οk	˜	Kšœžœ˜Kšœžœ‘žœ˜ΛKšœ
žœα˜πKšœžœ˜/Kšœžœ₯
˜Γ
KšœžœL˜\Kšžœ
˜Kš
œ˜K˜Kšœžœ.˜:—K˜šΟnœžœ
ž˜#KšžœDžœ!˜nKšžœ˜#—Kš	œžœ
žœ!žœžœ˜`K˜Kšžœžœ˜&Kšžœžœ&žœžœ˜NK˜Kš
œU™UK˜Kš
œ™K˜š
Ÿœžœ
žœžœžœ˜JKš
ž˜K˜4Kšžœžœ
žœ
žœ
˜&KšžœŽ
˜”
Kšžœ
˜K˜—K˜Kš
œ‚
™‚
K˜Kš
œf™fK˜šŸœžœžœ˜EKš
œ5˜5—K˜šŸ!œžœžœ˜GK˜-Kš
œ/˜/—K˜šŸ œžœžœžœ
žœžœ˜wšžœ*˜,Kšžœ
žœ˜Kšžœ
žœ˜—K˜—K˜šŸœžœ
žœ"žœžœ
žœžœ
˜~Kš
ž˜Kšžœž˜šœΟc5˜AKš
œD™DKš
œ$™$K˜JK˜%Kšžœ˜—Kšžœžœ
˜Kšžœ
˜—K˜šŸœžœžœžœ
žœžœžœ˜\Kš
ž˜Kšžœ˜Kšžœ
˜—Kš
œ™K™š
Ÿœžœ
žœžœžœ˜IKš
ž˜K˜$K˜&Kšžœ1˜7Kšžœ
˜—K˜šŸœžœžœ˜>K˜/K˜)K˜—˜Kš
œR™R—šŸœžœžœžœ˜HKšœ
žœ˜K˜—š
Ÿœžœ
žœ.žœžœ˜pKš
ž˜Kšœžœ*˜DK˜"Kšœžœ˜8K˜(K˜(K˜šžœžœ
ž˜Kš
ž˜Kšœžœžœ˜)Kšžœ
žœžœ
žœ
˜:Kšžœ
˜—K˜Kš žœEžœ
žœ *˜‰
Kšžœ
žœAžœ
žœ5˜„
K˜Kšžœ+˜1K˜Kšžœ
˜K˜—šŸœžœžœ
žœžœ	žœžœ˜YKšœžœ"˜<š
Ÿœžœ$žœžœžœ˜ZKšœžœ˜!šŸœžœ˜Kš
œ˜K˜Kšžœ!˜#šžœ	ž˜Kšžœ;˜?Kšžœ˜ —Kšžœ˜—Kšžœ˜K˜Kšžœ˜—K˜K˜+K˜Kšžœ˜K˜—K˜K™š
œG™GK˜—˜K™Kš
œ$™$Kš
œN™N—šŸœžœžœ˜=K˜/K˜3K˜K˜K˜—˜Kš
œ)™)—šŸœžœžœžœ
žœžœ˜yKš
ž˜Kš
œQ™QKš
œ5™5Kš
œ&™&Kš
œ]™]K˜6K˜6K˜$K˜$K˜?Kšžœžœ
žœ˜"K˜?Kšžœžœ
žœ˜"Kšžœžœžœ
žœ˜8Kšžœ˜Kšžœ
˜—K˜K˜šŸœžœ&žœžœ
žœžœ˜}Kš
ž˜K˜Ašžœž˜˜
šžœž˜Kšœ
žœ˜!Kšžœžœ,˜=——Kšžœžœ
˜—šžœ
˜K˜——šŸœžœžœžœžœ
žœžœ
˜nKš
ž˜šžœž˜˜aKš
ž˜K˜EK˜Kšžœ˜Kšžœ
˜—Kšžœžœ ˜/—Kšžœ
˜—K˜K˜šŸœžœ,žœžœ
žœžœ
˜nKš
ž˜˜"K˜˜K˜K˜;——K˜Kš
œ-™-Kšžœ˜Kšžœ
˜—K˜šŸœžœžœžœ
žœžœ
˜[Kš
ž˜˜"K˜K˜4—K˜7Kšžœ˜Kšžœ
˜K˜Kš
œΫ
™Ϋ
K™—Kšœžœžœ˜*šœžœžœ
˜ K˜K˜—K˜šŸœžœžœ˜:K˜K˜—K˜˜Kš
œ3™3š
œ™Kš
œO™OKš
œ‡
™‡
Kš
œD™D——šŸœžœ-žœžœ˜ZKš
ž˜Kšœžœ ˜:K˜Kšžœ,žœ
žœ (˜lKšžœžœ
žœ
žœB˜[Kšžœ
˜Kšžœ
˜K˜Kš
œ3™3š
œ:™:Kš
œψ
™ψ
——šŸœžœKžœ˜iKš
ž˜Kšœžœ ˜:K˜Kšžœ,žœ
žœ (˜lK˜Kšžœ
˜—K˜K˜Kš
œ³
™³
˜K˜—š
Ÿœžœ
žœžœžœ˜>Kš
ž˜K˜(Kšžœžœ
žœ
žœ
˜&KšžœI˜OKšžœ
˜—K˜šŸœžœžœ˜5K˜K˜#K˜+K˜K˜K˜K˜K˜K˜K˜K˜#K˜!K˜K˜K˜—K˜šŸœžœ"žœžœ
žœžœ
žœ˜]Kš
ž˜K˜Dšžœž˜Kšœžœ
žœ˜KšžœžœJ˜[—Kšžœ
˜—˜Kš
œυ™υKš
ϱ
™±
—šŸœžœžœžœ
žœžœ˜OKšœ
žœ˜—˜Kš
œ™—šŸœžœ&žœžœ
žœžœ˜uKš
ž˜šžœž˜Kšœžœ ˜4Kšžœžœ˜ —Kšžœ
˜K˜—šŸœžœžœžœžœ
žœžœ
˜fKšœ
žœ˜
—K˜šŸœžœFžœžœ
žœžœ
˜‡
Kš
ž˜K˜BK˜CK˜%Kšžœ˜Kšžœ
˜—K˜šŸœžœFžœžœ
žœžœ
˜‡
Kš
ž˜K˜BK˜CK˜%Kšžœ˜Kšžœ
˜K˜K˜—šŸœžœ&žœžœ
žœžœ
˜gKš
ž˜K˜<šžœ
ž˜Kšœ
žœ˜.Kšœžœ˜Kšžœžœ A˜]—Kšžœ
˜K˜—šŸœžœ+žœžœ
žœžœ
˜hKš
ž˜˜
˜K˜
˜K˜K˜.———Kšžœ˜Kšžœ
˜K˜—šŸœžœ#žœžœ
žœžœ
˜_Kš
ž˜˜
˜K˜	K˜——Kšžœ˜Kšžœ
˜—K˜šŸ	œžœ,žœžœ
žœžœ
˜fKš
ž˜˜"K˜˜K˜K˜;——K˜Kšžœ˜Kšžœ
˜—K˜šŸœžœ
žœžœžœ
žœžœ
˜kKš
ž˜K˜<Kšžœ˜Kšžœ
˜—K˜šŸœžœ
žœ"žœžœ
žœžœ
˜rKš
ž˜K˜CKšžœ˜%Kšžœ
˜—K˜šŸ	œžœ.žœžœ
žœžœ
˜hKš
ž˜˜
˜K˜˜K˜
K˜-———K˜%Kšžœ˜Kšžœ
˜—K˜šŸ	œžœ.žœžœ
žœžœ
˜hKš
ž˜˜
˜K˜˜K˜
K˜-———K˜%Kšžœ˜Kšžœ
˜—K˜šŸ
œžœžœ
žœžœžœžœžœ
žœ
˜lKš
œ˜—K˜š
œ™K˜K˜Kšœžœžœ˜$K˜š
Ÿœžœ
žœžœžœ˜AKšœ
žœ5žœ˜V—K˜K˜šŸ	œžœžœ˜5K˜K˜%K˜K˜K˜K˜K˜!K˜K˜K˜K˜K˜—K˜š
Ÿœžœ
žœžœ
žœ˜UK˜K˜—K˜š
Ÿœžœžœžœ
žœ
˜HKšœ
žœ
žœ+žœ˜PK˜—šŸœžœ#žœžœ˜LKšœ
žœ˜%K˜—š
Ÿœžœžœžœ
žœ˜AKšœ
žœ ˜%—K˜šŸœžœ/žœžœ˜TKšœ
žœ ˜)K˜—šŸœžœSžœžœ˜zKšžœ E˜LKš
œW™WK˜#K˜%Kšœžœ-˜8Kšœ	žœ.˜:Kšœžœ&˜9Kšžœ9˜?Kšžœ
˜K˜—šŸ
œžœ5žœžœ˜[Kš
ž˜K˜Kšœžœ-˜8Kšœžœ˜/Kšžœ.˜4Kšžœ
˜—˜Kš
œ*™*—šŸœžœ
žœžœ
žœžœžœ˜cKš
ž˜Kš	œ
žœ
žœ
žœ
žœ
˜&Kš	œ
žœ
žœ
žœ
žœ
˜&K˜K˜šžœžœ
žœžœžœ
ž˜8K˜$Kšœžœ-˜4Kš	œžœ
žœ
žœ
žœ˜'Kšžœžœ
žœžœ˜AK˜Kšžœ
˜—Kšœžœ'˜/šžœ˜Kš
œ΄™΄—Kšžœ
˜—˜Kš
œ*™*—šŸœžœ
žœžœ
žœžœžœ˜eKš
ž˜Kš	œ
žœ
žœ
žœ
žœ
˜&Kš	œ
žœ
žœ
žœ
žœ
˜&K˜K˜šžœžœ
žœžœžœ
ž˜9K˜$Kšœžœ-˜4Kš	œžœ
žœ
žœ
žœ˜'Kšžœžœ
žœžœ˜AK˜Kšžœ
˜—Kšœžœ)˜1šžœ˜Kš
œΉ™Ή—Kšžœ
˜—K˜K˜šŸœžœKžœ˜aKš
ž˜K˜%Kšœžœ0˜>K˜/Kšœžœ5˜HKšœžœ.˜AK˜Kšžœ
˜K˜—š
Ÿœžœ
žœžœžœ˜WKš
ž˜K˜K˜%Kšœžœ&˜>˜K˜!K˜—Kšžœ,˜2Kšžœ
˜—K˜—š
Ÿœžœ
žœ.žœžœ˜fKš
ž˜Kš
œΣ™ΣK™Kš
œΨ
™Ψ
K™K˜/K˜QKšœžœ5˜M˜K˜)K˜—Kšžœ,˜2Kšžœ
˜—K˜šŸœžœKžœžœ˜oKš
ž˜Kšœžœ>˜MKšœžœ5˜CKšœžœ%˜8Kšžœ/˜5Kšžœ
˜—K˜šŸœžœ[žœžœ˜Kš
ž˜Kš
œ­™­K™Kš
œ]™]K™K˜;K˜]Kšœžœ=˜TKšœžœ5˜CKšœžœ-˜@Kšžœ/˜5Kšžœ
˜—K˜K˜šŸ
œžœžœ
žœžœ	žœžœ˜OK˜K˜Kš
œ6˜6Kš
œ˜—K˜šŸœžœ
žœ
žœ˜4Kšžœ ˜&Kšœžœ"žœ˜MKšžœ˜Kšžœ
˜—K˜šŸœžœžœ%žœžœ
žœžœ
˜oKš
ž˜Kšœ
žœžœ˜-KšžœD˜JKšžœ
˜—K˜šŸœžœžœžœžœ
žœžœ
˜ZKš
ž˜Kšœ
žœžœ˜-KšžœD˜JKšžœ
˜—K˜Kšžœ˜—…—Is