SELECT kind
FROM
$var => {
flags: VariableFlags ¬ ScanVariableFlags[st];
id: VariableId ¬ ParseVarId[pc];
loc: Location ¬ ParseLocation[pc];
useCache: BOOL ¬ FALSE;
IF bits < 0 THEN bits ¬ defaultBits;
IF id # nullVariableId
AND (loc =
NIL
OR loc.kind = localVar)
THEN {
This variable is a candidate for cacheing
prev: Var ¬ IF id = nullVariableId THEN NIL
ELSE NARROW[IntCodeUtils.Fetch[pc.idTab, id]];
IF prev #
NIL
AND prev.location #
NIL
THEN {
IF loc = NIL THEN {node ¬ prev; GO TO oldVar};
NoteStrange[];
This is a conflicting location for a local variable!
};
IF prev #
NIL
THEN {
We just found the location!
prev.location ¬ loc;
node ¬ prev;
GO TO oldVar;
};
useCache ¬ TRUE;
};
node ¬ z.NEW[NodeRep.var ¬ [bits, var[flags, id, loc]]];
IF useCache THEN [] ¬ IntCodeUtils.Store[pc.idTab, id, node];
EXITS oldVar => {};
};
$const => {
constKind: ATOM ¬ ScanKind[st];
SELECT constKind
FROM
$word => {
IF bits < 0 THEN bits ¬ defaultBits;
node ¬ z.NEW[NodeRep.const.word
¬ [bits, const[word[ScanWord[st]]]]];
};
$bytes => {
align: Align ¬ ScanInt[st];
byteSeq: ByteSequence ¬ ParseBytes[pc];
IF bits < 0 THEN node.bits ¬ 8*Rope.Length[byteSeq];
node ¬ z.NEW[NodeRep.const.bytes
¬ [bits, const[bytes[align, byteSeq]]]];
};
$refLiteral => {
const: REF NodeRep.const.refLiteral ¬ z.NEW[NodeRep.const.refLiteral
¬ [bitsPerRef, const[refLiteral[rope, NIL]]]];
refLitKind: ATOM ¬ ScanKind[st];
const.litKind ¬
SELECT refLitKind
FROM
$rope => rope, $atom => atom, $refText => refText, $other => other,
ENDCASE => ERROR SyntaxError["illegal refLitKind"];
const.contents ¬ ParseBytes[pc];
node ¬ const;
};
$numLiteral => {
class: ArithClass ¬ ScanArithClass[st];
contents: ROPE ¬ ParseBytes[pc];
IF bits < 0 THEN bits ¬ defaultBits;
node ¬ z.NEW[NodeRep.const.numLiteral
¬ [bits, const[numLiteral[class, contents]]]];
};
ENDCASE => ERROR SyntaxError["illegal constant kind"];
};
$block => {
nodes: NodeList ¬ ParseNodeList[pc, '}];
IF bits < 0 THEN bits ¬ 0;
node ¬ z.NEW[NodeRep.block ¬ [bits, block[nodes]]];
};
$enable => {
handlerContext: Node ¬ ParseNode[pc];
handlerProc: Node ¬ ParseNode[pc];
handler: Handler ¬ z.NEW[HandlerRep
¬ [context: handlerContext, proc: handlerProc]];
nodes: NodeList ¬ ParseNodeList[pc, '}];
IF bits < 0 THEN bits ¬ 0;
node ¬ z.NEW[NodeRep.enable ¬ [bits, enable[handler, nodes]]];
};
$decl => {
var: Var ¬ ParseVar[pc];
init: Node ¬ ParseNode[pc];
node ¬ z.NEW[NodeRep.decl ¬ [0, decl[var: var, init: init]]];
};
$assign => {
lhs: Var ¬ ParseVar[pc];
rhs: Node ¬ ParseNode[pc];
IF bits < 0 THEN bits ¬ 0;
node ¬ z.NEW[NodeRep.assign ¬ [bits, assign[lhs: lhs, rhs: rhs]]];
};
$cond => {
caseHead: CaseList ¬ NIL;
caseTail: CaseList ¬ NIL;
WHILE PeekChar[st] # '}
DO
IF Insist[st, '(]
THEN {
key: ATOM ¬ ScanKind[st];
IF key = $test
THEN {
tests: NodeList ¬ ParseNodeList[pc, ')];
body: Node ¬ IF Insist[st, ')] THEN ParseNode[pc] ELSE NIL;
new: CaseList ¬ z.NEW[CaseListRep ¬ [tests, body, NIL]];
IF caseTail = NIL THEN caseHead ¬ new ELSE caseTail.rest ¬ new;
caseTail ¬ new;
}
ELSE ERROR SyntaxError["'test' expected"];
};
ENDLOOP;
IF bits < 0 THEN bits ¬ 0;
node ¬ z.NEW[NodeRep.cond ¬ [bits, cond[caseHead]]];
};
$label => {
label: Label ¬ ParseLabel[pc];
labNode: Node ¬ IF PeekChar[st] = '} THEN NIL ELSE ParseNode[pc];
IF bits < 0 THEN bits ¬ 0;
IF labNode # NIL THEN label.node ¬ labNode;
node ¬ z.NEW[NodeRep.label ¬ [bits, label[label]]];
};
$goto => {
dest: Label ¬ ParseLabel[pc, FALSE, TRUE];
backwards: BOOL ¬ ScanFlag[st];
IF backwards THEN dest.backTarget ¬ TRUE;
dest.jumpedTo ¬ TRUE;
node ¬ z.NEW[NodeRep.goto ¬
[0, goto[dest: dest, backwards: backwards]]];
};
$apply => {
proc: Node ¬ ParseNode[pc];
args: NodeList ¬ ParseNodeList[pc, '}, '!];
handler: Handler ¬ NIL;
IF Accept[st, '!]
THEN {
handler ¬ z.NEW[HandlerRep];
handler.context ¬ ParseNode[pc];
handler.proc ¬ ParseNode[pc];
};
IF bits < 0 THEN bits ¬ defaultBits;
node ¬ z.NEW[NodeRep.apply ¬
[bits, apply[proc: proc, args: args, handler: handler]]];
};
$lambda => {
parent: Label ¬ ParseLabel[pc, TRUE, TRUE];
descBody: Var ¬ IF PeekChar[st] = '{ THEN ParseVar[pc] ELSE NIL;
kind: LambdaKind =
SELECT ScanKind[st]
FROM
$outer => outer,
$inner => inner,
$install => install,
$init => init,
$catch => catch,
$scope => scope,
$fork => fork,
ENDCASE => unknown;
bitsOut: INT ¬ ScanInt[st];
formalArgs: VarList ¬ ParseVarList[pc];
body: NodeList ¬ ParseNodeList[pc, '}];
node ¬ z.NEW[NodeRep.lambda ¬ [defaultBits, lambda[
parent: parent, kind: kind, descBody: descBody,
bitsOut: bitsOut, formalArgs: formalArgs, body: body]]];
};
$return =>
node ¬ z.NEW[NodeRep.return ¬
[0, return[ParseNodeList[pc, '}] ]]];
$oper => {
IF bits < 0 THEN bits ¬ 0;
node ¬ z.NEW[NodeRep.oper ¬
[bits, oper[z.NEW[OperRep ¬ ParseOperRep[pc]]]]];
};
$machineCode => {
IF bits < 0 THEN bits ¬ 0;
node ¬ z.NEW[NodeRep.machineCode ¬
[bits, machineCode[ ParseBytes[pc] ]]];
};
$module => {
vars: VarList ¬ ParseVarList[pc];
procs: NodeList ¬ ParseNodeList[pc, '}];
node ¬ z.NEW[NodeRep.module ¬
[0, module[vars: vars, procs: procs]]];
};
$source => {
source: SourceRange ¬ ScanSourceRange[st];
nodes: NodeList ¬ ParseNodeList[pc, '}];
IF bits < 0 THEN bits ¬ 0;
node ¬ z.NEW[NodeRep.source ¬
[bits, source[source: source, nodes: nodes]]];
};
$comment => {
msg: ByteSequence ¬ ParseBytes[pc];
node ¬ z.NEW[NodeRep.comment ¬ [0, comment[msg]]];
};
ENDCASE => ERROR SyntaxError ["illegal node kind"];