DIRECTORY
AmpersandContext USING[MakeNodeFromNode],
Atom USING [GetPName],
CCTypes USING[BreakObject, CCError, CCErrorCase, Conforms, DoObject, Operator, GetTypeClass, IsIndirectType, sia],
CedarCode USING[OperationsBody],
CedarCodeExtras,
CedarNumericTypes USING[NumericDescriptor],
CirioBackstop,
CirioTypes USING[CompilerContext, NodeBody, Type, TypedCode],
CirioSyntacticOperations USING[ParseTree],
Convert USING[RopeFromInt],
IO,
Records USING[ConstructRecordNode],
RefTab,
Rope,
StructuredStreams;

CedarCodeImpl: CEDAR PROGRAM
IMPORTS AmpersandContext, Atom, CCTypes, CirioBackstop, Convert, IO, Records, RefTab, Rope, StructuredStreams
EXPORTS CedarCode, CedarCodeExtras, CirioTypes
SHARES CirioTypes
= BEGIN OPEN SS:StructuredStreams;

ROPE: TYPE ~ Rope.ROPE;
CC: TYPE = CirioTypes.CompilerContext;
Type: TYPE = CirioTypes.Type;
TypedCode: TYPE = CirioTypes.TypedCode;
NumericDescriptor: TYPE = CedarNumericTypes.NumericDescriptor;
OperationsBody: TYPE = CedarCode.OperationsBody;

CCE: ERROR[case: CCTypes.CCErrorCase, msg: ROPE _ NIL] _ CCTypes.CCError;

Code: TYPE = REF CodeBody;
CodeBody: PUBLIC TYPE = RECORD[
first, last: REF InstructionCell];

InstructionCell: TYPE = RECORD[
instruction: Instruction,
next: REF InstructionCell,
alternateNext: REF InstructionCell _ NIL,
visitedOn: INT,
number: INT];


Instruction: TYPE = REF InstructionBody;
InstructionBody: TYPE = RECORD[
SELECT case: * FROM
null =>  [],
pop => [n: INT],
test => [popCond: BOOL],
loadGlobalFrame => [name: ROPE, nToSkip: INT],
loadAMNode => [node: Node],
loadNameScope => [],
getNameContext => [scopeIndex: CARDINAL],
loadContentsOfAMNode => [node: Node],
makeAMNode => [sourceType: Type],
coerce => [sourceType, targetType: Type],
binaryOp => [op: CCTypes.Operator, left, right: Type],
unaryOp => [op: CCTypes.Operator, type: Type],
buildRecord => [nFields: INT, rcdType: Type],
storeUnpopped => [indirectType: Type, valType: Type],
loadThroughIndirect => [indirectType: Type],
extractField => [id: ROPE, type: Type],
selectField => [id: ROPE, indirectType: Type],
apply => [operatorType: Type, operandType: Type],
index => [indirectOperatorType: Type, operandType: Type],
selectNestedBlock => [set: INT, depth: INT, indirectType: Type],
ENDCASE];



ConcatCode: PUBLIC PROC[c1, c2: Code] RETURNS[Code] ~ {
IF c1 = NIL OR c1.first = NIL THEN RETURN[c2];
IF c2 = NIL OR c2.first = NIL THEN RETURN[c1];
c1.last.next _ c2.first;
c1.last _ c2.last;
RETURN[c1]};

CopyCode: PUBLIC PROC [old: Code] RETURNS [new: Code] ~ {
instMap: RefTab.Ref ~ RefTab.Create[];
CopyInst: PROC [i: REF InstructionCell] RETURNS [j: REF InstructionCell] ~ {
IF i=NIL THEN RETURN [NIL];
j _ NARROW[instMap.Fetch[i].val];
IF j#NIL THEN RETURN;
j _ NEW [InstructionCell _ [i.instruction, NIL, NIL, i.visitedOn, i.number]];
IF NOT instMap.Insert[i, j] THEN CCE[cirioError, "concurrent code copy"];
j.next _ CopyInst[i.next];
j.alternateNext _ CopyInst[i.alternateNext];
RETURN};
new _ NEW [CodeBody _ [NIL, CopyInst[old.last] ]];
new.first _ CopyInst[old.first];
RETURN};

CodeToDoPoppedCond: PUBLIC PROC[test, trueCase, falseCase: Code] RETURNS[Code]
= {RETURN CodeToCond[test, trueCase, falseCase, TRUE]};

CodeToDoUnpopedCond: PUBLIC PROC[test, trueCase, falseCase: Code] RETURNS[Code]
= {RETURN CodeToCond[test, trueCase, falseCase, FALSE]};

CodeToCond: PROC[test, trueCase, falseCase: Code, popCond: BOOL] RETURNS[Code] ~ {
fullTest: Code _ ConcatCode[test, OneInstCode[NEW[InstructionBody_[test[popCond]]]]];
null: Code _ NullCode[];
IF trueCase = NIL OR falseCase = NIL THEN CCE[cirioError];
fullTest.last.next _ trueCase.first;
fullTest.last.alternateNext _ falseCase.first;
trueCase.last.next _ null.first;
falseCase.last.next _ null.first;
fullTest.last _ null.last;
RETURN[fullTest];
};

CodeToPop: PUBLIC PROC[nPops: INT] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[pop[nPops]]]]]};

NullCode: PUBLIC PROC RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[null[]]]]]};

OneInstCode: PROC[inst: Instruction] RETURNS[Code] =
BEGIN
cell: REF InstructionCell _ NEW[InstructionCell_[inst, NIL, NIL, 0, 0]];
RETURN[NEW[CodeBody _ [cell, cell]]];
END;


CodeToLoadGlobalFrame: PUBLIC PROC [name: ROPE, nToSkip: INT] RETURNS [Code]
~ {RETURN OneInstCode[NEW[InstructionBody_[loadGlobalFrame[name, nToSkip]] ]]};

CodeToLoadNameScope: PUBLIC PROC RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[loadNameScope[]]]]]};

CodeToGetNameContext: PUBLIC PROC[scopeIndex: CARDINAL] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[getNameContext[scopeIndex]]]]]};

CodeToLoadContentsOfAMNode: PUBLIC PROC[node: Node] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[loadContentsOfAMNode[node]]]]]};

CodeToLoadAMNode: PUBLIC PROC[node: Node] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[loadAMNode[node]]]]]};

CodeToMakeAMNode: PUBLIC PROC[sourceType: Type] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[makeAMNode[sourceType]]]]]};

CodeToCoerce: PUBLIC PROC[sourceType, targetType: Type] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[coerce[sourceType, targetType]]]]]};

CodeToDoBinaryOp: PUBLIC PROC[op: CCTypes.Operator, left, right: Type] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[binaryOp[op, left, right]]]]]};

CodeToDoUnaryOp: PUBLIC PROC[op: CCTypes.Operator, type: Type] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[unaryOp[op, type]]]]]};

CodeToBuildRecord: PUBLIC PROC[nFields: INT, rcdType: Type] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[buildRecord[nFields, rcdType]]]]]};

CodeToStoreUnpopped: PUBLIC PROC[indirectType: Type, sourceType: Type] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[storeUnpopped[indirectType, sourceType]]]]]};

CodeToLoadThroughIndirect: PUBLIC PROC[indirectType: Type] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[loadThroughIndirect[indirectType]]]]]};

CodeToExtractField: PUBLIC PROC[id: ROPE, type: Type] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[extractField[id, type]]]]]};

CodeToSelectField: PUBLIC PROC[id: ROPE, indirectType: Type] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[selectField[id, indirectType]]]]]};

CodeToDoApply: PUBLIC PROC[operatorType: Type, operandType: Type] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[apply[operatorType, operandType]]]]]};

CodeToDoIndex: PUBLIC PROC[indirectOperatorType: Type, operandType: Type] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[index[indirectOperatorType, operandType]]]]]};

CodeToSelectNestedBlock: PUBLIC PROC[set:INT, depth: INT, indirectType: Type] RETURNS[Code] =
{RETURN[OneInstCode[NEW[InstructionBody_[selectNestedBlock[set, depth, indirectType]]]]]};




Node: TYPE = REF NodeBody;
NodeBody: TYPE = CirioTypes.NodeBody;

CreateNode: PROC[data: REF ANY] RETURNS[Node] =
{RETURN[NEW[NodeBody_[NIL, NIL, data]]]};

SetNodeOps: PROC[node: Node, ops: REF OperationsBody] =
{IF node.ops # NIL THEN CCE[cirioError]; node.ops _ ops};

SetNodeType: PROC[node: Node, type: Type] =
{IF node.type # NIL THEN CCE[cirioError]; node.type _ type};

CreateCedarNode: PUBLIC PROC[ops: REF OperationsBody, type: Type, data: REF ANY] RETURNS[Node] =
BEGIN
node: Node _ CreateNode[data];
IF type = NIL THEN CCE[cirioError];
SetNodeOps[node, ops];
SetNodeType[node, type];
RETURN[node];
END;

GetTypeOfNode: PUBLIC PROC[node: Node] RETURNS[Type] =
{RETURN[node.type]};

GetCurrentTypeOfNode: PUBLIC PROC[node: Node, cc: CC] RETURNS[Type] =
BEGIN
IF node.ops.getCurrentType = NIL THEN RETURN[node.type]
ELSE RETURN[node.ops.getCurrentType[node, cc]];
END;

GetDataFromNode: PUBLIC PROC[node: Node] RETURNS[REF ANY] =
{RETURN[node.data]};


Coerce: PUBLIC PROC[sourceType, targetType: Type, node: Node, cc: CC] RETURNS[Node] =
BEGIN
IF NOT CCTypes.Conforms[GetTypeOfNode[node], sourceType, cc] THEN
BEGIN
IF node.ops.coerce = NIL THEN CCE[cirioError];
RETURN[node.ops.coerce[sourceType, targetType, node, cc]];
END;
IF NOT CCTypes.Conforms[sourceType, targetType, cc] THEN
BEGIN
IF node.ops.coerce = NIL THEN CCE[cirioError];
RETURN[node.ops.coerce[sourceType, targetType, node, cc]];
END;
RETURN[node];
END;

AdvanceNameScope: PUBLIC PROC[node: Node, cc: CC] RETURNS[Node] =
BEGIN
IF node.ops.advanceNameScope = NIL THEN CCE[cirioError];
RETURN[node.ops.advanceNameScope[node, cc]];
END;

ExamineParseTree: PUBLIC PROC[node: Node, cc: CC] RETURNS[CirioSyntacticOperations.ParseTree] =
BEGIN
IF node.ops.examineParseTree = NIL THEN CCE[cirioError];
RETURN[node.ops.examineParseTree[node, cc]];
END;

ApplyBinaryOp: PUBLIC PROC[op: CCTypes.Operator, leftType, rightType: Type, leftNode, rightNode: Node, cc: CC] RETURNS[Node] =
BEGIN
IF leftNode.ops.binaryOp = NIL THEN CCE[cirioError];
RETURN[leftNode.ops.binaryOp[op, leftType, rightType, leftNode, rightNode, cc]];
END;

ApplyUnaryOp: PUBLIC PROC[op: CCTypes.Operator, type: Type, node: Node, cc: CC] RETURNS[Node] =
BEGIN
IF node.ops.unaryOp = NIL THEN CCE[cirioError];
RETURN[node.ops.unaryOp[op, type, node, cc]];
END;

StoreThroughIndirectNode: PUBLIC PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] =
BEGIN
IF indirectNode.ops.store = NIL THEN CCE[cirioError];
indirectNode.ops.store[valType, valNode, indirectType, indirectNode, cc];
END;

LoadThroughIndirectNode: PUBLIC PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] =
BEGIN
IF indirectNode.ops.load = NIL THEN CCE[cirioError];
RETURN[indirectNode.ops.load[indirectType, indirectNode, cc]];
END;

ForceNodeIn: PUBLIC PROC[type: Type, node: Node, cc: CC] RETURNS[Node] =
BEGIN
IF node.ops.forceIn = NIL THEN RETURN[node]
ELSE RETURN[node.ops.forceIn[type, node, cc]];
END;

ExtractFieldFromNode: PUBLIC PROC[id: ROPE, type: Type, node: Node, cc: CC] RETURNS[Node] =
BEGIN
IF node.ops.extractField = NIL THEN CCE[cirioError];
RETURN[node.ops.extractField[id, type, node, cc]];
END;

SelectFieldFromNode: PUBLIC PROC[id: ROPE, indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] =
BEGIN
IF indirectNode.ops.selectField = NIL THEN CCE[cirioError];
RETURN[indirectNode.ops.selectField[id, indirectType, indirectNode, cc]];
END;


NodeAsIndex: PUBLIC PROC[type: Type, node: Node, cc: CC] RETURNS[CARD] =
{RETURN[IF node.ops.asIndex # NIL THEN node.ops.asIndex[type, node, cc] ELSE CCE[cirioError]]};

ShowNode: PUBLIC PROC[to: IO.STREAM, node: Node, depth, width: INT, cc: CC] = {
IF node.ops.show # NIL THEN {
InnerShow: PROC RETURNS [ROPE] ~ {
node.ops.show[to, node, depth, width, cc];
RETURN[NIL]};
msg: ROPE ~ CirioBackstop.Protect[
InnerShow,
NIL--"to" is structured, and so shouldn't receive random reports--];
IF msg#NIL THEN to.PutF["--%g--", [rope[msg]] ]}
ELSE to.PutRope["node?"];
RETURN};

ShowNodeBracketed: PUBLIC PROC[to: IO.STREAM, node: Node, depth, width: INT, cc: CC] = {
InnerShow: PROC ~ {ShowNode[to, node, depth, width, cc]};
CCTypes.DoObject[to, InnerShow];
RETURN};

BreakShowNode: PUBLIC PROC[to: IO.STREAM, node: Node, depth, width: INT, cc: CC, sep: ROPE _ NIL] = {
InnerShow: PROC ~ {ShowNode[to, node, depth, width, cc]};
CCTypes.BreakObject[to, InnerShow, sep];
RETURN};

GetNodeRepresentation: PUBLIC PROC[node: Node, cc: CC] RETURNS[REF ANY] =
{RETURN[IF node.ops.getNodeRepresentation # NIL THEN node.ops.getNodeRepresentation[node, cc] ELSE CCE[cirioError]]};

ShowOp: PROC[op: CCTypes.Operator] RETURNS[ROPE] =
BEGIN
RETURN[Atom.GetPName[op]]
END;

Interpret: PUBLIC PROC[code: Code, cc: CC, debug: IO.STREAM _ NIL] RETURNS[Node] = { -- only good for expressions for now
stack: LIST OF Node _ NIL;
current: REF InstructionCell _ code.first; -- assumes code # NIL
savedCurrent: REF InstructionCell;
depth: INT _ 2; -- nominal for now
width: INT _ 35; -- nominal for now

PopStack: PROC RETURNS[Node] =
BEGIN
top: Node _ stack.first;
stack _ stack.rest;
RETURN[top];
END;

PushStack: PROC[node: Node] =
{stack _ CONS[node, stack]};

ShowTop: PROC = {
typeClass: ROPE _ NIL;
IF stack # NIL THEN {
type: Type _ GetTypeOfNode[stack.first];
typeClass _ Atom.GetPName[CCTypes.GetTypeClass[type]];
IF CCTypes.IsIndirectType[type] THEN typeClass _ Rope.Cat["^", typeClass]};
ShowNode[debug, stack.first, depth, width, cc];
debug.PutF["   (%g)", [rope[typeClass]] ]};

ShowTop2: PROC = {
ShowNode[debug, stack.rest.first, depth, width, cc];
SS.Bp[debug, lookLeft, CCTypes.sia, " "];
ShowNode[debug, stack.first, depth, width, cc];
RETURN};

WHILE current # NIL DO

savedCurrent _ current;

IF debug # NIL THEN {
debug.PutRope[ShowInstruction[current.instruction, stack]];
SS.Bp[debug, lookLeft, 0, " "];
WITH current.instruction SELECT FROM
inst: REF makeAMNode InstructionBody => ShowTop[];
inst: REF binaryOp InstructionBody =>  ShowTop2[];
inst: REF unaryOp InstructionBody => ShowTop[];
ENDCASE => NULL};

WITH current.instruction SELECT FROM
inst: REF null InstructionBody =>
{current _ current.next};
inst: REF pop InstructionBody =>
BEGIN
FOR I: INT IN [0..inst.n) DO
[] _ PopStack[];
ENDLOOP;
current _ current.next;
END;
inst: REF test InstructionBody =>
BEGIN
top: Node _ IF inst.popCond THEN PopStack[] ELSE stack.first;
IF top.ops.examineBoolean = NIL THEN CCE[cirioError, "an alleged boolean doesn't know how to reveal itself"];
IF top.ops.examineBoolean[top, cc]
THEN current _ current.next
ELSE current _ current.alternateNext;
END;
inst: REF loadGlobalFrame InstructionBody =>
BEGIN
IF cc.moduleScope=NIL THEN ERROR CCE[unimplemented, "This compiler context doesn't know how to load a global frame"];
PushStack[cc.moduleScope.GetModule[cc.moduleScope, inst.name, inst.nToSkip]];
current _ current.next;
END;
inst: REF loadAMNode InstructionBody =>
BEGIN
PushStack[AmpersandContext.MakeNodeFromNode[inst.node, cc]];
current _ current.next;
END;
inst: REF loadNameScope InstructionBody =>
BEGIN
PushStack[cc.nameScope]; -- this should come from an interpreter context?
current _ current.next;
END;
inst: REF getNameContext InstructionBody =>
BEGIN
top: Node _ PopStack[];
IF top.ops.getNameContext = NIL THEN CCE[cirioError, "top of stack doesn't know how to getNameContext"];
PushStack[top.ops.getNameContext[inst.scopeIndex, top, cc]];
current _ current.next;
END;
inst: REF loadContentsOfAMNode InstructionBody =>
BEGIN
PushStack[inst.node];
current _ current.next;
END;
inst: REF makeAMNode InstructionBody =>
BEGIN
top: Node _ PopStack[];
forcedIn: Node _ ForceNodeIn[inst.sourceType, top, cc];
enclosingNode: Node _ SELECT TRUE FROM
forcedIn.ops.makeAMNode = NIL => AmpersandContext.MakeNodeFromNode[forcedIn, cc],
ENDCASE => forcedIn.ops.makeAMNode[inst.sourceType, forcedIn, cc];
PushStack[enclosingNode];
current _ current.next;
END;
inst: REF coerce InstructionBody =>
BEGIN
top: Node _ PopStack[];
PushStack[Coerce[inst.sourceType, inst.targetType, top, cc]];
current _ current.next;
END;
inst: REF binaryOp InstructionBody =>
BEGIN
right: Node _ PopStack[];
left: Node _ PopStack[];
IF left.ops.binaryOp = NIL THEN CCE[cirioError, "2nd top of stack doesn't support binary operations"];
PushStack[left.ops.binaryOp[inst.op, inst.left, inst.right, left, right, cc]];
current _ current.next;
END;
inst: REF unaryOp InstructionBody =>
BEGIN
top: Node _ PopStack[];
IF top.ops.unaryOp = NIL THEN CCE[cirioError, "top of stack doesn't support unary operations"];
PushStack[top.ops.unaryOp[inst.op, inst.type, top, cc]];
current _ current.next;
END;
inst: REF buildRecord InstructionBody =>
BEGIN
fields: LIST OF Node _ NIL;

FOR I: INT IN [0..inst.nFields) DO
fieldVal: Node _ PopStack[];
fields _ CONS[fieldVal, fields];
ENDLOOP;
PushStack[Records.ConstructRecordNode[inst.rcdType, fields, cc]];
current _ current.next;
END;
inst: REF storeUnpopped InstructionBody =>
BEGIN
val: Node _ PopStack[];
indirect: Node _ PopStack[];
IF indirect.ops.store = NIL THEN CCE[cirioError, "top of stack doesn't support store"];
indirect.ops.store[inst.valType, val, inst.indirectType, indirect, cc];
PushStack[val];
current _ current.next;
END;
inst: REF loadThroughIndirect InstructionBody =>
BEGIN
indirect: Node _ PopStack[];
IF indirect.ops.load = NIL THEN CCE[cirioError, "top of stack doesn't support load"];
PushStack[indirect.ops.load[inst.indirectType, indirect, cc]];
current _ current.next;
END;
inst: REF extractField InstructionBody =>
BEGIN
record: Node _ PopStack[];
IF record.ops.extractField = NIL THEN CCE[cirioError, "top of stack doesn't support extractField"];
PushStack[record.ops.extractField[inst.id, inst.type, record, cc]];
current _ current.next;
END;
inst: REF selectField InstructionBody =>
BEGIN
indirect: Node _ PopStack[];
IF indirect.ops.selectField = NIL THEN CCE[cirioError, "top of stack doesn't support selectField"];
PushStack[indirect.ops.selectField[inst.id, inst.indirectType, indirect, cc]];
current _ current.next;
END;
inst: REF apply InstructionBody =>
BEGIN
operand: Node _ PopStack[];
operator: Node _ PopStack[];
IF operator.ops.apply = NIL THEN CCE[cirioError, "2nd top of stack doesn't support apply"];
PushStack[operator.ops.apply[inst.operatorType, inst.operandType, operator, operand, cc]];
current _ current.next;
END;
inst: REF index InstructionBody =>
BEGIN
operand: Node _ PopStack[];
indirectOperator: Node _ PopStack[];
IF indirectOperator.ops.index = NIL THEN CCE[cirioError, "2nd top of stack doesn't support index"];
PushStack[indirectOperator.ops.index[inst.indirectOperatorType, inst.operandType, indirectOperator, operand, cc]];
current _ current.next;
END;
inst: REF selectNestedBlock InstructionBody =>
BEGIN
indirect: Node _ PopStack[];
IF indirect.ops.selectNestedBlock = NIL THEN CCE[cirioError, "2nd top of stack doesn't support selectNestedBlock"];
PushStack[indirect.ops.selectNestedBlock[inst.set, inst.depth, inst.indirectType, indirect, cc]];   -- The first argument is to select between enumerated types block and variable blocks.  Zero selects variable blocks
current _ current.next;
END;
ENDCASE => CCE[cirioError]; -- shouldn't happen

IF debug # NIL THEN {
SS.Bp[debug, always, 0];
debug.PutRope["producing"];
SS.Bp[debug, lookLeft, CCTypes.sia, " "];
ShowTop[];
SS.Bp[debug, always, 0];
SS.Bp[debug, always, 0]};
ENDLOOP;

IF stack.rest # NIL THEN CCE[cirioError]; -- shouldn't happen
RETURN[stack.first];
};




ShowCode: PUBLIC PROC[code: Code] RETURNS[ROPE] =
BEGIN
cellNumb: INT _ 0;
rope: ROPE _ NIL;
NumberACell: PROC[cell: REF InstructionCell] =
{cell.number _ cellNumb; cellNumb _ cellNumb+1};
VisitACell: PROC[cell: REF InstructionCell] =
{rope _ Rope.Cat[rope, "\N", ShowACell[cell]]}; 
WalkCode[code, NumberACell];
WalkCode[code, VisitACell];
RETURN[rope];
END;

ShowACell: PROC[cell: REF InstructionCell] RETURNS[ROPE] =
BEGIN
rope: ROPE _ Rope.Cat[Convert.RopeFromInt[cell.number], ": ",
ShowInstruction[cell.instruction]];
IF cell.alternateNext # NIL THEN
rope _ rope.Cat[rope, " (=> ", Convert.RopeFromInt[cell.alternateNext.number], ")"];
RETURN[rope];
END;

ShowInstruction: PROC[instruction: Instruction, stack: LIST OF Node _ NIL] RETURNS[ROPE] =
BEGIN
typeClass: ROPE _ NIL;
IF stack # NIL THEN 
BEGIN
type: Type _ GetTypeOfNode[stack.first];
typeClass _ Atom.GetPName[CCTypes.GetTypeClass[type]];
IF CCTypes.IsIndirectType[type] THEN typeClass _ Rope.Cat["^", typeClass];
END;
BEGIN
result1: ROPE _ WITH instruction SELECT FROM
inst: REF null InstructionBody => "null",
inst: REF pop InstructionBody => 
Rope.Cat["pop ", Convert.RopeFromInt[inst.n]],
inst: REF test InstructionBody => IF inst.popCond THEN "unPoppedCond" ELSE "poppedCond",
inst: REF loadGlobalFrame InstructionBody => IO.PutFR["loadGlobalFrame %g %g", [rope[inst.name]], [integer[inst.nToSkip]] ],
inst: REF loadAMNode InstructionBody => "loadAMNode",
inst: REF loadNameScope InstructionBody => "loadNameScope",
inst: REF getNameContext InstructionBody => "getNameContext",
inst: REF loadContentsOfAMNode InstructionBody => "loadContentsOfAMNode",
inst: REF makeAMNode InstructionBody => "makeAMNode",
inst: REF coerce InstructionBody => "coerce",
inst: REF binaryOp InstructionBody =>
Rope.Cat["binaryOp ", ShowOp[inst.op]],
inst: REF unaryOp InstructionBody =>
Rope.Cat["unaryOp ", ShowOp[inst.op]],
inst: REF buildRecord InstructionBody => "buildRecord",
inst: REF storeUnpopped InstructionBody => "storeUnpopped",
inst: REF loadThroughIndirect InstructionBody => "loadThroughIndirect",
inst: REF extractField InstructionBody =>
Rope.Cat["extractField ", inst.id],
inst: REF selectField InstructionBody =>
Rope.Cat["selectField ", inst.id],
inst: REF apply InstructionBody => "apply",
inst: REF index InstructionBody => "index",
inst: REF selectNestedBlock InstructionBody =>
Rope.Cat["selectNestedBlock ", Convert.RopeFromInt[inst.depth]],
ENDCASE => CCE[cirioError];
RETURN[Rope.Cat[result1, "   (", typeClass, ")"]];
END;

END;

walkPass: INT _ 0; -- global so that we can walk sharing code fragments

WalkCode: PROC[code: Code, for: PROC[cell: REF InstructionCell]] =
BEGIN
walkPass _ walkPass+1;
IF walkPass = 0 THEN walkPass _ 1;
SubWalk[code, code.first, for];
END;

SubWalk: PROC[code: Code, cell: REF InstructionCell, for: PROC[cell: REF InstructionCell]] =
BEGIN
visitCell: REF InstructionCell _ cell;
WHILE TRUE DO
IF NOT visitCell.visitedOn = walkPass THEN
BEGIN
visitCell.visitedOn _ walkPass;
for[visitCell];
END;
IF visitCell.alternateNext # NIL THEN EXIT;
IF code.last = visitCell THEN EXIT;
visitCell _ visitCell.next;
ENDLOOP;

IF code.last # visitCell THEN
BEGIN
SubWalk[code, visitCell.next, for];
SubWalk[code, visitCell.alternateNext, for];
END;

END;


END..
Ί
CedarCodeImpl.mesa
Copyright Σ 1990 by Xerox Corporation.  All rights reserved.
Sturgis: September 13, 1989 11:46:26 am PDT
Last changed by Theimer on August 25, 1989 7:41:46 pm PDT
Hopcroft July 26, 1989 12:07:06 pm PDT
Last tweaked by Mike Spreitzer on January 10, 1992 9:30 am PST

following stuff is for WalkCode and ShowCode
Here are the exported routines that create code
Uses side effects.  c1 might be damaged.  c2 might share with result.
Uses side effects.  all args might be damaged.
Here is the interpreter
for the moment, the details of nodes will be kept here, although in the near future they will have to migrate out to various files depending on target world and target langauge

Nodes have data and Cedar operations.  The Cedar operations correspond to the instructions above.
does not call the object routine unless Conforms[GetTypeOfNode[node], sourceType] # yes or Conforms[sourceType, targetType] # yes;
{RETURN[SELECT op FROM
$plus => "plus",
$minus => "minus",
$div => "div",
$mult => "mult",
$mod => "mod",
$le => "le",
$lt => "lt",
$eq => "eq",
$ne => "ne",
$gt => "gt",
$ge => "ge",
$and => "and",
$or => "or",
$not => "not",
$max => "max",
$min => "min",
$size => "size",
$bits => "bits",
$bytes => "bytes",
$units => "units",
$words => "words",
$first => "first",
$last => "last",
$uparrow => "uparrow",
ENDCASE => CCE[cirioError]]};
printing code
we have to compute result1 outside the return clause, due to brain damaged mimosa
Κ^•NewlineDelimiter

™
codeš
œ™K™<Kš
œ+™+K™9K™&K™>—K™š
Οk	˜	Kšœœ˜)Kšœœ˜Kšœœe˜rKšœ
œ˜ K˜Kšœœ˜+K˜Kšœœ-˜=Kšœœ˜*Kšœœ˜Kšœ
˜Kšœœ˜#K˜Kš
œ˜K˜—K˜šΟn
œœ
˜Kšœ:œ*˜mKšœ'˜.Kšœ˜—Kšœœ
œ
œ˜"K˜Kšœœœ
˜Kšœœ˜&Kšœœ˜Kšœœ˜'Kšœœ'˜>Kšœœ˜0K˜Kšœœ!œœ˜IK˜Kšœœœ
˜šœ
œ
œœ
˜Kšœ
œ˜"—K˜šœœœ
˜K˜Kšœœ˜Kšœœœ
˜)Kš
œ,™,Kšœœ
˜Kšœœ˜
K˜K˜—Kšœ
œœ˜(šœœœ
˜šœ	˜K˜Kšœœ˜Kšœœ˜Kšœœœ˜.K˜K˜Kšœœ˜)K˜%K˜!K˜)K˜6K˜.Kšœœ˜-K˜5K˜,Kšœœ˜'Kšœœ˜.K˜1K˜9Kšœœ	œ˜@Kšœ˜	—K˜—K˜š
œ/™/˜Kš
œE™E—šž
œœ
œœ
˜7Kšœœ
œœ
œ
œ˜.Kšœœ
œœ
œ
œ˜.K˜K˜Kšœ˜—K˜šžœœ
œ
œ˜9K˜&š
žœœœœœ˜LKš
œœ
œ
œœ˜Kšœœ˜!Kšœœ
œ
œ
˜Kšœœ$œœ˜MKšœ
œœ
œ%˜IKš
œ˜Kš
œ,˜,Kšœ˜—Kšœœœ˜2K˜ Kšœ˜—˜Kš
œ.™.—šžœœ
œ"œ˜NKšœœ'œ˜7—K˜šžœœ
œ"œ˜OKšœœ'œ˜8—K˜šž
œœ+œœ
˜RKšœ.œ$˜UK˜Kšœœ
œ
œ
œ
œ
˜:K˜$K˜.K˜ K˜!K˜Kšœ˜Kš
œ˜—K˜š
ž	œœ
œœœ˜2Kšœ
œ
œ"˜9K˜—šžœœ
œ
œ˜%Kšœ
œ
œ˜5—K˜šžœœœ˜4Kš
˜Kš	œœœœœ	˜HKšœ
œ˜%Kšœ
˜K˜—K˜šžœœ
œœœœ˜LKšœœ
œ6˜O—K˜šžœœ
œ
œ˜0Kšœ
œ
œ'˜>—K˜š
žœœ
œ
œœ˜GKšœ
œ
œ2˜I—K˜šžœœ
œ
œ˜CKšœ
œ
œ2˜I—K˜šžœœ
œ
œ˜9Kšœ
œ
œ(˜?K˜—šžœœ
œœ˜?Kšœ
œ
œ.˜E—K˜šžœœ
œœ˜GKšœ
œ
œ6˜MK˜—šžœœ
œ*œ˜VKšœ
œ
œ1˜HK˜—šžœœ
œ#œ˜NKšœ
œ
œ)˜@—K˜š
žœœ
œ
œœ˜KKšœ
œ
œ5˜L—K˜šžœœ
œ'œ˜VKšœ
œ
œ?˜V—K˜šžœœ
œœ˜JKšœ
œ
œ9˜P—K˜š
žœœ
œœœ˜EKšœ
œ
œ.˜E—K˜š
žœœ
œœœ˜LKšœ
œ
œ5˜L—K˜šž
œœ
œ(œ˜QKšœ
œ
œ8˜O—K˜šž
œœ
œ0œ˜YKšœ
œ
œ@˜W—K˜šžœœ
œœ	œœ˜]Kšœ
œ
œC˜Z—K˜—K˜K˜š
œ™Kš
ϡ
™°
K™Kš
œa™aK˜Kšœœœ
˜Kšœ
œ˜%K˜š
ž
œœœ
œœ˜/Kš	œ
œ
œœœ˜)—K˜šž
œœœ˜7Kš	œ
œœ
œ
œ˜9—K˜šžœœ˜+Kš	œ
œ
œ
œ
œ ˜<—K˜šžœœ
œœ#œ
œœ˜`Kš
˜K˜Kšœœ
œ
œ
˜#K˜K˜Kšœ˜
Kšœ
˜—K˜šž
œœ
œ
œ˜6Kšœ
œ
˜—K˜š
žœœ
œœœ˜EKš
˜šœœ
œ
œ˜7Kšœ
œ$˜/—Kšœ
˜—K˜šžœœ
œ
œ
œ
œ˜;šœ
œ
˜K˜—K˜Kš
œ‚
™‚
—š
žœœ
œ/œœ˜UKš
˜šœ
œ7˜AKš
˜Kšœœ
œ
œ
˜.Kšœ4˜:Kšœ
˜—šœ
œ.˜8Kš
˜Kšœœ
œ
œ
˜.Kšœ4˜:Kšœ
˜—Kšœ˜
Kšœ
˜—K˜š
žœœ
œœœ˜AKš
˜Kšœœ
œ
œ
˜8Kšœ&˜,Kšœ
˜—K˜š
žœœ
œœœ&˜_Kš
˜Kšœœ
œ
œ
˜8Kšœ&˜,Kšœ
˜—K˜š
ž
œœ
œQœœ˜~Kš
˜Kšœœ
œ
œ
˜4KšœJ˜PKšœ
˜—K˜š
žœœ
œ3œœ˜_Kš
˜Kšœœ
œ
œ
˜/Kšœ'˜-Kšœ
˜—K˜šžœœ
œKœ˜uKš
˜Kšœœ
œ
œ
˜5K˜IKšœ
˜—K˜š
žœœ
œ-œœ˜dKš
˜Kšœœ
œ
œ
˜4Kšœ8˜>Kšœ
˜—K˜š
žœœ
œœœ˜HKš
˜šœœ
œ
œ˜+Kšœ
œ#˜.—Kšœ
˜—K˜šžœœ
œœœœ˜[Kš
˜Kšœœ
œ
œ
˜4Kšœ,˜2Kšœ
˜—K˜šžœœ
œœ.œœ˜jKš
˜Kšœ œ
œ
œ
˜;KšœC˜IKšœ
˜—K˜K˜šžœœ
œœœ
œ˜HKš
œ
œ
œœ
œ"œ
œ˜_—K˜šžœœ
œœ
œœœ˜Ošœœ
œ˜šž	œœ
œœ˜"Kš
œ*˜*Kšœ
œ˜
—šœœ˜"Kš
œ
˜
KšΟc?œ˜D—Kšœœ
œ!˜0—Kšœ˜Kšœ˜—K˜šžœœ
œœ
œœœ˜XKšž	œœ*˜9Kš
œ ˜ Kšœ˜—K˜šž
œœ
œœ
œœœœœ˜eKšž	œœ*˜9Kš
œ(˜(Kšœ˜—K˜šžœœ
œœœ
œ
œ˜IKš
œ
œ
œ"œ
œ*œ
œ˜u—K˜šžœœœ
œ˜2š
˜Kšœ˜Kšœ
˜—šœ
œ
œ™K™K™K™K™K™K™K™K™K™K™K™K™K™K™K™K™K™K™K™K™K™K™K™K™Kšœœ™——K˜šž	œœ
œœ	œ
œœœŸ$˜yKšœœ
œœ
˜Kšœ	œŸ˜@Kšœœ˜"KšœœŸ˜"KšœœŸ˜#K˜šžœœ
œ˜Kš
˜K˜K˜Kšœ˜Kšœ
˜—K˜šž	œœ˜Kšœ	œ˜—K˜šžœœ˜Kšœœœ
˜šœ	œ
œ˜Kš
œ(˜(Kš
œ6˜6Kšœœ'˜K—Kš
œ/˜/Kš
œ+˜+—K˜šžœœ˜Kš
œ4˜4Kšœ'˜)Kš
œ/˜/Kšœ˜—K˜šœœ
˜K˜K˜K˜šœ	œ
œ˜K˜;Kšœ˜šœœ
˜$Kšœœ)˜2Kšœœ)˜2Kšœœ&˜/Kšœœ˜——K˜šœœ
˜$šœœ˜!K˜—šœœ˜ Kš
˜š	œ
ž
œœ
œ
˜K˜Kšœ
˜—K˜Kšœ
˜—šœœ˜!Kš
˜Kšœœœœ
˜=Kšœœ
œ
œE˜mšœ ˜"Kšœ˜Kšœ!˜%—Kšœ
˜—šœœ#˜,Kš
˜Kš
œœ
œ
œ
œQ˜uK˜MK˜Kšœ
˜—šœœ˜'Kš
˜K˜<K˜Kšœ
˜—šœœ!˜*Kš
˜KšœŸ0˜IK˜Kšœ
˜—šœœ"˜+Kš
˜K˜Kšœœ
œ
œ@˜hKš
œ<˜<K˜Kšœ
˜—šœœ(˜1Kš
˜K˜K˜Kšœ
˜—šœœ˜'Kš
˜K˜K˜7šœœ
œ
˜&Kšœœ4˜QKšœ;˜B—K˜K˜Kšœ
˜—šœœ˜#Kš
˜K˜K˜=K˜Kšœ
˜—šœœ˜%Kš
˜K˜K˜Kšœœ
œ
œC˜fK˜NK˜Kšœ
˜—šœœ˜$Kš
˜K˜Kšœœ
œ
œ>˜_K˜8K˜Kšœ
˜—šœœ˜(Kš
˜Kšœœ
œœ
˜K˜š	œ
ž
œœ
œ˜"K˜Kšœ	œ˜ Kšœ
˜—K˜AK˜Kšœ
˜—šœœ!˜*Kš
˜K˜K˜Kšœœ
œ
œ3˜WK˜GK˜K˜Kšœ
˜—šœœ'˜0Kš
˜K˜Kšœœ
œ
œ2˜UK˜>K˜Kšœ
˜—šœœ ˜)Kš
˜K˜Kšœœ
œ
œ:˜cK˜CK˜Kšœ
˜—šœœ˜(Kš
˜K˜Kšœœ
œ
œ9˜cK˜NK˜Kšœ
˜—šœœ˜"Kš
˜K˜K˜Kšœœ
œ
œ7˜[K˜ZK˜Kšœ
˜—šœœ˜"Kš
˜K˜K˜$Kšœœ
œ
œ7˜cK˜rK˜Kšœ
˜—šœœ%˜.Kš
˜K˜Kšœ"œ
œ
œC˜sKšœdŸt˜Ψ
K˜Kšœ
˜—KšœœŸ˜/—K˜šœ	œ
œ˜Kšœ˜K˜Kšœ'˜)Kš
œ
˜
Kšœ˜Kšœ˜—Kšœ
˜K˜—Kš	œœ
œ
œŸ˜=Kšœ˜Kš
œ˜——K˜K˜K˜š
œ
™
K˜š
žœœ
œ
œ
œ˜1Kš
˜Kšœ
œ˜Kšœœœ
˜šžœœœ˜.K˜0—šž
œœœ˜-K˜0—K˜K˜Kšœ˜
Kšœ
˜—K˜š
ž	œœœœ
œ˜:Kš
˜šœœ3˜=K˜#—šœœ
˜ K˜T—Kšœ˜
Kšœ
˜—K˜šžœœ"œ
œœœ
œ˜ZKš
˜Kšœœœ
˜šœ	œ
œ
˜Kš
˜Kš
œ(˜(Kš
œ6˜6Kšœœ&˜JKšœ
˜—™QKš
˜šœ	œœ
œ
˜,Kšœœ ˜)šœœ˜!K˜.—Kš	œœœœœ˜XKšœœ$œM˜|Kšœœ,˜5Kšœœ2˜;Kšœœ4˜=Kšœœ@˜IKšœœ,˜5Kšœœ$˜-šœœ˜%K˜'—šœœ˜$K˜&—Kšœœ.˜7Kšœœ2˜;Kšœœ>˜Gšœœ ˜)K˜#—šœœ˜(K˜"—Kšœœ"˜+Kšœœ"˜+šœœ%˜.K˜@—Kšœœ
˜—Kšœ,˜2Kšœ
˜—K˜Kšœ
˜—K˜Kšœ
œŸ4˜GK˜šžœœœœ˜BKš
˜K˜Kšœœ˜"K˜Kšœ
˜—K˜š
žœœœœœ˜\Kš
˜Kšœœ˜&šœ
œ
˜
šœ
œ ˜*Kš
˜K˜K˜Kšœ
˜—Kšœœ
œ
œ
˜+Kšœœ
œ
˜#K˜Kšœ
˜—K˜šœ˜Kš
˜K˜#K˜,Kšœ
˜—K˜Kšœ
˜—K˜K˜—Kšœ˜—…—S’sΊ