DIRECTORY
CCTypes USING[CCError, CCErrorCase, GetAnyTargetType, GetCharType, GetIndirectType, GetRopeType, GetTargetTypeOfIndirect, Operator],
CedarCode,
CedarNumericTypes USING[CreateNumericNode, CreateNumericType],
CedarOtherPureTypes USING[CreateCharNode, CreateRopeNode],
CirioSyntacticOperations USING[CompileForRHS, CreateParseTree, ParseTree, ParseTreeFunctions, LHSapply, LHSDot, LHSFieldIdentifier, LHSIdentifier, LHSuparrow, NameArgPair, RHSApply, RHSCons, RHSAssignment, RHSBinaryOp, RHSConstructor, RHSDot, RHSFieldIdentifier, RHSIdentifier, RHSLiteral, RHSnAryOp, RHSNil, RHSPairConstructor, RHSUnaryOp],
CirioTypes USING[CompilerContext, Node, Type, TypedCode],
IO USING [PutFR, int, real, card, char],
PPLeaves USING[HTIndex, LTIndex],
PPTree USING[Link, Node, NodeName], 
Procedures USING [ProcLiteral, CreateProcLiteralType, CreateProcLiteralNode],
Rope USING[Equal, Fetch, ROPE, Cat],
Types,
WalkCedarParseTrees USING[];

WalkCedarParseTreesImpl: CEDAR PROGRAM
IMPORTS CCTypes, CedarCode, CedarNumericTypes, CedarOtherPureTypes, CirioSyntacticOperations, IO, Procedures, Rope, Types
EXPORTS WalkCedarParseTrees
= BEGIN OPEN CSO: CirioSyntacticOperations;

Type: TYPE = CirioTypes.Type;
TypedCode: TYPE = CirioTypes.TypedCode;
CompilerContext: TYPE = CirioTypes.CompilerContext;
Operator: TYPE = CCTypes.Operator;
CC: TYPE = CirioTypes.CompilerContext;
CCError: ERROR[case: CCTypes.CCErrorCase _ syntax, msg: Rope.ROPE _ NIL] _ CCTypes.CCError;



CreatePPTreeParseTree: PUBLIC PROC[tree: PPTree.Link, cc: CompilerContext] RETURNS[CSO.ParseTree] =
{RETURN[CSO.CreateParseTree[PTF, tree]]};

PTF: REF CSO.ParseTreeFunctions _ NEW[CSO.ParseTreeFunctions_[
CompileCedarPTExpForRHS,
CompileCedarPTExpForLHS,
CompileCedarPTExpAsFieldExtraction,
CompileCedarPTExpAsFieldSelection,
CompileCedarPTExpShowParseTree]];


CompileCedarPTExpForLHS: PROC[tree: CSO.ParseTree, cc: CompilerContext, data: REF ANY] RETURNS[TypedCode] =
BEGIN
pptree: PPTree.Link _ NARROW[data];

WITH pptree SELECT FROM
hti: PPLeaves.HTIndex => RETURN[CSO.LHSIdentifier[hti.name, cc]];
node: REF PPTree.Node => 
BEGIN
kind: PPTree.NodeName = node.name;
nSons: CARDINAL _ node.sonLimit - 1;
son1: PPTree.Link _ IF nSons > 0 THEN node.son[1] ELSE NIL;
son2: PPTree.Link _ IF nSons > 1 THEN node.son[2] ELSE NIL;
left: CSO.ParseTree _ CreatePPTreeParseTree[son1, cc];
SELECT node.name FROM
dot =>
BEGIN
WITH son2 SELECT FROM
hti: PPLeaves.HTIndex => RETURN[CSO.LHSDot[left, hti.name, cc]];
ENDCASE => CCError[]; -- bad syntax?
END;
uparrow =>
RETURN[CSO.LHSuparrow[left, cc]];
apply => RETURN CompileApply[son1, son2, cc, left];
ENDCASE => CCError[unimplemented]; -- we havn't implemented all the possibilities 
END;
ENDCASE => CCError[unimplemented];

END;



CompileCedarPTExpForRHS: PROC[tree: CSO.ParseTree, nominalTarget: Type, cc: CompilerContext, data: REF ANY] RETURNS[TypedCode] =
BEGIN
pptree: PPTree.Link _ NARROW[data];

WITH pptree SELECT FROM
node: REF PPTree.Node => RETURN [EvalNode[node, nominalTarget, cc]];
hti: PPLeaves.HTIndex => RETURN[CSO.RHSIdentifier[hti.name, nominalTarget, cc]];
lti: PPLeaves.LTIndex => -- we have a literal in hand
BEGIN
WITH lti.value SELECT FROM
int: REF INT =>
BEGIN -- because the parser returns a negative int when it should return a large CARD we have to make a test
IF int^ >= 0 THEN RETURN[CSO.RHSLiteral[CreateNodeFromLiteral[int, cc], cc]]
ELSE
BEGIN
SELECT Rope.Fetch[lti.literal, 0] FROM
'+, '0, '1, '2, '3, '4, '5, '6, '7, '8, '9 => -- client intended a large CARD
RETURN[CSO.RHSLiteral[CreateNodeFromLiteral[NEW[CARD32_LOOPHOLE[int^]], cc], cc]];
'- => {RETURN[CSO.RHSLiteral[CreateNodeFromLiteral[int, cc], cc]]};
ENDCASE => CCError[cirioError]; -- my assumption wasn't true
END;
END;
card: REF CARD => RETURN [CSO.RHSLiteral[CreateNodeFromLiteral[card, cc], cc]];
real: REF REAL => RETURN[CSO.RHSLiteral[CreateNodeFromLiteral[real, cc], cc]];
rope: REF Rope.ROPE => RETURN[CSO.RHSLiteral[CreateNodeFromLiteral[rope, cc], cc]];
proc: REF Procedures.ProcLiteral => RETURN [CSO.RHSLiteral[CreateNodeFromLiteral[proc, cc], cc]];
ENDCASE => CCError[unimplemented, "unimplemented literal encountered"];
END;
ENDCASE => CCError[unimplemented, "unimplemented type encountered"];
END;

EvalNode: PROC[node: REF PPTree.Node, nominalTarget: Type, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
kind: PPTree.NodeName = node.name;
nSons: CARDINAL _ node.sonLimit - 1;
son1: PPTree.Link _ IF nSons > 0 THEN node.son[1] ELSE NIL;
son2: PPTree.Link _ IF nSons > 1 THEN node.son[2] ELSE NIL;


SELECT kind FROM -- only expression types, extremly few of them
or, and, not, relE, relN, relL, relGE, relG, relLE,
plus, uminus, minus, times, div, mod, uparrow => -- unary or binary operator
BEGIN
SELECT nSons FROM 
1 => -- unary operator
BEGIN
op: Operator _ SELECT kind FROM
not => $not,
uminus => $minus,
plus => $plus,
uparrow => $uparrow,
ENDCASE => CCError[unimplemented];
arg: CSO.ParseTree _ CreatePPTreeParseTree[son1, cc];
RETURN[CSO.RHSUnaryOp[op, arg, cc]];
END;
2 => -- binary operator
BEGIN
op: Operator _ SELECT kind FROM  -- IS THIS LIST COMPLETE?
or => $or,
and => $and,
relE => $eq,
relN => $ne,
relL => $lt,
relG => $gt, 
relGE => $ge,
relLE => $le,
plus => $plus,
minus => $minus,
times => $mult,
div => $div,
mod => $mod,
ENDCASE => CCError[cirioError];

left: CSO.ParseTree _ CreatePPTreeParseTree[son1, cc];
right: CSO.ParseTree _ CreatePPTreeParseTree[son2, cc];
RETURN[CSO.RHSBinaryOp[op, left, right, cc]];
END;
ENDCASE => CCError[cirioError]; -- shouldn't happen
END;


mwconst => 
BEGIN
IF nSons # 1 THEN CCError[cirioError]; -- shouldn't happen
RETURN[CompileCedarPTExpForRHS[NIL, nominalTarget, cc, son1]];
END;

max, min =>
BEGIN
list: REF PPTree.Node _ NARROW[son1];
argList: LIST OF CSO.ParseTree _ BuildArgList[list, cc];
op: Operator _ SELECT kind FROM
max => $max,
min => $min,
ENDCASE => CCError[cirioError]; -- shouldn't happen

IF nSons # 1 THEN CCError[cirioError]; -- shouldn't happen
IF list.name # list THEN CCError[cirioError]; -- shouldn't happen

RETURN[CSO.RHSnAryOp[op, argList, cc]];
END;

assignx, dot =>
BEGIN
left: CSO.ParseTree _ CreatePPTreeParseTree[son1, cc];
right: CSO.ParseTree _ CreatePPTreeParseTree[son2, cc];

IF nSons # 2 THEN CCError[cirioError];

SELECT kind FROM
assignx => RETURN[CSO.RHSAssignment[left, right, cc]];
dot => RETURN[CSO.RHSDot[left, right, cc]];
ENDCASE => CCError[cirioError];

END;

apply =>
BEGIN
IF nSons # 2 THEN CCError[cirioError];
IF son1 = NIL THEN
BEGIN -- simply a record constructor (or array constructor?)
list: REF PPTree.Node _ NARROW[son2];
nItems: INT _ list.sonLimit-1;

IF nItems = 0 THEN
RETURN[CSO.RHSConstructor[NIL, nominalTarget, cc]];


WITH list.son[1] SELECT FROM
node: REF PPTree.Node =>
BEGIN
SELECT NARROW[list.son[1], REF PPTree.Node].name FROM
item => RETURN[CSO.RHSPairConstructor[BuildNameArgPairList[list, cc], nominalTarget, cc]];
ENDCASE => RETURN[CSO.RHSConstructor[BuildArgList[list, cc], nominalTarget, cc]];
END;
ENDCASE => RETURN[CSO.RHSConstructor[BuildArgList[list, cc], nominalTarget, cc]];

END
ELSE RETURN CompileApply[son1, son2, cc, right];
END;

list =>
BEGIN -- presumably a list of arguments to a procedure or an index to an array
IF node.sonLimit = 1 THEN -- the list is empty
RETURN[CSO.RHSConstructor[BuildArgList[node, cc], nominalTarget, cc]];
WITH node.son[1] SELECT FROM
son1Node: REF PPTree.Node =>
BEGIN
SELECT NARROW[node.son[1], REF PPTree.Node].name FROM
item => RETURN[CSO.RHSPairConstructor[BuildNameArgPairList[node, cc], nominalTarget, cc]];
ENDCASE => RETURN[CSO.RHSConstructor[BuildArgList[node, cc], nominalTarget, cc]];
END;
ENDCASE => RETURN[CSO.RHSConstructor[BuildArgList[node, cc], nominalTarget, cc]];
END;

clit => 
BEGIN
WITH son1 SELECT FROM
lti: PPLeaves.LTIndex => -- we have a literal in hand
WITH lti.value SELECT FROM
char: REF CHAR => RETURN[CSO.RHSLiteral[CreateNodeFromLiteral[char, cc], cc]];
ENDCASE => CCError[cirioError];
ENDCASE => CCError[cirioError];
END;

nil => RETURN[CSO.RHSNil[nominalTarget, cc]];

cons =>
BEGIN
IF (nSons # 2) OR (son1 # NIL) THEN CCError[cirioError];
WITH son2 SELECT  FROM
node: REF PPTree.Node =>
BEGIN
list: CSO.ParseTree _ CreatePPTreeParseTree[node, cc];
RETURN[CSO.RHSCons[list, nominalTarget, cc]];
END;
ENDCASE => CCError[cirioError];
END;

addr =>
BEGIN
arg: CSO.ParseTree _ CreatePPTreeParseTree[son1, cc];
IF nSons # 1 THEN CCError[cirioError]; -- shouldn't happen
RETURN[CSO.RHSUnaryOp[$address, arg, cc]];
END;

ENDCASE => CCError[unimplemented, "unimplemented pptree node encountered"];

END;

CompileApply: PROC [son1, son2: PPTree.Link, cc: CC, side: {left, right}] RETURNS [TypedCode] ~ {
WITH son1 SELECT FROM
hti: PPLeaves.HTIndex =>
IF hti.name.Equal["GLOBALVARS"] THEN {
name: Rope.ROPE _ NIL;
nToSkip: INT _ 0;
gf: CirioTypes.Node _ NIL;
gft: CirioTypes.Type;
litTc: TypedCode;
IF son2#NIL THEN WITH son2 SELECT FROM
node: REF PPTree.Node => SELECT node.name FROM
list => {
IF node.sonLimit < 2 OR node.sonLimit > 3 THEN CCError[operation, "GLOBALVARS[] must be given a program name, maybe a number to skip, and no more"];
WITH node.son[1] SELECT FROM
hti2: PPLeaves.HTIndex => name _ hti2.name;
ENDCASE => ERROR CCError[operation, "The first argument to GLOBALVARS[] must be a literal program name"];
IF node.sonLimit>2 THEN WITH node.son[2] SELECT FROM
lti: PPLeaves.LTIndex => WITH lti.value SELECT FROM
ri: REF INT => nToSkip _ ri^;
rc: REF CARD => IF rc^ < INT.LAST THEN nToSkip _ rc^ ELSE ERROR CCError[operation, "The second argument to GLOBALVARS[] must be a literal integer (in [0..INT.LAST])"];
ENDCASE => ERROR CCError[operation, "The second, literal, argument to GLOBALVARS[] must be a literal number"];
ENDCASE => ERROR CCError[operation, "The second argument to GLOBALVARS[] must be a literal integer"];
};
ENDCASE => ERROR CCError[operation, "The arguments to GLOBALVARS must be a list or identifier"];
hti2: PPLeaves.HTIndex => name _ hti2.name;
ENDCASE => ERROR CCError[operation, "GLOBALVARS[] must be given a literal program name"]
ELSE ERROR CCError[operation, "GLOBALVARS[] must be given a literal program name (and maybe a number to skip)"];
IF cc.moduleScope=NIL THEN CCError[operation, "current compiler context cannot fetch global frames"];
gf _ cc.moduleScope.GetModule[cc.moduleScope, name, nToSkip];
IF gf=NIL THEN CCError[operation, IO.PutFR["can't get global vars for module %g skip %g", [rope[name]], [integer[nToSkip]] ]];
gft _ CedarCode.GetTypeOfNode[gf];
litTc _ CSO.RHSLiteral[gf, cc];
SELECT side FROM
left => RETURN [litTc];
right => RETURN[[code: CedarCode.ConcatCode[litTc.code, CedarCode.CodeToLoadThroughIndirect[gft]], type: CCTypes.GetTargetTypeOfIndirect[gft]]];
ENDCASE => ERROR;
}
ELSE IF hti.name.Equal["EXPRTYPE"] THEN {
tt: CirioTypes.Type ~ Types.CreateTypeType[cc];
tit: CirioTypes.Type ~ CCTypes.GetIndirectType[tt];
subjPT: CSO.ParseTree;
subjTC: TypedCode;
tni: Types.TypeIndirectNodeInfo;
tn: CirioTypes.Node;
SELECT side FROM
left => CCError[operation, "EXPRTYPE expressions do not yield left-hand sides"];
right => NULL;
ENDCASE => ERROR;
IF son2=NIL THEN CCError[operation, "EXPRTYPE must be given an argument"];
subjPT _ CreatePPTreeParseTree[son2, cc];
subjTC _ CSO.CompileForRHS[subjPT, CCTypes.GetAnyTargetType[cc], cc];
tni _ NEW [Types.TypeIndirectNodeInfoBody _ [GetDefType, subjTC.type]];
tn _ Types.CreateTypeIndirectNode[tit, tni];
RETURN[CSO.RHSLiteral[tn, cc]];
};
ENDCASE => NULL;
{left: CSO.ParseTree;
left _ CreatePPTreeParseTree[son1, cc];
SELECT side FROM
left => RETURN[CSO.LHSapply[left, AlwaysLookLikeList[son2, cc], cc]];
right => RETURN[CSO.RHSApply[left, AlwaysLookLikeList[son2, cc], cc]];
ENDCASE => ERROR;
}};

GetDefType: PROC [data: REF ANY] RETURNS [CirioTypes.Type]
~ {RETURN [NARROW[data]]};

AlwaysLookLikeList: PROC[presumedList: PPTree.Link, cc: CC] RETURNS[CSO.ParseTree] =
BEGIN

IF presumedList # NIL THEN WITH presumedList SELECT FROM
node: REF PPTree.Node =>
SELECT node.name FROM
list => RETURN[CreatePPTreeParseTree[presumedList, cc]];
ENDCASE => NULL;
ENDCASE => NULL;
BEGIN
listSize: INT _ IF presumedList = NIL THEN 0 ELSE 1;
listNode: REF PPTree.Node _ NEW[PPTree.Node[listSize]];
listNode.name _ list;
IF listSize = 1 THEN listNode.son[1] _ presumedList;
RETURN[CreatePPTreeParseTree[listNode, cc]];
END;

END;

CompileCedarPTExpAsFieldExtraction: PROC[tree: CSO.ParseTree, fieldContext: CirioTypes.Type, cc: CompilerContext, data: REF ANY] RETURNS[TypedCode] =
BEGIN
pptree: PPTree.Link _ NARROW[data];

WITH pptree SELECT FROM
hti: PPLeaves.HTIndex => RETURN[CSO.RHSFieldIdentifier[hti.name, fieldContext, cc]];
ENDCASE => CCError[cirioError];
END;


CompileCedarPTExpAsFieldSelection: PROC[tree: CSO.ParseTree, fieldIndirectContext: CirioTypes.Type, cc: CompilerContext, data: REF ANY] RETURNS[TypedCode] =
BEGIN
pptree: PPTree.Link _ NARROW[data];

WITH pptree SELECT FROM
hti: PPLeaves.HTIndex => RETURN[CSO.LHSFieldIdentifier[hti.name, fieldIndirectContext, cc]];
ENDCASE => CCError[cirioError];
END;

CompileCedarPTExpShowParseTree: PROC [tree: CSO.ParseTree, cc: CompilerContext, data: REF ANY] RETURNS [Rope.ROPE] =
BEGIN
pptree: PPTree.Link _ NARROW[data];

innerShowParseTree: PROC [pptree: PPTree.Link, nestingLevel: CARDINAL] RETURNS [Rope.ROPE] =
BEGIN
blanks: Rope.ROPE _ NIL;
ptNode: Rope.ROPE;
THROUGH [1..nestingLevel] DO
blanks _ Rope.Cat[blanks, "   "];
ENDLOOP;
IF pptree = NIL THEN 
ptNode _ "NIL"
ELSE 
WITH pptree SELECT FROM
node: REF PPTree.Node => 
BEGIN
name: Rope.ROPE _ NodeNameRopes[node.name];
info: Rope.ROPE _ IO.PutFR[", info: %g\n", IO.card[node.info]];
sons: Rope.ROPE _ NIL;
name _ Rope.Cat[name, "    attr: ["];
name _ Rope.Cat[name, IF node.attr[1] THEN "TRUE" ELSE "FALSE"];
name _ Rope.Cat[name, IF node.attr[2] THEN ", TRUE" ELSE ", FALSE"];
name _ Rope.Cat[name, IF node.attr[3] THEN ", TRUE]" ELSE ", FALSE]"];
name _ Rope.Cat[name, info];
FOR i: CARDINAL IN [1..node.sonLimit-1] DO
sons _ Rope.Cat[sons, innerShowParseTree[node.son[i], nestingLevel+1]];
ENDLOOP;
ptNode _ Rope.Cat[name, sons];
END;
hti: PPLeaves.HTIndex => 
BEGIN
index: Rope.ROPE _ IO.PutFR["    index: %g", IO.int[hti.index]];
ptNode _ Rope.Cat[hti.name, index];
END;
lti: PPLeaves.LTIndex => 
BEGIN
index: Rope.ROPE _ IO.PutFR["    index: %g", IO.int[lti.index]];
WITH lti.value SELECT FROM
int: REF INT => ptNode _ IO.PutFR["%g", IO.int[int^]];
real: REF REAL => ptNode _ IO.PutFR["%g", IO.real[real^]];
char: REF CHAR => ptNode _ IO.PutFR["%g", IO.char[char^]];
rope: REF Rope.ROPE => ptNode _ rope^;
proc: REF Procedures.ProcLiteral => ptNode _ "PROC. LITERAL";
ENDCASE => CCError[unimplemented, "unimplemented literal encountered"];
ptNode _ Rope.Cat[ptNode, index, ", literal: ", lti.literal];
END;
ENDCASE => CCError[unimplemented, "unimplemented type encountered"];
RETURN [Rope.Cat[blanks, ptNode, "\n"]];
END;

RETURN [innerShowParseTree[pptree, 0]];
END;


BuildArgList: PROC[list: REF PPTree.Node, cc: CompilerContext] RETURNS[LIST OF CSO.ParseTree] =
BEGIN
nElements: CARDINAL _ list.sonLimit - 1;
argList: LIST OF CSO.ParseTree _ NIL;
IF list.name # list THEN CCError[cirioError]; -- shouldn't happen
FOR I: INT DECREASING IN [1..nElements] DO
pt: CSO.ParseTree _ CreatePPTreeParseTree[list.son[I], cc];
argList _ CONS[pt, argList];
ENDLOOP;
RETURN[argList];
END;

BuildNameArgPairList: PROC[list: REF PPTree.Node, cc: CompilerContext] RETURNS[LIST OF CSO.NameArgPair] =
BEGIN
nPairs: CARDINAL _ list.sonLimit - 1;
pairList: LIST OF CSO.NameArgPair _ NIL;

IF list.name # list THEN CCError[cirioError]; -- shouldn't happen
FOR I: INT DECREASING IN [1..nPairs] DO
pair: REF PPTree.Node _ NARROW[list.son[I]];
id: Rope.ROPE _ PPTreeAsId[pair.son[1]];
arg: PPTree.Link _ pair.son[2];
argt: CSO.ParseTree _ CreatePPTreeParseTree[arg, cc];

IF pair.name # item THEN CCError[cirioError]; -- shouldn't happen
pairList _ CONS[[id, argt], pairList];
ENDLOOP;

RETURN[pairList];
END;

PPTreeAsId: PROC[pptree: PPTree.Link] RETURNS[Rope.ROPE] =
BEGIN
WITH pptree SELECT FROM
hti: PPLeaves.HTIndex => RETURN[hti.name];
ENDCASE => CCError[cirioError]; -- shouldn't happen
END;

CreateNodeFromLiteral: PROC[literal: REF ANY, cc: CC] RETURNS[CirioTypes.Node] =
BEGIN
type: Type _ CreateCedarLiteralType[literal, cc];

WITH literal SELECT FROM
lit: REF REAL => RETURN[CedarNumericTypes.CreateNumericNode[type, literal]];
lit: REF INT => RETURN[CedarNumericTypes.CreateNumericNode[type, literal]];
lit: REF CARD => RETURN[CedarNumericTypes.CreateNumericNode[type, literal]];
lit: REF CHAR => RETURN[CedarOtherPureTypes.CreateCharNode[lit^, cc]];
lit: REF Rope.ROPE => RETURN[CedarOtherPureTypes.CreateRopeNode[lit^, cc]];
lit: REF Procedures.ProcLiteral => RETURN [Procedures.CreateProcLiteralNode[lit^, cc]];
ENDCASE  => CCError[unimplemented] -- we havn't implemented many as yet
END;

CreateCedarLiteralType: PROC[literal: REF ANY, cc: CC] RETURNS[CirioTypes.Type] =
BEGIN
WITH literal SELECT FROM
real: REF REAL =>
RETURN[CedarNumericTypes.CreateNumericType[[32, real[]], cc, NIL]];
int: REF INT =>
IF (int^ < FIRST[INT16]) OR (int^ > LAST[INT16]) THEN
RETURN[CedarNumericTypes.CreateNumericType[[32, signed[full[]]], cc, NIL]]
ELSE
RETURN[CedarNumericTypes.CreateNumericType[[16, signed[full[]]], cc, NIL]];
card: REF CARD =>
BEGIN
IF card^ <= CARD32[LAST[INT32]] THEN 
RETURN [CedarNumericTypes.CreateNumericType[[16, unsigned[full[]]], cc, NIL]]
ELSE 
RETURN[CedarNumericTypes.CreateNumericType[[32, unsigned[full[]]], cc, NIL]];
END;
char: REF CHAR => {
t: CirioTypes.Type ~ CCTypes.GetCharType[cc];
IF cc=NIL THEN CCError[cirioError, "CHAR type not defined yet"];
RETURN[t]};
rope: REF Rope.ROPE => {
t: CirioTypes.Type ~ CCTypes.GetRopeType[cc];
IF t=NIL THEN CCError[cirioError, "ROPE type not defined yet"];
RETURN[t]};
proc: REF Procedures.ProcLiteral =>
RETURN [Procedures.CreateProcLiteralType[proc^, cc]];
ENDCASE => CCError[unimplemented]; -- we havn't implemented many as yet
END;

NodeNameRopes: ARRAY PPTree.NodeName OF Rope.ROPE ~ [ list: "list", item: "item", decl: "decl", typedecl: "typedecl",
basicTC: "basicTC", enumeratedTC: "enumeratedTC", recordTC: "recordTC", monitoredTC: "monitoredTC", variantTC: "variantTC",
refTC: "refTC", pointerTC: "pointerTC", listTC: "listTC", arrayTC: "arrayTC", arraydescTC: "arraydescTC", sequenceTC: "sequenceTC",
procTC: "procTC", processTC: "processTC", portTC: "portTC", signalTC: "signalTC", errorTC: "errorTC", programTC: "programTC",
anyTC: "anyTC", definitionTC: "definitionTC", unionTC: "unionTC", relativeTC: "relativeTC",
subrangeTC: "subrangeTC", longTC: "longTC", opaqueTC: "opaqueTC", zoneTC: "zoneTC", linkTC: "linkTC", spareTC: "spareTC",
implicitTC: "implicitTC", frameTC: "frameTC", discrimTC: "discrimTC",
entry: "entry", internal: "internal",
unit: "unit", diritem: "diritem", module: "module", body: "body", inline: "inline", lambda: "lambda", block: "block", assign: "assign", extract: "extract",
if: "if",
case: "case", casetest: "casetest", caseswitch: "caseswitch",
bind: "bind",
do: "do", forseq: "forseq", upthru: "upthru", downthru: "downthru",
return: "return", result: "result",
goto: "goto", exit: "exit", loop: "loop",
free: "free",
resume: "resume", reject: "reject", continue: "continue", retry: "retry", catchmark: "catchmark",
restart: "restart", stop: "stop",
lock: "lock", wait: "wait", notify: "notify", broadcast: "broadcast", unlock: "unlock",
null: "null",
label: "label",
open: "open",
enable: "enable", catch: "catch",
dst: "dst", lst: "lst", lstf: "lstf",
syscall: "syscall", spareS1: "spareS1", spareS2: "spareS2", spareS3: "spareS3",
subst: "subst", call: "call", portcall: "portcall", signal: "signal", error: "error", syserror: "syserror", xerror: "xerror",
start: "start", join: "join", apply: "apply",
callx: "callx", portcallx: "portcallx", signalx: "signalx", errorx: "errorx", syserrorx: "syserrorx", startx: "startx", fork: "fork", joinx: "joinx",
index: "index", dindex: "dindex", seqindex: "seqindex", reloc: "reloc",
construct: "construct", union: "union", rowcons: "rowcons", sequence: "sequence", listcons: "listcons",
substx: "substx",
ifx: "ifx", casex: "casex", bindx: "bindx",
assignx: "assignx", extractx: "extractx",
or: "or", and: "and",
relE: "relE", relN: "relN", relL: "relL", relGE: "relGE", relG: "relG", relLE: "relLE", in: "in", notin: "notin",
plus: "plus", minus: "minus", times: "times", div: "div", mod: "mod",
dot: "dot", cdot: "cdot", dollar: "dollar",
create: "create",
not: "not",
uminus: "uminus",
addr: "addr",
uparrow: "uparrow",
min: "min", max: "max", lengthen: "lengthen", abs: "abs", all: "all",
size: "size", first: "first", last: "last", pred: "pred", succ: "succ",
arraydesc: "arraydesc", length: "length", base: "base",
loophole: "loophole",
nil: "nil",
new: "new",
void: "void",
clit: "clit", llit: "llit",
cast: "cast", check: "check", float: "float", pad: "pad", chop: "chop", safen: "safen",
syscallx: "syscallx", narrow: "narrow", istype: "istype",
openx: "openx",
mwconst: "mwconst", cons: "cons",
atom: "atom", typecode: "typecode",
stringinit: "stringinit", textlit: "textlit", signalinit: "signalinit", procinit: "procinit",
intOO: "intOO", intOC: "intOC", intCO: "intCO", intCC: "intCC",
thread: "thread",
none: "none",
exlist: "exlist",
initlist: "initlist",
ditem: "ditem",
self: "self",
mergecons: "mergecons"];

END..
Ά
WalkCedarParseTreesImpl.mesa
Copyright Σ 1990 by Xerox Corporation.  All rights reserved.
Sturgis: March 5, 1989 4:07:45 pm PST
Last changed by Theimer on August 9, 1989 11:58:43 pm PDT
Hopcroft July 26, 1989 10:21:00 am PDT
Spreitze, May 27, 1991 7:16 pm PDT
we have an identifier in hand
assume that the first char is either a digit or a sign
I probably could have avoided the loophole by appropriate arithmetic, first in the INT32 domain and then in the CARD32 domain.  However, the correctness of that arithmetic is just as dependent on representations as is the use of LOOPHOLE.
At this point we must decide whether we are dealing with a name:arg pair list, or simply a list of args
we must decide whether we are dealing with a name:arg pair list, or simply a list of args
this code matches that in apply where son1 = nil, perhaps there is a way to combine them?

ok, we have to encase it in a list
we have an identifier in hand
we have an identifier in hand
nameRef: REF ANY _  NEW [PPTree.NodeName _ node.name];
name: Rope.ROPE _ IO.PutFR["%g", IO.refAny[nameRef]];
in PPTrees a literal is represented as a REF to the value.  (So we can avoid interpreting the textual value of the literal.)
Κ@•NewlineDelimiter

™š
œ™J™<Jš
œ%™%Icode™9K™&K™"—J˜š
Οk	˜	Kšœœw˜„
K˜
Kšœœ'˜>Kšœœ!˜:Kšœœ·˜ΥKšœœ)˜9Kšœ
œ ˜(Kšœ	œ˜!Kšœœ˜$Kšœœ=˜MKšœœœ˜$K˜Kšœœ˜—J˜šΟnœœ
˜&KšœWœ˜yKšœ˜—Kšœœ
œ
œ˜+J˜Jšœœ˜Jšœœ˜'Jšœœ˜3Jšœ
œ˜"Jšœœ˜&Jšžœœ/œœ˜[J˜J˜J˜š
žœœ
œ)œ
œ
˜cJšœ
œ
œœ
˜)—J˜š
œœ
œœ
œ˜>J˜J˜J˜#J˜"J˜!—J˜J˜šžœœœ'œ
œœ
˜kJš
˜Jšœœ˜#J˜šœœ
˜šœœ
œ˜AJš
œ™—šœœ˜Jš
˜J˜"Jšœœ˜$Jš	œœœ
œ
œ
˜;Jš	œœœ
œ
œ
˜;Jšœœ-˜6šœ˜˜Jš
˜šœœ
˜Jšœœ
œ˜@JšœΟc˜$—Jšœ
˜—˜
Jšœ
œ˜!—Jšœ	œ$˜3JšœŸ/˜R—Jšœ
˜—Jšœ˜"—J˜Jšœ
˜—J˜J˜J˜šžœœœ<œ
œœ
˜€
Jš
˜Jšœœ˜#J˜šœœ
˜Jšœœœ%˜DJšœœ
œ-˜PšœŸ˜5Jš
˜šœœ
˜šœœ
œ˜Jšœ
Ÿf˜lšœœ
œ
œ0˜Lš
˜Jš
˜Jš
œ6™6šœ˜&šœ.Ÿ˜Mš
œ
œ"œ
œ
œ˜RJš
œξ
™ξ
——Jšœœ
œ2˜CJšœŸ˜<—Jšœ
˜——Jšœ
˜—Kš	œœ
œœœ2˜OJš	œœ
œœ
œ2˜NJš	œœœœ
œ2˜SKšœœœœ2˜aJšœ@˜G—Jšœ
˜—Jšœ=˜D—Jšœ
˜—J˜šžœœœ8œ
˜dJš
˜J˜"Jšœœ˜$Jš	œœœ
œ
œ
˜;Jš	œœœ
œ
œ
˜;J˜J˜šœœ
Ÿ.˜?J˜3šœ1Ÿ˜LJš
˜šœœ
˜šœŸ˜Jš
˜šœœ˜J˜J˜J˜J˜Jšœ˜"—Jšœœ-˜5Jšœ
œ˜$Jšœ
˜—šœŸ˜Jš
˜šœœœŸ˜:J˜
J˜J˜J˜J˜J˜
J˜
J˜
J˜J˜J˜J˜J˜Jšœ˜J˜—Jšœœ-˜6Jšœœ-˜7Jšœ
œ#˜-Jšœ
˜—JšœŸ˜3—šœ
˜J˜——J˜˜Jš
˜JšœœŸ˜:Jšœœ˜>Jšœ
˜—J˜˜Jš
˜Jšœœœ˜%Jšœ	œ
œ
œ$˜8šœœ˜J˜J˜JšœŸ˜3—J˜JšœœŸ˜:JšœœŸ˜AJ˜Jšœ
œ˜'Jšœ
˜—J˜˜Jš
˜Jšœœ-˜6Jšœœ-˜7J˜Jšœœ˜&J˜šœ˜Jšœœ
œ!˜6Jšœœ
œ˜+Jšœ˜—J˜Jšœ
˜—J˜˜Jš
˜Jšœœ˜&šœœ
˜Jšœ
Ÿ6˜<Jšœœœ˜%Jšœœ˜J˜šœ˜Jšœ
œœ˜3—J˜Jš
œg™gJ˜šœ
œ
˜šœœ˜Jš
˜šœ
œœ˜5Jšœœ
œH˜ZJšœœ
œ<˜Q—Jšœ
˜—Jšœœ
œ<˜Q—J˜Jš
˜—Kšœ
œ%˜0Jšœ
˜—J˜˜Jšœ
ŸH˜NJš
œY™YJš
œY™Yšœœ
Ÿ˜.Jšœ
œ<˜F—šœ
œ
˜šœ
œ˜Jš
˜šœ
œœ˜5Jšœœ
œH˜ZJšœœ
œ<˜Q—Jšœ
˜—Jšœœ
œ<˜Q—Jšœ
˜—J˜˜Jš
˜šœœ
˜šœŸ˜5šœœ
˜Jš	œœ
œœ
œ2˜NJšœ˜——Jšœ˜—Jšœ
˜—J˜Jšœœ
œ˜-J˜š
œ˜Kš
˜Kšœ
œœœ˜8šœœ˜šœœ˜Kš
˜Kšœœ-˜6Kšœ
œ#˜-Kšœ
˜—Kšœ˜—Kšœ
˜—K˜š
œ˜Kš
˜Kšœœ-˜5Kšœ
œŸ˜:Kšœ
œ ˜*Kšœ
˜—J˜JšœD˜KJ˜—Jšœ
˜—J˜šžœœœœ˜ašœœ
˜š
œ˜šœœ˜&Kšœœœ
˜Kšœ	œ˜Kšœœ
˜K˜K˜šœœ
œ
œœ
˜&šœœœ˜.š
œ	˜	Kšœœœf˜”
šœ
œ
˜Kš
œ+˜+KšœœY˜i—š	œœ
œ
œ
˜4šœœœ
˜3Kšœœ
œ˜Kšœœ
œœœ
œ
œœ
œh˜§
Kšœœ^˜n—KšœœU˜e—K˜—KšœœP˜`—Kš
œ+˜+KšœœH˜X—Kšœ
œf˜pKšœœ
œK˜eK˜=Kšœœ
œœZ˜~Kš
œ"˜"Kšœœ˜šœ˜Kšœœ	˜Kšœ	œ
˜
Kšœœ
˜—K˜
—šœ
œœ˜)Kš
œ/˜/Kš
œ3˜3Kšœœ˜K˜Kš
œ ˜ K˜šœ˜Kš
œP˜PKšœ	œ
˜Kšœœ
˜—Kšœœ
œ:˜JKš
œ)˜)Kšœ	œ9˜EKšœœ>˜GKš
œ,˜,Kšœ
œ˜K˜——Kšœœ
˜—Kšœœ˜Kš
œ'˜'šœ˜Kšœœ
œ3˜EKšœ	œ
œ3˜FKšœœ
˜—Kš
œ˜—K˜š
ž
œœœ
œœ˜:Jšœœœ	˜—J˜š
žœœ œœ
œ
˜TJš
˜J˜šœœ
œ
œœ
˜8šœœ˜šœ˜Jšœœ*˜8Jšœœ
˜——Jšœœ
˜—J™š
œ"™"Jš
˜Jšœ
œœœ
œœ˜4Jšœ
œœ˜7J˜Jšœœ ˜4Jšœ&˜,Jšœ
˜J˜—Jšœ
˜—J˜šž"œœœFœ
œœ
˜•
Jš
˜Jšœœ˜#J˜šœœ
˜šœœ
œ1˜TJš
œ™—Jšœ˜—Jšœ
˜—J˜J˜šž!œœœNœ
œœ
˜œ
Jš
˜Jšœœ˜#J˜šœœ
˜šœœ
œ9˜\Jš
œ™—Jšœ˜—Jšœ
˜—J˜šžœœœ'œ
œœœ˜tKš
˜Jšœœ˜#J˜š
žœœ%œœœ˜\Kš
˜Kšœ
œœ
˜Kšœ
œ
˜šœ˜K˜!Kšœ
˜—šœ
œ
˜Kš
œ˜—šœ
˜šœœ
˜šœœ˜Kš
˜Kšœ	œ
œœ™6Kšœœœœ™5Kšœœ˜+Kšœœœœ˜?Kšœœœ
˜K˜%Kšœœ
œœ
˜@Kšœœ
œ
œ˜DKšœœ
œœ
˜FKš
œ˜šœœ
œ˜*K˜GKšœ
˜—Kš
œ˜Kšœ
˜—š
œ˜Kš
˜Kšœœœœ˜@Kš
œ#˜#Kšœ
˜—š
œ˜Kš
˜Kšœœœœ˜@šœœ
˜Kš	œœ
œ
œœ˜6Kš	œœ
œ
œœ˜:Kš	œœ
œ
œ
œ˜:Kšœœœ˜&Kšœœ4˜=Kšœ@˜G—K˜=Kšœ
˜—Kšœ=˜D—Kšœ"˜(—Kšœ
˜—K˜Kšœ!˜'Kšœ
˜—K˜J˜šžœœœ#œ
œ
œ
œ
˜_Jš
˜Jšœœ˜(Jš	œ	œ
œ
œ
œ
˜%JšœœŸ˜Ašœ
ž
œœ

œ
œ˜*Jšœœ4˜;Jšœ
œ˜Jšœ
˜—Jšœ
˜Jšœ
˜—J˜šžœœœ#œ
œ
œ
œ˜iJš
˜Jšœœ˜%Jš	œ
œ
œ
œœ
˜(J˜JšœœŸ˜Ašœ
ž
œœ

œ
œ
˜'Jšœœœ˜,Jšœ	œ˜(J˜Jšœœ,˜5J˜JšœœŸ˜AJšœœ˜&Jšœ
˜—J˜Jšœ˜Jšœ
˜—J˜šž
œœœœ˜:Jš
˜šœœ
˜Jšœœ˜*JšœŸ˜3—Jšœ
˜—˜Jš
œ|™|—šžœœ
œ
œœœ˜PJš
˜J˜1J˜šœ	œ
˜Jšœœ
œœ5˜LJšœœ
œœ5˜KJšœœ
œœ5˜LJšœœ
œœ/˜FJšœœœœ/˜KKšœœœ.˜WJšœŸ$˜G—Jšœ
˜—J˜šžœœ
œ
œœœ˜QJš
˜šœ	œ
˜šœœ
œ˜Jšœ7œ˜C—šœœ
œ˜š
œ	œ
œœ	œ
œ˜5Jšœ?œ˜Jš
˜Jšœ?œ˜K———šœœ
œ˜Jš
˜š
œ
œ
œ
œœ
˜%KšœBœ˜M—šœ
˜JšœAœ˜M—Jšœ
˜—šœœ
œ˜Jš
œ-˜-Jšœœ
œ2˜@Jšœ˜—šœœœ˜Jš
œ-˜-Jšœœ
œ2˜?Jšœ˜—šœœ˜#Kšœ/˜5—JšœŸ$˜G—Jšœ
˜—J˜šž
œœœœD˜uK˜{K˜ƒ
K˜}K˜[K˜yK˜EK˜%K˜›
K˜	K˜=K˜
K˜CK˜#K˜)K˜
K˜aK˜!K˜WK˜
K˜K˜
K˜!K˜%K˜OK˜}K˜-K˜•
K˜GK˜gK˜K˜+K˜)K˜K˜qK˜EK˜+K˜K˜K˜K˜
K˜K˜EK˜GK˜7K˜K˜K˜K˜
K˜K˜WK˜9K˜K˜!K˜#K˜]K˜?K˜K˜
K˜K˜K˜K˜
K˜—K˜Jšœ˜—…—Snφ