DIRECTORY Ascii, Atom, Basics, Commander, CommanderOps, Convert, CrankIO, CrankTypes, FS, IO, MPLeaves, MesaParser, MPTree, ProcessProps, Rope, StructuredStreams, UnparserBuffer;

CrankIOImpl: CEDAR MONITOR
IMPORTS Ascii, Atom, Basics, Commander, CommanderOps, Convert, FS, IO, MesaParser, ProcessProps, Rope, StructuredStreams, UnparserBuffer
EXPORTS CrankIO
~ BEGIN OPEN CrankTypes;


ROPE: TYPE = Rope.ROPE;

Huh: PUBLIC SIGNAL [tree: Tree] = CODE;

Parse: PROC [program: ROPE, errout: IO.STREAM] RETURNS [Tree] = INLINE {
RETURN [MesaParser.Parse[program, errout].root]
};

MakeOutputName: PUBLIC PROC [inputName: ROPE, ext: ROPE] RETURNS [ROPE] ~ {
cp: FS.ComponentPositions;
[inputName, cp] ¬ FS.ExpandName[inputName];
RETURN [Rope.Cat[Rope.Substr[inputName, cp.base.start, cp.base.length], ".", ext]]
};

ParseRope: PUBLIC PROC [rope: ROPE] RETURNS [MPTree.Link] = {
errout: IO.STREAM ¬ NARROW[ProcessProps.GetProp[$StdOut]];
RETURN [Parse[rope, errout]];
};

GetRopeFile: PROC [name: ROPE] RETURNS [rope: ROPE] = {
in: IO.STREAM ¬ FS.StreamOpen[fileName: name, accessOptions: read];
rope ¬ IO.GetRope[in];
IO.Close[in];
};

ParseFile: PUBLIC PROC [fileName: ROPE] RETURNS [MPTree.Link] = {
errout: IO.STREAM ¬ NARROW[ProcessProps.GetProp[$StdOut]];
result: MPTree.Link ¬ Parse[GetRopeFile[fileName], errout];
RETURN [result];
};

RopeFromTree: PUBLIC PROC [tree: Tree] RETURNS [ROPE] = {
stream: IO.STREAM ¬ IO.ROS[];
PutTree[stream, tree];
RETURN [IO.RopeFromROS[stream]]
};

WriteTree: PUBLIC PROC [tree: Tree, fileName: ROPE, sourceName: ROPE, skipAttributes: LIST OF ATOM] RETURNS [fullFName: ROPE] = {
stream: IO.STREAM = FS.StreamOpen[fileName, $create];
fullFName ¬ FS.GetName[FS.OpenFileFromStream[stream]].fullFName;
PutTree[stream, tree, FALSE, united, sourceName, skipAttributes];
IO.Close[stream];
};

WriteSTree: PUBLIC PROC [tree: Tree, fileName: ROPE, breakCondition: UnparserBuffer.BreakCondition ¬ united, sourceName: ROPE ¬ NIL, skipAttributes: LIST OF ATOM ¬ NIL] RETURNS [fullFName: ROPE] = {
IF Basics.IsBound[UnparserBuffer.NewInittedHandle]
THEN {
writer: IO.STREAM = FS.StreamOpen[fileName, $create];
handle: UnparserBuffer.Handle = UnparserBuffer.NewInittedHandle[[output: [stream[writer]]]];
stream: IO.STREAM = StructuredStreams.Create[onTopOf: handle];
PutTree[stream, tree, TRUE, breakCondition, sourceName, skipAttributes];
StructuredStreams.CloseThrough[stream];
fullFName ¬ FS.FileInfo[name: fileName].fullFName;
}
ELSE {
RETURN WriteTree[tree, fileName, sourceName, skipAttributes];
};
};

nodeNames: ARRAY MPTree.NodeName OF 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", varTC: "varTC", implicitTC: "implicitTC", frameTC: "frameTC", discrimTC: "discrimTC", paintTC: "paintTC", optionTC: "optionTC", spareTC: "spareTC", 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", lste: "lste", lstf: "lstf", syscall: "syscall", checked: "checked", lst: "lst", 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", power: "power", dot: "dot", cdot: "cdot", dollar: "dollar", create: "create", not: "not", uminus: "uminus", addr: "addr", uparrow: "uparrow", min: "min", max: "max", ord: "ord", val: "val", 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", lengthen: "lengthen", shorten: "shorten", self: "self", gcrt: "gcrt", proccheck: "proccheck", entry: "entry", internal: "internal", invalid: "invalid" ];

RopeFromNodeName: PUBLIC PROC [nodeName: MPTree.NodeName] RETURNS [ROPE] = {
RETURN [nodeNames[nodeName]]
};

Raise: PROC [old: CHAR] RETURNS [new: CHAR] = {new ¬ Ascii.Upper[old]};
nodeNameAtoms: ARRAY MPTree.NodeName OF ATOM ¬ ALL[NIL];
AtomFromNodeName: PUBLIC PROC [nodeName: MPTree.NodeName] RETURNS [ATOM] = {
IF nodeNameAtoms[nodeName] = NIL THEN {
nodeNameAtoms[nodeName] ¬ Atom.MakeAtom[Rope.Translate[base: RopeFromNodeName[nodeName], translator: Raise]];
};
RETURN [nodeNameAtoms[nodeName]]
};

AllUpperCase: PROC [rope: ROPE] RETURNS [BOOL] = {
each: PROC [c: CHAR] RETURNS [quit: BOOL] = { quit ¬ NOT (c IN ['A..'Z] OR c IN ['0..'9]) };
RETURN [NOT Rope.Map[base: rope, action: each]]
};

DecodeAttr: PUBLIC PROC [name: MPTree.NodeName, attrBits: PACKED ARRAY MPTree.AttrId OF BOOL] RETURNS [Attributes] = {
attr: PACKED ARRAY MPTree.AttrId OF BOOL ¬ attrBits;
list: LIST OF REF ANY ¬ NIL;
Means: PROC [attrid: MPTree.AttrId, attrName: ATOM] = {
IF attr[attrid] THEN { list ¬ CONS[attrName, CONS[$TRUE, list]]; attr[attrid] ¬ FALSE };
};
Checking: PROC = {
AddChecking: PROC [a: ATOM] = {
list ¬ CONS[$CHECKING, CONS[a, list]];
attr[1] ¬ attr[2] ¬ FALSE;
};
SELECT ORD[attr[1]]*2+ORD[attr[2]] FROM
3 => {AddChecking[$CHECKED]};
1 => {AddChecking[$TRUSTED]};
0 => {AddChecking[$UNCHECKED]};
ENDCASE => NULL;
};
IF attr = ALL[FALSE] THEN RETURN [NIL];
SELECT name FROM
mwconst => {Means[1, $FLOATINGPOINT]};
size => {
SELECT attr FROM
[FALSE, FALSE, FALSE] => RETURN[LIST[$UNITS, $BITS]];
[TRUE, FALSE, FALSE] => RETURN[LIST[$UNITS, $BYTES]];
[FALSE, TRUE, FALSE] => RETURN[LIST[$UNITS, $ADDRESSUNITS]];
[TRUE, TRUE, FALSE] => RETURN[LIST[$UNITS, $WORDS]];
ENDCASE => NULL;
};
inline, block => { Checking[] };
body => { Means[3, $INLINE]; Checking[] };
programTC => { Means[3, $CEDAR]; Means[1, $MONITOR] };
procTC => { Means[3, $SAFE] };
monitoredTC, recordTC => {
IF NOT attr[3] THEN SIGNAL Huh[NIL];
attr[3] ¬ FALSE;
Means[1, $MACHINEDEPENDENT];
};
enumeratedTC => { Means[2, $MACHINEDEPENDENT] };
sequenceTC, arrayTC => { Means[3, $MACHINEDEPENDENT]; Means[3, $PACKED] };
typedecl, decl => { Means[2, $PUBLIC]; Means[1, $CONSTANT] };
variantTC => { Means[1, $MACHINEDEPENDENT] };
refTC => { Means[3, $READONLY] };
ENDCASE => NULL;
Means[3, $ATTRBIT3];
Means[2, $ATTRBIT2];
Means[1, $ATTRBIT1];
RETURN [list];
};

Bp: PROC [p: PutTreeOptions] = {
IO.PutChar[p.stream, ' ];
IF p.structure THEN StructuredStreams.Bp[p.stream, p.breakCondition, 1];
};

PutTreeOptions: TYPE = REF PutTreeOptionsRep;
PutTreeOptionsRep: TYPE = RECORD [stream: IO.STREAM, structure: BOOL ¬ FALSE, breakCondition: UnparserBuffer.BreakCondition ¬ united, idcount: INT ¬ 0, skipAttributes: LIST OF ATOM ¬ NIL];
PutTree: PUBLIC PROC [stream: IO.STREAM, tree: Tree, structure: BOOL ¬ FALSE, breakCondition: UnparserBuffer.BreakCondition ¬ united, sourceFrom: ROPE ¬ NIL, skipAttributes: LIST OF ATOM ¬ NIL] = {
IF sourceFrom # NIL THEN {
IF structure THEN StructuredStreams.Begin[stream];
IO.PutF[stream, "(%lsource-file%l %g) ", [rope["n"]], [rope["N"]], [rope[Convert.RopeFromRope[sourceFrom]]]];
IF structure THEN StructuredStreams.End[stream];
IF structure THEN StructuredStreams.Bp[stream, breakCondition, 1];
};
PutTreeInternal[NEW[PutTreeOptionsRep ¬ [stream, structure, breakCondition, 0, skipAttributes]], tree];
};

PutTreeNode: PROC [p: PutTreeOptions, node: REF MPTree.Node, nodeName: ATOM, attributes: Attributes] = {
IO.PutChar[p.stream, '(];
PutName[p, IF nodeName = NIL OR AtomFromNodeName[node.name] = nodeName THEN RopeFromNodeName[node.name] ELSE Atom.GetPName[nodeName]];
Bp[p];
PutAttributes[p, attributes];
FOR i: NAT IN [1..node.sonLimit) DO
IO.PutChar[p.stream, ' ];
Bp[p];
PutTreeInternal[p, node.son[i]];
ENDLOOP;
IO.PutChar[p.stream, ')];
};

PutHTNode: PROC [p: PutTreeOptions, ht: REF MPLeaves.HTNode, nodeName: ATOM, attributes: Attributes] = {
IO.PutChar[p.stream, '(];
PutName[p, IF nodeName = NIL OR nodeName = $ID THEN "id" ELSE Atom.GetPName[nodeName]];
Bp[p];
PutAttributes[p, attributes];
Bp[p];
IO.PutF1[p.stream, "\"%g\"", IO.rope[ht.name]];
IO.PutChar[p.stream, ')];
IF (p.idcount ¬ p.idcount+1) MOD 10 = 0 THEN {
WITH ProcessProps.GetProp[$StdOut] SELECT FROM
log: IO.STREAM => {
IO.PutChar[log, '.];
IF p.idcount MOD 100 = 0 THEN IO.PutChar[log, ' ];
};
ENDCASE => NULL;
};
};

PutRopeNode: PROC [p: PutTreeOptions, rope: ROPE, attributes: Attributes] = {
IO.PutF1[p.stream, "\"%g\"", IO.rope[rope]];
};

PutLTNode: PROC [p: PutTreeOptions, lit: REF MPLeaves.LTNode, nodeName: ATOM, attributes: Attributes] = {
IO.PutChar[p.stream, '(];
PutName[p, IF nodeName = NIL OR nodeName = $LITERAL THEN "literal" ELSE Atom.GetPName[nodeName]];
IO.PutChar[p.stream, ' ];
PutAttributes[p, attributes];
IO.PutChar[p.stream, ' ];
WITH lit.value SELECT FROM
c: REF CHAR => IO.PutF1[p.stream, "#\\%g", IO.char[c­]];
i: REF INT => IO.Put1[p.stream, IO.int[i­]];
i: REF INTEGER => IO.Put1[p.stream, IO.int[i­]];
i: REF DINT => IO.Put1[p.stream, IO.dint[i­]];
i: REF CARDINAL => IO.Put1[p.stream, IO.card[i­]];
i: REF CARD => IO.Put1[p.stream, IO.card[i­]];
i: REF DCARD => IO.Put1[p.stream, IO.dcard[i­]];
a: REF ATOM => IO.PutF1[p.stream, "|%g|", IO.rope[Atom.GetPName[a­]]];
r: REF REAL => IO.PutRope[p.stream, lit.literal];
r: REF ROPE => IO.PutRope[p.stream, lit.literal];
ENDCASE => {Huh[lit]; IO.PutRope[p.stream, lit.literal]};
IO.PutChar[p.stream, ')];
};


PutAttributes: PROC [p: PutTreeOptions, attributes: Attributes] = {
RemoveProps: PROC [lora: LIST OF REF ANY] RETURNS [LIST OF REF ANY] = {
IF lora = NIL
THEN RETURN [NIL]
ELSE {
residual: LIST OF REF ANY = RemoveProps[lora.rest.rest];
FOR each: LIST OF ATOM ¬ p.skipAttributes, each.rest UNTIL each = NIL DO
IF lora.first = each.first THEN RETURN [residual];
ENDLOOP;
IF residual = lora.rest.rest THEN RETURN [lora];
RETURN [CONS[lora.first, CONS[lora.rest.first, residual]]]
};
};
IF p.structure THEN StructuredStreams.Begin[p.stream];
PutLORA[p, RemoveProps[attributes]]; -- for now
IF p.structure THEN StructuredStreams.End[p.stream];
};

PutLORA: PROC [p: PutTreeOptions, lora: LIST OF REF ANY] = {
n: INT ¬ 0;
IO.PutChar[p.stream, '(];
FOR each: LIST OF REF ANY ¬ lora, each.rest UNTIL each = NIL DO
IF n # 0 THEN { Bp[p] };
PutTreeInternal[p, each.first];
n ¬ n + 1;
ENDLOOP;
IO.PutChar[p.stream, ')];
};

PutName: PROC [p: PutTreeOptions, name: ROPE] = {
IF p.structure THEN IO.PutF1[p.stream, "%l", [rope["n"]]];
IO.PutChar[p.stream, ':]; -- make them commonlisp keywords
IO.PutRope[p.stream, name];
IF p.structure THEN IO.PutF1[p.stream, "%l", [rope["N"]]];
};

PutTreeInternal: PROC [p: PutTreeOptions, tree: Tree] = {
IF p.structure THEN StructuredStreams.Begin[p.stream];
WITH tree SELECT FROM
lora: LIST OF REF ANY => {
PutLORA[p, lora];
};
atom: ATOM => {
escape: BOOL = NOT AllUpperCase[Atom.GetPName[atom]];
IF escape THEN IO.PutChar[p.stream, '|];
IO.PutChar[p.stream, ':]; -- make them commonlisp keywords
IO.PutRope[p.stream, Atom.GetPName[atom]];
IF escape THEN IO.PutChar[p.stream, '|];
};
refINT: REF INT => {
IO.Put1[p.stream, IO.int[refINT­]];
};
refDINT: REF DINT => {
IO.Put1[p.stream, IO.dint[refDINT­]];
};
refCARD: REF CARD => {
IO.Put1[p.stream, IO.card[refCARD­]];
};
refDCARD: REF DCARD => {
IO.Put1[p.stream, IO.dcard[refDCARD­]];
};
rope: ROPE => {
PutRopeNode[p, rope, NIL];
};
aNode: AttributedNode => {
WITH aNode.syntaxNode SELECT FROM
node: REF MPTree.Node => {
PutTreeNode[p, node, aNode.syntaxNodeName, aNode.attributes];
};
ht: REF MPLeaves.HTNode => {
PutHTNode[p, ht, aNode.syntaxNodeName, aNode.attributes];
};
lit: REF MPLeaves.LTNode => {
PutLTNode[p, lit, aNode.syntaxNodeName, aNode.attributes];
};
rope: ROPE => {
IO.PutChar[p.stream, '(];
PutName[p, "id"];
Bp[p];
PutAttributes[p, aNode.attributes];
Bp[p];
IO.PutF1[p.stream, "\"%g\"", IO.rope[rope]];
IO.PutChar[p.stream, ')];
};
ENDCASE => Huh[aNode.syntaxNode];
};
node: REF MPTree.Node => {
PutTreeNode[p, node, NIL, DecodeAttr[node.name, node.attr]];
};
ht: REF MPLeaves.HTNode => {
PutHTNode[p, ht, NIL, SourceLocAttribute[ht.index]];
};
lit: REF MPLeaves.LTNode => {
PutLTNode[p, lit, NIL, SourceLocAttribute[lit.index]];
};
ENDCASE => {
IF tree = NIL
THEN IO.PutRope[p.stream, "NIL"]
ELSE IO.Put1[stream: p.stream, value: [refAny[tree]]];
};
IF p.structure THEN StructuredStreams.End[p.stream];
};

SourceLocAttribute: PROC [sourceLoc: INT] RETURNS [Attributes] = {
IF sourceLoc = INT.LAST THEN RETURN [NIL] ELSE RETURN [LIST[$AT, NEW[INT ¬ sourceLoc]]]
};

AddAttributeNodes: PUBLIC PROC [tree: Tree] RETURNS [Tree] = {
Wrap: PROC [t: Tree, name: ATOM, attributes: Attributes] RETURNS [Tree] = {
aNode: AttributedNode ¬ NEW[AttributedNodeRep ¬ [attributes: attributes, syntaxNodeName: name, syntaxNode: t]];
RETURN [aNode];
};
IF tree = NIL THEN RETURN [NIL];
WITH tree SELECT FROM
node: REF MPTree.Node => {
IF node.name = $optionTC
THEN {
check: [2..2] ~ node.sonLimit;
aNode: AttributedNode ~ NARROW[AddAttributeNodes[node.son[1]]];
name: ATOM ¬ NIL;
value: REF ¬ NIL;
intval: INT ¬ 0;
SELECT node.subInfo FROM
$packedOption => {name ¬ $PACKING; value ¬ $PACKED};
$msbitOption => {name ¬ $ENDIAN; value ¬ $MSBIT};
$lsbitOption => {name ¬ $ENDIAN; value ¬ $LSBIT};
$nativeOption => {name ¬ $ENDIAN; value ¬ $NATIVE};
$word8Option => {name ¬ $BITSPERWORD; intval ¬ 8};
$word16Option => {name ¬ $BITSPERWORD; intval ¬ 16};
$word32Option => {name ¬ $BITSPERWORD; intval ¬ 32};
$word64Option => {name ¬ $BITSPERWORD; intval ¬ 64};
ENDCASE;
IF name # NIL THEN {
IF value = NIL THEN value ¬ NEW[INT ¬ intval];
aNode.attributes ¬ CONS[name, CONS[value, aNode.attributes]];
};
RETURN [aNode]
}
ELSE {
attributes: Attributes = DecodeAttr[node.name, node.attr];
FOR i: NAT IN [1..node.sonLimit) DO
node.son[i] ¬ AddAttributeNodes[node.son[i]];
ENDLOOP;
RETURN [Wrap[node, AtomFromNodeName[node.name], attributes]];
};
};
rope: ROPE => RETURN [Wrap[tree, $ID, NIL]];
ht: REF MPLeaves.HTNode => RETURN [Wrap[tree, $ID, SourceLocAttribute[ht.index]]];
lit: REF MPLeaves.LTNode => RETURN [Wrap[tree, $LITERAL, SourceLocAttribute[lit.index]]];
ENDCASE => { Huh[tree] };
RETURN [Wrap[tree, $ID, NIL]]
};

WalkTree: PROC [tree: Tree] = {
WITH tree SELECT FROM
node: REF MPTree.Node => {
n: NAT = node.sonLimit-1; -- number of sons
True: TYPE = BOOL[TRUE..TRUE];
SELECT node.name FROM
module => {
check: True = (n=6);
directory: Tree = node.son[1];
imports: Tree = node.son[2];
exports: Tree = node.son[3];
shares: Tree = node.son[4];
locks: Tree = node.son[5];
decl: Tree = node.son[6];
};
diritem => {
check: True = (n=3);
directoryItem: Tree = node.son[1];
from: Tree = node.son[2];
usingList: Tree = node.son[3];
};
lambda => {
check: True = (n=2);
decl: Tree = node.son[1];
body: Tree = node.son[2];
};
decl => {
check: True = (n=3);
identifier: Tree = node.son[1];
type: Tree = node.son[2];
value: Tree = node.son[3];
};
open => {
check: True = (n=2);
items: Tree = node.son[1]; -- an item with two (name, value) components, or list of same
scope: Tree = node.son[2];
};
definitionTC => {
check: True = (n=0);

};
programTC => {
check: True = (n=2);
arguments: Tree = node.son[1];
returns: Tree = node.son[2];
};
monitoredTC => {
check: True = (n=1);
fieldList: Tree = node.son[1];
};
recordTC => {
check: True = (n=1);
fieldList: Tree = node.son[1]; -- often a list of decls
};
unionTC => {
check: True = (n=2);
commonPart: Tree = node.son[1]; -- at least the tag field
variants: Tree = node.son[2]; -- a list of typedecl nodes, with variantTC nodes for the types
};
implicitTC => {
check: True = (n=0);
};
variantTC => {
check: True = (n=1);
fieldList: Tree = node.son[1];
};
sequenceTC => {
check: True = (n=2);
domainLimit: Tree = node.son[1]; -- a decl
rangeType: Tree = node.son[2]; -- a type
};
longTC, refTC, pointerTC => {
check: True = (n=1);
applyTo: Tree = node.son[1];
};
procTC, processTC => {
check: True = (n=2);
arguments: Tree = node.son[1];
returns: Tree = node.son[2];
};
errorTC, signalTC => {
check: True = (n=2);
arguments: Tree = node.son[1];
returns: Tree = node.son[2];
};
enumeratedTC => {
check: True = (n=1);
list: Tree = node.son[1];
};
listTC => {
check: True = (n=1);
elementType: Tree = node.son[1];
};
linkTC => {
check: True = (n=0);
};
anyTC => {
check: True = (n=0);
};
zoneTC => {
check: True = (n=0);
};
opaqueTC => {
check: True = (n=1);
x: Tree = node.son[1]; -- This is probably the size, if supplied

};
arrayTC => {
check: True = (n=2);
domainType: Tree = node.son[1];
rangeType: Tree = node.son[2];
};
subrangeTC => {
check: True = (n=2);
baseType: Tree = node.son[1];
range: Tree = node.son[2]; -- should be an interval
};
intCC, intCO, intOC, intOO => {
check: True = (n=2);
lower: Tree = node.son[1];
includeLower: BOOL = node.name=intCC OR node.name=intCO;
upper: Tree = node.son[2];
includeUpper: BOOL = node.name=intCC OR node.name=intOC;
};
inline => {
check: True = (n=1);
code: Tree = node.son[1]; -- a list of byte constants
};
body => {
check: True = (n=4);
open: Tree = node.son[1];
declarations: Tree = node.son[2];
bodyContents: Tree = node.son[3];
exits: Tree = node.son[4];
};
block => {
check: True = (n=2);
declarations: Tree = node.son[1];
bodyContents: Tree = node.son[2];
};
entry, internal => {
check: True = (n=1);
body: Tree = node.son[1];
};
enable => {
check: True = (n=2);
catch: Tree = node.son[1];
block: Tree = node.son[2];
};
label => {
check: True = (n=2);
block: Tree = node.son[1];
labelledClauses: Tree = node.son[2]; -- a two-element item (or list of same?)
};
goto => {
check: True = (n=1);
target: Tree = node.son[1]; -- an identifier
};
typedecl => {
check: True = (n=3);
identifier: Tree = node.son[1];
type: Tree = node.son[2];
initialValue: Tree = node.son[3];
};
dot => {
check: True = (n=2);
outer: Tree = node.son[1];
inner: Tree = node.son[2];
};
apply => {
nSons: [2..3] = n;
operator: Tree = node.son[1];
operand: Tree = node.son[2];
catch: Tree = IF n = 3 THEN node.son[3] ELSE NIL;
};
catch => {
check: True = (n=2);
items: Tree = node.son[1];
xx: Tree = node.son[2];
};
continue => {
check: True = (n=0);
};
return, resume => {
check: True = (n=1);
returnValue: Tree = node.son[1];
};
uparrow => {
check: True = (n=1);
pointer: Tree = node.son[1];
};
do => {
check: True = (n=6);
loopControl: Tree = node.son[1];
whileTest: Tree = node.son[2];
xxx: Tree = node.son[3]; -- probably decls
bodyContents: Tree = node.son[4];
xxxxx: Tree = node.son[5]; -- probably funny stuff I don't use
repeatFinished: Tree = node.son[6];
IF xxx#NIL OR xxxxx#NIL THEN Huh[node];
};
upthru, downthru => {
check: True = (n=3);
loopVariable: Tree = node.son[1]; -- may be a decl
range: Tree = node.son[2];
xxx: Tree = node.son[3];
IF xxx#NIL THEN Huh[node];
};
forseq => {
check: True = (n=3);
loopVariable: Tree = node.son[1]; -- may be a decl
initialValue: Tree = node.son[2];
nextValue: Tree = node.son[3];
};
loop, exit => {
check: True = (n=0);
};
fork, wait, broadcast, notify => {
check: True = (n=1);
what: Tree = node.son[1];
};
free => {
check: True = (n=3);
zone: Tree = node.son[1];
pointer: Tree = node.son[2];
whatsit: Tree = node.son[3];
};
if, ifx => {
check: True = (n=3);
test: Tree = node.son[1];
truePart: Tree = node.son[2];
falsePart: Tree = node.son[3];
};
bind, bindx => {
check: True = (n=4);
expression: Tree = node.son[1];
xx: Tree = node.son[2];
items: Tree = node.son[3];
endcase: Tree = node.son[4];
};
case, casex => {
check: True = (n=3);
expression: Tree = node.son[1];
items: Tree = node.son[2];
endcase: Tree = node.son[3];
};
xerror => {
check: True = (n=1); -- What if the error has arguments?
error: Tree = node.son[1];
};
signal, error, errorx => {
check: True = (n=1);
operand: Tree = node.son[1];
};
syserror, syserrorx => {
check: True = (n=0);
};
assign, assignx => {
check: True = (n=2);
dest: Tree = node.son[1];
source: Tree = node.son[2];
};
extract => {
check: True = (n=2);
extractFields: Tree = node.son[1];
expression: Tree = node.son[2];
};
null => {
check: True = (n=0);
};
or, and, relE, relN, relL, relGE, relG, relLE, in, notin, plus, minus, times, div, mod, power => {
check: True = (n=2);
operand1: Tree = node.son[1];
operand2: Tree = node.son[2];
};
listcons, cons => {
check: True = (n=2);
operand1: Tree = node.son[1]; -- this is NIL in cases seen. Whatsit?
operand2: Tree = node.son[2]; -- list of arguments
};
new => {
check: True = (n=3);
x: Tree = node.son[1]; -- who knows?
type: Tree = node.son[2];
initialValue: Tree = node.son[3];
};
mwconst, atom, nil, cast, clit, float, pad, lengthen => {
check: True = (n=1);
operand: Tree = node.son[1];
};
not, uminus, addr, abs, all, pred, succ => {
check: True = (n=1);
operand: Tree = node.son[1];
};
min, max => {
check: True = (n=1);
operands: Tree = node.son[1];
};
first, last => {
check: True = (n=1);
operand: Tree = node.son[1];
};
size => {
check: True = (n=2);
type: Tree = node.son[1];
packing: Tree = node.son[2];
};
narrow, loophole => {
check: True = (n=2);
operand: Tree = node.son[1];
type: Tree = node.son[2]; -- The result type - NIL means derive from context
};
signalinit => {
check: True = (n=0);
};
list, item => {
};
ENDCASE => {SIGNAL Huh[node]};
FOR i: NAT IN [1..node.sonLimit) DO
WalkTree[node.son[i]];
ENDLOOP;
};
ht: REF MPLeaves.HTNode => NULL;
lit: REF MPLeaves.LTNode => NULL;
rope: ROPE => NULL;
aNode: AttributedNode => { WalkTree[aNode.syntaxNode] };
ENDCASE => IF tree#NIL THEN SIGNAL Huh[tree];
};

CrankErrorTreeCommand: Commander.CommandProc ~ {
PutTree[cmd.out, CommanderOps.GetProp[cmd, $CrankErrorTree]];
IO.PutRope[cmd.out, "\n"];
};

Commander.Register["CrankErrorTree", CrankErrorTreeCommand, "Dump CrankErrorTree property"];

END.


CrankIOImpl.mesa
Copyright Σ 1987, 1989, 1990, 1991 by Xerox Corporation.  All rights reserved.
Michael Plass, December 3, 1991 11:29 am PST

writer: TiogaAccess.Writer = TiogaAccess.Create[];
TiogaAccess.WriteFile[writer: writer, fileName: fileName];
IO.PutChar[p.stream, '(];
PutName[p, "id"];
Bp[p];
PutAttributes[p, attributes];
Bp[p];
IO.PutF[p.stream, "\"%g\")", IO.rope[rope]];
This will not come from InterpreterOps
This will not come from InterpreterOps
This will not come from InterpreterOps
This will not come from InterpreterOps
This will not come from InterpreterOps
This will not come from InterpreterOps
Push the attribute down and remove this node.
This doesn't actually do anything (except perhaps raise a signal).  It serves mostly as documentation as to what may be in a tree.  It is not necessarily complete.
node.attr means something here.
node.attr means something here.
node.attr means something here.
node.attr means something here.
node.attr means something here.
This is for variant records
For implicit tag fields (the * in RECORD[SELECT tag: * FROM...)
node.attr means something here.
The variant parts of a unionTC
A SEQUENCE field of the record
node.attr means something here.
node.attr means something here.
node.attr means something here.
This is used to mark the rest field of a list
For REF ANY, etc.
node.attr means something here.
An interval. In the names, C=Closed, O=Open
This actually means MACHINE CODE
node.attr means something here.
node.attr means something here.
node.attr means something here.
wrapped around the body of the procedure
wrapped around a block protected with ENABLE
wrapped around a block protected with EXITS clause
must be in the scope of a label
node.attr means something here.
Could be:
field selector
object notation
qualified name
adjective for variant records
Could be:
function application
array indexing
adjective for variant records
array or record constructor or extractor
return is from a procedure body, resume is from a catch phrase
dereferencing (may be implied in many contexts)
Appears as first son of do
Appears as first son of do
Appear in the body of do; loop jumps to the top of the loop, exit jumps out.
if is a statement, ifx an expression
WITH foo SELECT FROM a:A => x; a:B => x ENDCASE...
bindx is for expressions
SELECT foo FROM r1 => x; r2 => x ENDCASE...
casex is for expressions
Comes from RETURN WITH ERROR
unnamed error
assign is a statement, assignx an expression
An extractor
empty statement
Binary ops
Type coersions.  mwconst=multi-word constant, clit = character literal
Unary ops
N-ary ops
Unary ops on types
SIZE builtin
loophole may sometimes be a challenge to translate
Used for general grouping
Κp•NewlineDelimiter

–
(cedarcode) style™
code™Kšœ
Οe
œC™NK™,K™—šΟk	œMžœžœV˜²
K˜—KšΠlnœž
˜Kšžœ8žœžœC˜ˆ
Kšžœ˜šœžœ
žœ˜K˜K˜šžœžœžœ
˜K˜—šΟnœžœ
žœžœ
˜'K˜—š œžœžœ
žœ
žœžœ
žœ˜HKšžœ)˜/K˜K˜—š œžœ
žœ
žœžœžœžœ˜KKšœžœ˜Kšœžœ˜+KšžœL˜RK˜K˜—š
 	œžœ
žœžœžœ˜=Kšœžœ
žœžœ ˜:Kšžœ˜K˜K˜—š
 œžœžœžœžœ˜7K•StartOfExpansionΚ[fileName: 
ROPE, accessOptions: 
FS.AccessOptions _ read, streamOptions: 
FS.StreamOptions _ (3)[TRUE, TRUE, TRUE], keep: 
CARDINAL _ 1B (1), createByteCount: 
FS.ByteCount _ 2560, streamBufferParms: 
FS.StreamBufferParms _ [vmPagesPerBuffer: 
8, nBuffers: 
2], extendFileProc: 
FS.ExtendFileProc, wantedCreatedTime: 
GMT _ nullGMT, remoteCheck: 
BOOL _ TRUE, wDir: 
ROPE _ NIL, checkFileType: 
BOOL _ FALSE, fileType: 
FS.FileType _ [0B (0)]]šœžœ
žœžœ1˜CKšœžœ
˜Kšžœ˜
K˜K˜—š
 	œžœ
žœžœžœ˜AKšœžœ
žœžœ ˜:K˜;Kšžœ
˜K˜K˜—š
 œžœ
žœžœžœ˜9Kš	œžœ
žœžœ
žœ˜K˜Kšžœžœ˜K˜K˜—š 	œžœ
žœžœžœžœ
žœ
žœžœ
žœ˜
Kšœžœ
žœžœ˜5K–[self: 
STREAM]šœžœ	žœ'˜@Kšœžœ&˜AK–'[self: 
STREAM, abort: 
BOOL _ FALSE]šžœ˜K˜K˜—š 
œžœ
žœžœFžœžœžœ
žœ
žœžœžœ
žœ˜Ζ
šžœ0˜2šžœ˜K™2Kšœžœ
žœžœ˜5Kš
œ\˜\Kšœžœ
žœ-˜>Kšœžœ.˜HK–'[self: 
STREAM, abort: 
BOOL _ FALSE]š
œ'˜'K–0[writer: 
TiogaAccess.Writer, fileName: 
ROPE]™:K–n[name: 
ROPE, wantedCreatedTime: 
GMT _ OPAQUE#17777777777B, remoteCheck: 
BOOL _ TRUE, wDir: 
ROPE _ NIL]šœžœ$˜2Kš
œ
˜
—šžœ˜Kšžœ7˜=Kš
œ˜——K˜K˜—šœžœžœ
žœ’˜ΊK˜—š
 œžœ
žœžœžœ˜LKšžœ˜K˜K˜—Kš
 œžœžœžœžœ˜GKšœžœžœ
žœžœ
žœ˜8š
 œžœ
žœžœžœ˜Lšžœžœ
žœ˜'K˜mK˜—Kšžœ˜ K˜K˜—š
 œžœžœžœžœ˜2Kšœžœžœžœžœ
žœžœ
žœžœ
˜\K–T[base: 
ROPE, start: 
INT _ 0, len: 
INT _ 2147483647, action: 
Rope.ActionType]šžœžœ$˜/K˜K˜—š 
œžœ
žœ#žœ
žœžœ
žœžœ˜vKš	œžœ
žœžœ
žœ˜4Kšœžœ
žœ
žœ
žœžœ
˜š œžœ#žœ˜7Kš
žœžœ
žœžœžœ˜XK˜—š œžœ˜š œžœžœ˜Kšœžœžœ˜&Kšœžœ
˜K˜—šžœ
žœžœ
ž˜'K˜K˜K˜Kšžœžœ
˜—K˜—Kšžœžœ
žœžœ
žœžœ˜'šžœž˜K˜&˜	šžœž˜Kšœ
žœžœžœžœ
žœ˜5Kšœ
žœžœžœžœ
žœ˜5Kšœ
žœžœžœžœ
žœ˜<Kšœ
žœžœžœžœ
žœ˜4Kšžœžœ
˜—K˜—K˜ K˜*K˜6K˜˜Kš
žœ
žœ	žœ
žœžœ˜$Kšœ
žœ
˜K˜K˜—K˜0K˜JK˜=K˜-K˜!Kšžœžœ
˜—K˜K˜K˜Kšžœ˜K˜K˜—š œžœ˜ Kšžœ˜Kšžœ
žœ5˜HK˜K˜—Kšœžœžœ˜-Kšœžœžœ
žœ
žœ
žœžœCžœžœ
žœ
žœžœ˜Ό
š œžœ
žœ
žœ
žœžœžœFžœžœžœ
žœ
žœžœ˜Ε
šžœžœ
žœ˜Kšžœžœ!˜2Kšžœk˜mKšžœžœ˜0Kšžœžœ1˜BK˜—KšœžœT˜gK˜K˜—š œžœžœžœ˜hšžœ˜Kšœžœžœ
žœ(žœžœ˜†
K˜K˜šžœžœ
žœž˜#Kšžœ˜K˜K˜ Kšžœ
˜—Kšžœ˜—K˜K˜—š 	œžœžœžœ˜hšžœ˜K–0[stream: 
STREAM, value: 
IO.Value _ [null[]]]šœžœžœ
žœžœžœ˜WK˜K˜K˜Kšžœžœ˜/Kšžœ˜—šžœžœžœ˜.šžœžœ
ž˜.šœžœ
žœ˜Kšžœ˜Kšžœžœ	žœ
žœ˜2K˜—Kšžœžœ
˜—K˜—K˜K˜—š œžœžœ˜MKšžœžœ
˜,šžœ™K–0[stream: 
STREAM, value: 
IO.Value _ [null[]]]™K™K™K™Kšžœžœ
™,—K˜K˜—š 	œžœžœžœ˜išžœ˜K–0[stream: 
STREAM, value: 
IO.Value _ [null[]]]šœžœžœ
žœžœžœ˜aKšžœ˜K˜Kšžœ˜šžœžœ
ž˜Kš	œžœ
žœžœžœ˜8Kš	œžœ
žœžœžœ
˜,Kš	œžœ
žœžœžœ
˜0Kš	œžœ
žœžœžœ˜.Kš	œžœ
žœžœžœ˜2Kš	œžœ
žœžœžœ˜.Kš	œžœ
žœžœžœ˜0Kš	œžœ
žœžœžœ˜FKšœžœ
žœžœ ˜1Kšœžœ
žœžœ ˜1Kšžœžœ!˜9—Kšžœ˜—K˜K˜K˜—š 
œžœ0˜Cš œžœžœ
žœ
žœ
žœžœžœ
žœ
žœ
žœ˜Gšžœž˜
Kšžœ
žœžœ
˜šžœ˜Kš	œ
žœ
žœ
žœ
žœ˜8š
žœžœ
žœ
žœžœžœ
ž˜HKšžœžœ
žœ˜2Kšžœ
˜—Kšžœžœ
žœ˜0Kšžœžœ
žœ˜:K˜——K˜—Kšžœ
žœ#˜6Kšœ%Οc
˜/Kšžœ
žœ!˜4K˜K˜—š œžœžœ
žœ
žœ
žœ˜<Kšœžœ˜Kšžœ˜–0[stream: 
STREAM, value: 
IO.Value _ [null[]]]šžœžœ
žœ
žœ
žœžœžœ
ž˜?Kšžœžœ˜K˜K˜
Kšžœ
˜—Kšžœ˜K˜K˜—š œžœžœ˜1K–0[stream: 
STREAM, value: 
IO.Value _ [null[]]]šžœ
žœ
žœ$˜:Kšžœ‘ ˜:Kšžœ˜Kšžœ
žœ
žœ$˜:K˜K˜—š œžœ$˜9Kšžœ
žœ#˜6šžœžœ
ž˜š	œžœ
žœ
žœ
žœ˜K™&K˜K˜—šœžœ˜K™&Kšœžœžœ#˜5Kšžœžœ
žœ˜(Kšžœ‘ ˜:Kšžœ(˜*Kšžœžœ
žœ˜(K˜—šœžœ˜K™&Kšžœžœ˜#K˜—šœ	žœ˜K™&Kšžœžœ˜%K˜—šœ	žœ˜K™&Kšžœžœ˜%K˜—šœ
ž	œ˜K™&Kšžœžœ˜'K˜—šœžœ˜Kšœžœ˜K˜—˜šžœžœ
ž˜!šœžœ˜K˜=K˜—šœžœ˜K˜9K˜—–0[stream: 
STREAM, value: 
IO.Value _ [null[]]]šœžœ˜K˜:K˜—šœžœ˜Kšžœ˜K–0[stream: 
STREAM, value: 
IO.Value _ [null[]]]˜K˜K˜#K˜Kšžœžœ
˜,Kšžœ˜K˜—Kšžœ˜!—K˜—šœžœ˜Kšœžœ$˜<K˜—–0[stream: 
STREAM, value: 
IO.Value _ [null[]]]šœžœ˜Kšœžœ ˜4K˜—–0[stream: 
STREAM, value: 
IO.Value _ [null[]]]šœžœ˜Kšœžœ!˜6K˜—šžœ˜šžœž˜
Kšžœ
žœ˜ Kšžœ
žœ/˜6—Kš
œ˜——Kšžœ
žœ!˜4K˜K˜—š œžœ
žœžœ˜BKšžœ
žœ
žœ
žœ
žœžœžœ
žœžœžœ
žœ˜WK˜K˜—š œžœ
žœžœ˜>š œžœžœžœ˜KKšœžœT˜oKšžœ	˜K˜—Kš
žœžœ
žœ
žœžœ˜ šžœžœ
ž˜šœžœ˜šžœ˜šžœ˜K™-Kš
œ˜Kšœžœ!˜?Kšœžœžœ
˜Kšœžœžœ
˜Kšœžœ˜šžœž˜Kš
œ4˜4Kš
œ1˜1Kš
œ1˜1Kš
œ3˜3Kš
œ2˜2Kš
œ4˜4Kš
œ4˜4Kš
œ4˜4Kšžœ
˜—šžœžœ
žœ˜Kš
žœ	žœ
žœ	žœ
žœ˜.Kšœžœžœ˜=Kš
œ˜—Kšžœ˜Kš
œ
˜
—šžœ˜K˜:šžœžœ
žœž˜#K˜-Kšžœ
˜—Kšžœ7˜=Kš
œ˜——K˜—Kšœžœžœžœ˜,K–0[stream: 
STREAM, value: 
IO.Value _ [null[]]]šœžœžœ1˜RK–0[stream: 
STREAM, value: 
IO.Value _ [null[]]]šœžœžœ7˜YKšžœ˜—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˜K˜—˜	K˜Kšœ‘=˜XK˜K˜—˜K™K˜K˜K˜—˜K™K˜K˜K˜K˜—˜K™K˜K˜K˜—˜
K™K˜Kšœ‘˜7K˜—˜K™K˜Kšœ ‘˜9Kšœ‘?˜]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™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šœ‘˜3K˜—˜K™+K˜K˜Kšœžœžœ˜8K˜Kšœžœžœ˜8K˜—˜K™ K™K˜Kšœ‘˜5K˜—˜	K™K˜K˜K˜!K˜!K˜K˜—˜
K™K˜K˜!K˜!K˜—˜K™(K˜K˜K˜—˜K™,K˜K˜K˜K˜—˜
Kšœ&žœ™2K˜K˜Kšœ%‘(˜MK˜—˜	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š	œžœžœ
žœ
žœ
˜1K˜—˜
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šœ"‘˜2K˜K˜Kšžœžœ
žœ˜K˜—˜K™K˜Kšœ"‘˜2K˜!K˜K˜—˜K™LK˜K˜—˜"K˜K˜K˜—˜	K˜K˜K˜K˜K˜—˜K™$K˜K˜K˜K˜K˜—˜K™2K™K˜K˜K˜K˜K˜K˜—˜K™+K™K˜K˜K˜K˜K˜—˜Kšœžœ
žœ
ž™Kšœ‘#˜8K˜K˜—˜K˜K˜K˜—˜K™
K˜K˜—˜K™,K˜K˜K˜K˜—˜K™K˜K˜"K˜K˜—˜	K™K˜K˜—˜bK™
K˜K˜K˜K˜—˜K˜Kšœ‘&˜DKšœ‘˜2K˜—˜K˜Kšœ‘
˜$K˜K˜!K˜—˜9K™FK˜K˜K˜—˜,K™	K˜K˜K˜—˜
K™	K˜K˜K˜—˜K™K˜K˜K˜—˜	K™K˜K˜K˜K˜—˜K™2K˜K˜Kšœ‘2˜LK˜—˜K˜K˜—˜K™K˜—Kšžœžœ˜—šžœžœ
žœž˜#K˜Kšžœ
˜—K˜—K–0[stream: 
STREAM, value: 
IO.Value _ [null[]]]šœžœžœ
˜ K–0[stream: 
STREAM, value: 
IO.Value _ [null[]]]šœžœžœ
˜!Kšœžœžœ
˜K˜8Kš
žœžœžœ
žœ
žœ˜-—K˜K˜—š œ˜0K˜=Kšžœ˜K˜K˜—K˜\—K˜Kšžœ
˜—…—\$„$