~
BEGIN
OPEN CrankTypes;
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: TiogaAccess.Writer = TiogaAccess.Create[];
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];
TiogaAccess.WriteFile[writer: writer, fileName: fileName];
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]];
IO.PutChar[p.stream, '(];
PutName[p, "id"];
Bp[p];
PutAttributes[p, attributes];
Bp[p];
IO.PutF[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 => {
This will not come from InterpreterOps
PutLORA[p, lora];
};
atom:
ATOM => {
This will not come from InterpreterOps
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 => {
This will not come from InterpreterOps
IO.Put1[p.stream, IO.int[refINT]];
};
refDINT:
REF DINT => {
This will not come from InterpreterOps
IO.Put1[p.stream, IO.dint[refDINT]];
};
refCARD:
REF CARD => {
This will not come from InterpreterOps
IO.Put1[p.stream, IO.card[refCARD]];
};
refDCARD:
REF DCARD => {
This will not come from InterpreterOps
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 {
Push the attribute down and remove this node.
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] = {
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.
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 => {
node.attr means something here.
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 => {
node.attr means something here.
check: True = (n=0);
};
programTC => {
node.attr means something here.
check: True = (n=2);
arguments: Tree = node.son[1];
returns: Tree = node.son[2];
};
monitoredTC => {
node.attr means something here.
check: True = (n=1);
fieldList: Tree = node.son[1];
};
recordTC => {
node.attr means something here.
check: True = (n=1);
fieldList: Tree = node.son[1]; -- often a list of decls
};
unionTC => {
This is for variant records
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 => {
For implicit tag fields (the * in RECORD[SELECT tag: * FROM...)
check: True = (n=0);
};
variantTC => {
node.attr means something here.
The variant parts of a unionTC
check: True = (n=1);
fieldList: Tree = node.son[1];
};
sequenceTC => {
A SEQUENCE field of the record
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 => {
node.attr means something here.
check: True = (n=2);
arguments: Tree = node.son[1];
returns: Tree = node.son[2];
};
errorTC, signalTC => {
node.attr means something here.
check: True = (n=2);
arguments: Tree = node.son[1];
returns: Tree = node.son[2];
};
enumeratedTC => {
node.attr means something here.
check: True = (n=1);
list: Tree = node.son[1];
};
listTC => {
check: True = (n=1);
elementType: Tree = node.son[1];
};
linkTC => {
This is used to mark the rest field of a list
check: True = (n=0);
};
anyTC => {
For REF ANY, etc.
check: True = (n=0);
};
zoneTC => {
node.attr means something here.
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 => {
An interval. In the names, C=Closed, O=Open
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 => {
This actually means MACHINE CODE
node.attr means something here.
check: True = (n=1);
code: Tree = node.son[1]; -- a list of byte constants
};
body => {
node.attr means something here.
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 => {
node.attr means something here.
check: True = (n=2);
declarations: Tree = node.son[1];
bodyContents: Tree = node.son[2];
};
entry, internal => {
wrapped around the body of the procedure
check: True = (n=1);
body: Tree = node.son[1];
};
enable => {
wrapped around a block protected with ENABLE
check: True = (n=2);
catch: Tree = node.son[1];
block: Tree = node.son[2];
};
label => {
wrapped around a block protected with EXITS clause
check: True = (n=2);
block: Tree = node.son[1];
labelledClauses: Tree = node.son[2]; -- a two-element item (or list of same?)
};
goto => {
must be in the scope of a label
check: True = (n=1);
target: Tree = node.son[1]; -- an identifier
};
typedecl => {
node.attr means something here.
check: True = (n=3);
identifier: Tree = node.son[1];
type: Tree = node.son[2];
initialValue: Tree = node.son[3];
};
dot => {
Could be:
field selector
object notation
qualified name
adjective for variant records
check: True = (n=2);
outer: Tree = node.son[1];
inner: Tree = node.son[2];
};
apply => {
Could be:
function application
array indexing
adjective for variant records
array or record constructor or extractor
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 => {
return is from a procedure body, resume is from a catch phrase
check: True = (n=1);
returnValue: Tree = node.son[1];
};
uparrow => {
dereferencing (may be implied in many contexts)
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 => {
Appears as first son of do
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 => {
Appears as first son of do
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 => {
Appear in the body of do; loop jumps to the top of the loop, exit jumps out.
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 => {
if is a statement, ifx an expression
check: True = (n=3);
test: Tree = node.son[1];
truePart: Tree = node.son[2];
falsePart: Tree = node.son[3];
};
bind, bindx => {
WITH foo SELECT FROM a:A => x; a:B => x ENDCASE...
bindx is for expressions
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 => {
SELECT foo FROM r1 => x; r2 => x ENDCASE...
casex is for expressions
check: True = (n=3);
expression: Tree = node.son[1];
items: Tree = node.son[2];
endcase: Tree = node.son[3];
};
xerror => {
Comes from RETURN WITH ERROR
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 => {
unnamed error
check: True = (n=0);
};
assign, assignx => {
assign is a statement, assignx an expression
check: True = (n=2);
dest: Tree = node.son[1];
source: Tree = node.son[2];
};
extract => {
An extractor
check: True = (n=2);
extractFields: Tree = node.son[1];
expression: Tree = node.son[2];
};
null => {
empty statement
check: True = (n=0);
};
or, and, relE, relN, relL, relGE, relG, relLE, in, notin, plus, minus, times, div, mod, power => {
Binary ops
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 => {
Type coersions. mwconst=multi-word constant, clit = character literal
check: True = (n=1);
operand: Tree = node.son[1];
};
not, uminus, addr, abs, all, pred, succ => {
Unary ops
check: True = (n=1);
operand: Tree = node.son[1];
};
min, max => {
N-ary ops
check: True = (n=1);
operands: Tree = node.son[1];
};
first, last => {
Unary ops on types
check: True = (n=1);
operand: Tree = node.son[1];
};
size => {
SIZE builtin
check: True = (n=2);
type: Tree = node.son[1];
packing: Tree = node.son[2];
};
narrow, loophole => {
loophole may sometimes be a challenge to translate
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 => {
Used for general grouping
};
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"];