IntCodeUtilsImpl.mesa
Copyright Ó 1986, 1987, 1989, 1991 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) November 30, 1989 8:50:21 pm PST
JKF July 27, 1988 8:19:39 am PDT
Willie-s, September 23, 1991 6:07 pm PDT
DIRECTORY
Basics USING [LongNumber],
Basics16 USING [BITXOR],
IntCodeDefs USING [ApplyNode, ArithOper, AssignNode, BlockNode, BooleanOper, CaseList, CedarOper, CheckOper, CodeOper, CommentNode, CompareOper, CompositeLocation, CondNode, ConstNode, ConvertOper, DeclNode, DerefLocation, DummyLocation, EnableNode, EscapeLocation, EscapeOper, FieldLocation, GlobalVarLocation, GotoNode, IndexedLocation, Label, LabelNode, LambdaNode, LocalVarLocation, Location, MachineCodeNode, MesaOper, ModuleNode, Node, NodeList, NodeListRep, NodeRep, nullVariableId, Oper, OperNode, OperRep, ReturnNode, SourceNode, UpLevelLocation, Var, VarList, VarListRep, WordConstNode, zerosWord],
IntCodeUtils USING [Id, IdTab, IdTabRep, IdTabVisitor, LabelVisitor, NullValue, SimplicityLevel, Value, Visitor],
Rope USING [Equal],
SafeStorage USING [GetSystemZone];
Node walking routines
MapNode:
PUBLIC
PROC [node: Node, visitor: IntCodeUtils.Visitor] = {
Note: this routine is used so much that it seems best to have MapNodeList and MapLocation expanded specially here.
list: NodeList ¬ NIL;
IF node = NIL THEN GO TO noMore;
WITH node
SELECT
FROM
var: Var => {
IF var.location #
NIL
THEN
WITH var.location
SELECT
FROM
deref: DerefLocation =>
IF deref.addr # NIL THEN deref.addr ¬ visitor[deref.addr];
indexed: IndexedLocation => {
IF indexed.base # NIL THEN indexed.base ¬ visitor[indexed.base];
IF indexed.index # NIL THEN indexed.index ¬ visitor[indexed.index];
};
field: FieldLocation =>
IF field.base # NIL THEN field.base ¬ visitor[field.base];
composite: CompositeLocation => {
list ¬ composite.parts;
GO TO continue;
};
escape: EscapeLocation =>
IF escape.base # NIL THEN escape.base ¬ visitor[escape.base];
ENDCASE;
GO TO noMore;
EXITS continue => {};
};
block: BlockNode => {
list ¬ block.nodes;
};
enable: EnableNode => {
IF enable.handle #
NIL
THEN {
IF enable.handle.context #
NIL
THEN
enable.handle.context ¬ visitor[enable.handle.context];
IF enable.handle.proc #
NIL
THEN
enable.handle.proc ¬ visitor[enable.handle.proc];
};
list ¬ enable.scope;
};
decl: DeclNode => {
IF decl.var # NIL THEN decl.var ¬ NARROW[visitor[decl.var]];
IF decl.init # NIL THEN decl.init ¬ visitor[decl.init];
GO TO noMore;
};
assign: AssignNode => {
IF assign.lhs # NIL THEN assign.lhs ¬ NARROW[visitor[assign.lhs]];
IF assign.rhs # NIL THEN assign.rhs ¬ visitor[assign.rhs];
GO TO noMore;
};
cond: CondNode => {
FOR each: CaseList ¬ cond.cases, each.rest
WHILE each #
NIL
DO
FOR test: NodeList ¬ each.tests, test.rest
WHILE test #
NIL
DO
IF test.first # NIL THEN test.first ¬ visitor[test.first];
ENDLOOP;
IF each.body # NIL THEN each.body ¬ visitor[each.body];
ENDLOOP;
GO TO noMore;
};
label: LabelNode => {
lab: Label ¬ label.label;
IF lab # NIL AND lab.node # NIL THEN lab.node ¬ visitor[lab.node];
GO TO noMore;
};
apply: ApplyNode => {
IF apply.handler #
NIL
THEN {
IF apply.handler.context #
NIL
THEN
apply.handler.context ¬ visitor[apply.handler.context];
IF apply.handler.proc #
NIL
THEN
apply.handler.proc ¬ visitor[apply.handler.proc];
};
IF apply.proc # NIL THEN apply.proc ¬ visitor[apply.proc];
list ¬ apply.args;
};
lambda: LambdaNode => {
IF lambda.formalArgs # NIL THEN MapVarList[lambda.formalArgs, visitor];
list ¬ lambda.body;
};
return: ReturnNode => {
list ¬ return.rets;
};
module: ModuleNode => {
MapVarList[module.vars, visitor];
list ¬ module.procs;
};
source: SourceNode => {
list ¬ source.nodes;
};
ENDCASE => GO TO noMore;
WHILE list #
NIL
DO
first: Node ¬ list.first;
IF first # NIL THEN list.first ¬ visitor[first];
list ¬ list.rest;
ENDLOOP;
EXITS noMore => {};
};
MapNodeList:
PUBLIC
PROC [nodeList: NodeList, visitor: Visitor] = {
Note: if you change this, also change MapNode.
FOR each: NodeList ¬ nodeList, each.rest
WHILE each #
NIL
DO
first: Node ¬ each.first;
IF first # NIL THEN each.first ¬ visitor[first];
ENDLOOP;
};
MapVarList:
PUBLIC
PROC [varList: VarList, visitor: Visitor] = {
FOR each: VarList ¬ varList, each.rest
WHILE each #
NIL
DO
IF each.first # NIL THEN each.first ¬ NARROW[visitor[each.first]];
ENDLOOP;
};
MapLocation:
PUBLIC
PROC [location: Location, visitor: Visitor] = {
Note: if you change this, also change MapNode.
IF location #
NIL
THEN
WITH location
SELECT
FROM
deref: DerefLocation => {
IF deref.addr # NIL THEN deref.addr ¬ visitor[deref.addr];
};
indexed: IndexedLocation => {
IF indexed.base # NIL THEN indexed.base ¬ visitor[indexed.base];
IF indexed.index # NIL THEN indexed.index ¬ visitor[indexed.index];
};
field: FieldLocation => {
IF field.base # NIL THEN field.base ¬ visitor[field.base];
};
composite: CompositeLocation => {
MapNodeList[composite.parts, visitor];
};
escape: EscapeLocation => {
IF escape.base # NIL THEN escape.base ¬ visitor[escape.base];
};
ENDCASE;
};
VisitLabels:
PUBLIC
PROC
[node: Node, visitor: LabelVisitor, fullTree:
BOOL, visitNIL:
BOOL ¬
FALSE] = {
inner: IntCodeUtils.Visitor = {
[node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]
WITH node
SELECT
FROM
var: Var =>
WITH var.location
SELECT
FROM
localVar: LocalVarLocation =>
IF visitNIL
OR localVar.parent #
NIL
THEN
localVar.parent ¬ visitor[localVar.parent, node, FALSE];
ENDCASE;
label: LabelNode =>
IF visitNIL
OR label.label #
NIL
THEN
label.label ¬ visitor[label.label, node, TRUE];
goto: GotoNode =>
IF visitNIL
OR goto.dest #
NIL
THEN
goto.dest ¬ visitor[goto.dest, node, FALSE];
lambda: LambdaNode =>
IF visitNIL
OR lambda.parent #
NIL
THEN
lambda.parent ¬ visitor[lambda.parent, node, FALSE];
oper: OperNode =>
WITH oper.oper
SELECT
FROM
code:
REF code OperRep =>
IF visitNIL
OR code.label #
NIL
THEN
code.label ¬ visitor[code.label, node, FALSE];
ENDCASE;
ENDCASE;
IF fullTree THEN MapNode[node, inner];
RETURN [node];
};
[] ¬ inner[node];
};
Node & var list routines
NodeListCons:
PUBLIC PROC [first: Node, rest: NodeList ¬
NIL]
RETURNS [NodeList] = {
RETURN [zone.NEW[NodeListRep ¬ [first, rest]]];
};
NodeListTail:
PUBLIC PROC [list: NodeList]
RETURNS [NodeList] = {
IF list = NIL THEN RETURN [NIL];
DO
rest: NodeList ¬ list.rest;
IF rest = NIL THEN RETURN [list];
list ¬ rest;
ENDLOOP;
};
VarListCons:
PUBLIC PROC [first: Var, rest: VarList ¬
NIL]
RETURNS [VarList] = {
RETURN [zone.NEW[VarListRep ¬ [first, rest]]];
};
VarListTail:
PUBLIC PROC [list: VarList]
RETURNS [VarList] = {
IF list = NIL THEN RETURN [NIL];
DO
rest: VarList ¬ list.rest;
IF rest = NIL THEN RETURN [list];
list ¬ rest;
ENDLOOP;
};
Equality & side effect routines
SideEffectFree:
PUBLIC
PROC [node: Node, noSignals:
BOOL]
RETURNS [
BOOL] = {
Returns TRUE if the evaluation of node is guaranteed to not have side effects.
IF noSignals THEN raising a signal (or any other control flow change) is considered to be a side effect. If NOT noSignals, then a side-effect is not considered to take place if normal control is interrupted for a check.
DO
WITH node
SELECT
FROM
var: Var =>
WITH var.location
SELECT
FROM
g: GlobalVarLocation => RETURN [TRUE];
l: LocalVarLocation => RETURN [TRUE];
f: FieldLocation => {node ¬ f.base; LOOP};
c: CompositeLocation => RETURN [SideEffectFreeList[c.parts, noSignals]];
u: UpLevelLocation => RETURN [TRUE];
d: DerefLocation =>
IF noSignals
THEN
RETURN [
FALSE]
ELSE {node ¬ d.addr;
LOOP};
note: an address fault can turn into a signal
d: DummyLocation => RETURN [TRUE];
x: IndexedLocation =>
IF SideEffectFree[x.index, noSignals] THEN {node ¬ x.base; LOOP};
ENDCASE;
const: ConstNode => RETURN [TRUE];
comment: CommentNode => RETURN [TRUE];
oper: OperNode => RETURN [TRUE];
apply: ApplyNode => {
args: NodeList = apply.args;
IF apply.handler # NIL THEN RETURN [FALSE];
IF NOT SideEffectFreeList[args, noSignals] THEN RETURN [FALSE];
WITH apply.proc
SELECT
FROM
oper: OperNode =>
WITH oper.oper
SELECT
FROM
arith: ArithOper =>
SELECT
TRUE
FROM
NOT noSignals => RETURN [TRUE];
arith.class.kind >= real => RETURN [FALSE];
arith.class.checked => RETURN [FALSE];
ENDCASE =>
SELECT arith.select
FROM
div, mod => {
IF args #
NIL
AND args.rest #
NIL
THEN
WITH args.rest.first
SELECT
FROM
wc: WordConstNode =>
IF wc.word # IntCodeDefs.zerosWord
THEN
RETURN [TRUE];
ENDCASE;
RETURN [
FALSE];
The divisor could be zero
};
ENDCASE => RETURN [TRUE];
boolean: BooleanOper => RETURN [TRUE];
convert: ConvertOper =>
SELECT
TRUE
FROM
NOT noSignals => RETURN [TRUE];
convert.from.kind # convert.to.kind => RETURN [FALSE];
convert.from.kind >= real => RETURN [FALSE];
convert.from.precision > convert.to.precision => RETURN [FALSE];
ENDCASE => RETURN [TRUE];
check: CheckOper => RETURN [NOT noSignals];
compare: CompareOper =>
SELECT
TRUE
FROM
NOT noSignals => RETURN [TRUE];
compare.class.kind >= real => RETURN [FALSE];
ENDCASE => RETURN [TRUE];
mesa: MesaOper =>
SELECT mesa.mesa
FROM
addr, all, equal, notEqual => RETURN [TRUE];
ENDCASE;
cedar: CedarOper =>
SELECT cedar.cedar
FROM
narrow, referentType, procCheck => RETURN [NOT noSignals];
ENDCASE;
ENDCASE;
ENDCASE;
};
block: BlockNode => RETURN [SideEffectFreeList[block.nodes, noSignals]];
decl: DeclNode => {node ¬ decl.init; LOOP};
label: LabelNode => {node ¬ label.label.node; LOOP};
goto: GotoNode => RETURN [NOT noSignals];
mc: REF NodeRep.machineCode => RETURN [TRUE];
source: SourceNode => RETURN [SideEffectFreeList[source.nodes, noSignals]];
cond: CondNode => {
FOR each: CaseList ¬ cond.cases, each.rest
WHILE each #
NIL
DO
IF NOT SideEffectFreeList[each.tests, noSignals] THEN RETURN [FALSE];
IF NOT SideEffectFree[each.body, noSignals] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
ENDCASE => IF node = NIL THEN RETURN [TRUE];
RETURN [FALSE];
ENDLOOP;
};
SideEffectFreeList:
PUBLIC
PROC [nodes: NodeList, noSignals:
BOOL]
RETURNS [
BOOL] = {
Returns TRUE if the evaluation of node is guaranteed to not have side effects (noSignals => raising a signal has side effects).
FOR each: NodeList ¬ nodes, each.rest
WHILE each #
NIL
DO
IF NOT SideEffectFree[each.first, noSignals] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
SimplyEqual:
PUBLIC
PROC [n1, n2: Node]
RETURNS [
BOOL] = {
DO
IF n1 = n2 THEN RETURN [TRUE];
IF n1 = NIL OR n2 = NIL THEN RETURN [FALSE];
IF n1.bits # n2.bits THEN RETURN [FALSE];
WITH n1
SELECT
FROM
const1: WordConstNode =>
WITH n2
SELECT
FROM
const2: WordConstNode => RETURN [const1.word = const2.word];
ENDCASE;
var1: Var =>
WITH n2
SELECT
FROM
var2: Var => {
loc1: Location ¬ var1.location;
loc2: Location ¬ var2.location;
IF loc1 = loc2 THEN RETURN [TRUE];
IF loc1 = NIL OR loc2 = NIL THEN RETURN [FALSE];
IF var1.id # nullVariableId AND var1.id = var2.id THEN RETURN [TRUE];
WITH loc1
SELECT
FROM
deref1: DerefLocation =>
WITH loc2
SELECT
FROM
deref2: DerefLocation =>
IF deref1.align = deref2.align
THEN {
n1 ¬ deref1.addr;
n2 ¬ deref2.addr;
LOOP;
};
ENDCASE;
field1: FieldLocation =>
WITH loc2
SELECT
FROM
field2: FieldLocation =>
IF field1.start = field2.start
THEN {
n1 ¬ field1.base;
n2 ¬ field2.base;
LOOP;
};
ENDCASE;
index1: IndexedLocation =>
WITH loc2
SELECT
FROM
index2: IndexedLocation =>
IF SimplyEqual[index1.base, index2.base]
THEN {
n1 ¬ index1.index;
n2 ¬ index2.index;
LOOP;
};
ENDCASE;
dummy1: DummyLocation =>
WITH loc2
SELECT
FROM
index2: DummyLocation => RETURN [TRUE];
ENDCASE;
ENDCASE;
};
ENDCASE;
source1: SourceNode =>
WITH n2
SELECT
FROM
source2: SourceNode => RETURN [SimplyEqualList[source1.nodes, source2.nodes]];
ENDCASE;
block1: BlockNode =>
WITH n2
SELECT
FROM
block2: BlockNode => RETURN [SimplyEqualList[block1.nodes, block2.nodes]];
ENDCASE;
apply1: ApplyNode =>
WITH n2
SELECT
FROM
apply2: ApplyNode => {
IF apply1.handler # NIL OR apply2.handler # NIL THEN RETURN [FALSE];
IF NOT SimplyEqualList[apply1.args, apply2.args] THEN RETURN [FALSE];
n1 ¬ apply1.proc;
n2 ¬ apply2.proc;
LOOP;
};
ENDCASE;
assign1: AssignNode =>
WITH n2
SELECT
FROM
assign2: AssignNode => {
IF NOT SimplyEqual[assign1.lhs, assign2.lhs] THEN RETURN [FALSE];
n1 ¬ assign1.rhs;
n2 ¬ assign2.rhs;
LOOP;
};
ENDCASE;
label1: LabelNode =>
WITH n2
SELECT
FROM
label2: LabelNode =>
{
IF LabelEqual[label1.label, label2.label]
THEN {
n1 ¬ label1.label.node;
n2 ¬ label2.label.node;
LOOP;
};
};
ENDCASE;
goto1: GotoNode =>
WITH n2
SELECT
FROM
goto2: GotoNode => RETURN [LabelEqual[goto1.dest, goto2.dest]];
ENDCASE;
rtn1: ReturnNode =>
WITH n2
SELECT
FROM
rtn2: ReturnNode => RETURN [SimplyEqualList[rtn1.rets, rtn2.rets]];
ENDCASE;
oper1: OperNode =>
WITH n2
SELECT
FROM
oper2: OperNode => RETURN [OperEqual[oper1.oper, oper2.oper]];
ENDCASE;
mc1: MachineCodeNode =>
WITH n2
SELECT
FROM
mc2: MachineCodeNode => RETURN [Rope.Equal[mc1.bytes, mc2.bytes]];
ENDCASE;
cmt1: CommentNode =>
WITH n2
SELECT
FROM
cmt2: CommentNode =>
RETURN [
TRUE];
All comments are considered equal
ENDCASE;
ENDCASE;
RETURN [FALSE];
ENDLOOP;
};
LabelEqual:
PROC [lab1: Label, lab2: Label]
RETURNS [
BOOL] = {
IF lab1 = lab2 THEN RETURN [TRUE];
IF lab1 = NIL OR lab2 = NIL THEN RETURN [FALSE];
RETURN [lab1.id = lab2.id];
};
OperEqual:
PROC [op1: Oper, op2: Oper]
RETURNS [
BOOL] = {
IF op1 = op2 THEN RETURN [TRUE];
IF op1 = NIL OR op2 = NIL THEN RETURN [FALSE];
WITH op1
SELECT
FROM
code1: CodeOper =>
WITH op2
SELECT
FROM
code2: CodeOper => RETURN [code1.direct = code2.direct
AND code1.offset = code2.offset
AND LabelEqual[code1.label, code2.label]];
ENDCASE;
arith1: ArithOper =>
WITH op2
SELECT
FROM
arith2: ArithOper => RETURN [arith1.class = arith2.class
AND arith1.select = arith2.select];
ENDCASE;
bool1: BooleanOper =>
WITH op2
SELECT
FROM
bool2: BooleanOper => RETURN [bool1.class = bool2.class
AND bool1.bits = bool2.bits];
ENDCASE;
cvt1: ConvertOper =>
WITH op2
SELECT
FROM
cvt2: ConvertOper => RETURN [cvt1.to = cvt2.to
AND cvt1.from = cvt2.from];
ENDCASE;
chk1: CheckOper =>
WITH op2
SELECT
FROM
chk2: CheckOper => RETURN [chk1.class = chk2.class
AND chk1.sense = chk2.sense];
ENDCASE;
cmp1: CompareOper =>
WITH op2
SELECT
FROM
cmp2: CompareOper => RETURN [cmp1.class = cmp2.class
AND cmp1.sense = cmp2.sense];
ENDCASE;
mesa1: MesaOper =>
WITH op2
SELECT
FROM
mesa2: MesaOper => RETURN [mesa1.mesa = mesa2.mesa
AND mesa1.info = mesa2.info];
ENDCASE;
cedar1: CedarOper =>
WITH op2
SELECT
FROM
cedar2: CedarOper => RETURN [cedar1.cedar = cedar2.cedar
AND cedar1.info = cedar2.info];
ENDCASE;
escape1: EscapeOper =>
WITH op2
SELECT
FROM
escape2: EscapeOper => RETURN [escape1.escape = escape2.escape
AND escape1.info = escape2.info];
ENDCASE;
ENDCASE;
RETURN [FALSE];
};
SimplyEqualList:
PUBLIC
PROC [nl1, nl2: NodeList]
RETURNS [
BOOL] = {
DO
SELECT
TRUE
FROM
nl1 = nl2 => RETURN [TRUE];
nl1 = NIL, nl2 = NIL => RETURN [FALSE];
ENDCASE => {
n1: Node ¬ nl1.first;
n2: Node ¬ nl2.first;
WITH nl1.first
SELECT
FROM
comment: CommentNode => GO TO spin1;
source: SourceNode =>
SELECT
TRUE
FROM
source.nodes = NIL => GO TO spin1;
source.nodes.rest = NIL => n1 ¬ source.nodes.first;
ENDCASE;
ENDCASE;
WITH nl2.first
SELECT
FROM
comment: CommentNode => GO TO spin2;
source: SourceNode =>
SELECT
TRUE
FROM
source.nodes = NIL => GO TO spin2;
source.nodes.rest = NIL => n2 ¬ source.nodes.first;
ENDCASE;
ENDCASE;
IF NOT SimplyEqual[n1, n2] THEN RETURN [FALSE];
nl1 ¬ nl1.rest;
nl2 ¬ nl2.rest;
EXITS
spin1 => nl1 ¬ nl1.rest;
spin2 => nl2 ¬ nl2.rest;
};
ENDLOOP;
};
IsSimple:
PUBLIC
PROC [node: Node, level: SimplicityLevel]
RETURNS [
BOOL] = {
Returns TRUE if the evaluation of node is guaranteed to not have side effects.
IF noSignals THEN raising a signal is considered to be a side effect.
inner:
PROC [node: Node]
RETURNS [
BOOL] = {
list: NodeList ¬ NIL;
IF node = NIL THEN GO TO retTrue;
IF level.maxBits # 0 AND node.bits > level.maxBits THEN GO TO retFalse;
DO
WITH node
SELECT
FROM
var: Var =>
WITH var.location
SELECT
FROM
g: GlobalVarLocation => GO TO retTrue;
l: LocalVarLocation => GO TO retTrue;
f: FieldLocation => {node ¬ f.base; LOOP};
c: CompositeLocation => {list ¬ c.parts; EXIT};
u: UpLevelLocation => RETURN [level.derefs # 0];
d: DerefLocation =>
IF level.derefs # 0
THEN {
level.derefs ¬ level.derefs - 1;
node ¬ d.addr;
LOOP;
};
d: DummyLocation => GO TO retTrue;
x: IndexedLocation => {
IF level.simpleOps # 0
THEN {
level.simpleOps ¬ level.simpleOps - 1;
IF inner[x.index] THEN {node ¬ x.base; LOOP};
};
};
ENDCASE;
const: ConstNode => GO TO retTrue;
comment: CommentNode => GO TO retTrue;
apply: ApplyNode => {
IF apply.handler # NIL THEN GO TO retFalse;
IF level.simpleOps = 0 THEN GO TO retFalse;
level.simpleOps ¬ level.simpleOps - 1;
FOR each: NodeList ¬ apply.args, each.rest
WHILE each #
NIL
DO
IF NOT inner[each.first] THEN GO TO retFalse;
ENDLOOP;
WITH apply.proc
SELECT
FROM
oper: OperNode =>
WITH oper.oper
SELECT
FROM
arith: ArithOper => RETURN [level.noSignals];
boolean: BooleanOper => GO TO retTrue;
convert: ConvertOper => RETURN [level.noSignals];
check: CheckOper => RETURN [level.noSignals];
compare: CompareOper => GO TO retTrue;
mesa: MesaOper =>
SELECT mesa.mesa
FROM
addr, all, equal, notEqual => GO TO retTrue;
ENDCASE;
cedar: CedarOper =>
SELECT cedar.cedar
FROM
narrow, referentType, procCheck => RETURN [level.noSignals];
ENDCASE;
ENDCASE;
ENDCASE;
};
block: BlockNode => {list ¬ block.nodes; EXIT};
source: SourceNode => {list ¬ source.nodes; EXIT};
cond: CondNode => {
FOR each: CaseList ¬ cond.cases, each.rest
WHILE each #
NIL
DO
FOR test: NodeList ¬ each.tests, test.rest
WHILE test #
NIL
DO
IF NOT inner[test.first] THEN GO TO retFalse;
ENDLOOP;
IF NOT inner[each.body] THEN GO TO retFalse;
ENDLOOP;
GO TO retTrue;
};
ENDCASE => IF node = NIL THEN GO TO retTrue;
GO TO retFalse;
ENDLOOP;
FOR each: NodeList ¬ list, each.rest
WHILE each #
NIL
DO
IF NOT inner[each.first] THEN GO TO retFalse;
ENDLOOP;
GO TO retTrue;
EXITS
retFalse => RETURN [FALSE];
retTrue => RETURN [TRUE];
};
RETURN [inner[node]];
};
IsSimpleList:
PUBLIC
PROC [list: NodeList, level: SimplicityLevel]
RETURNS [
BOOL] = {
FOR each: NodeList ¬ list, each.rest
WHILE each #
NIL
DO
IF NOT IsSimple[each.first, level] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
IDTab types & routines
IdTab: TYPE = REF IdTabRep;
IdTabRep: TYPE = RECORD [
entries: Id ← 0,
data: REF ← NIL
];
Id: TYPE = INT;
IdTabArray: TYPE = REF IdTabArrayRep;
IdTabArrayRep:
TYPE =
ARRAY IdTabIndex
OF IdTabEntry;
IdTabIndex:
TYPE = [0..IdTabIndexMod);
IdTabIndexMod: NAT = 256;
IdTabEntry: TYPE = REF IdTabEntryRep;
IdTabEntryRep:
TYPE =
RECORD [
next: IdTabEntry ¬ NIL,
key: Id ¬ 0,
value: Value ¬ NullValue];
smallTabLimit: NAT ¬ 4;
IdHash:
PROC [id: Id]
RETURNS [IdTabIndex] =
INLINE {
ln: Basics.LongNumber ¬ [int[id]];
RETURN [Basics16.BITXOR[Basics16.BITXOR[ln.lh, ln.ll], Basics16.BITXOR[ln.hh, ln.hl]] MOD IdTabIndexMod];
};
NewIdTab:
PUBLIC PROC
RETURNS [IdTab] = {
Returns a new id tab with no elements.
RETURN [zone.NEW[IdTabRep ¬ [0, NIL]]];
};
Fetch:
PUBLIC
PROC [idTab: IdTab, id: Id]
RETURNS [Value ¬ NullValue] = {
Fetches the value associated with the given id in the given table. Returns NullValue if there was no value.
chain: IdTabEntry ¬ NIL;
WITH idTab.data
SELECT
FROM
array: IdTabArray => chain ¬ array[IdHash[id]];
entry: IdTabEntry => chain ¬ entry;
ENDCASE => RETURN [NIL];
FOR each: IdTabEntry ¬ chain, each.next
WHILE each #
NIL
DO
IF id = each.key THEN RETURN [each.value];
ENDLOOP;
};
Store:
PUBLIC
PROC [idTab: IdTab, id: Id, val:
REF ¬
NIL]
RETURNS [old: Value ¬ NullValue] = {
Stores a new value for the given id. Returns the old value (or NullValue if none). Storing NullValue is equivalent to deleting the old value.
WITH idTab.data
SELECT
FROM
array: IdTabArray => {
hash: IdTabIndex ¬ IdHash[id];
start: IdTabEntry ¬ array[hash];
FOR each: IdTabEntry ¬ start, each.next
WHILE each #
NIL
DO
IF id = each.key
THEN {
old ¬ each.value;
each.value ¬ val;
SELECT
TRUE
FROM
old = val => {};
old = NIL => idTab.entries ¬ idTab.entries + 1;
val = NIL => idTab.entries ¬ idTab.entries - 1;
ENDCASE;
RETURN};
ENDLOOP;
array[hash] ¬ zone.NEW[IdTabEntryRep ¬ [next: start, key: id, value: val]];
idTab.entries ¬ idTab.entries + 1;
RETURN;
};
start: IdTabEntry => {
FOR each: IdTabEntry ¬ start, each.next
WHILE each #
NIL
DO
IF id = each.key
THEN {
old ¬ each.value;
each.value ¬ val;
SELECT
TRUE
FROM
old = val => {};
old = NIL => idTab.entries ¬ idTab.entries + 1;
val = NIL => idTab.entries ¬ idTab.entries - 1;
ENDCASE;
RETURN};
ENDLOOP;
idTab.data ¬ zone.NEW[IdTabEntryRep ¬ [next: start, key: id, value: val]];
};
ENDCASE =>
idTab.data ¬ zone.NEW[IdTabEntryRep ¬ [next: NIL, key: id, value: val]];
IF (idTab.entries ¬ idTab.entries + 1) > smallTabLimit THEN MakeBigTab[idTab];
};
Insert:
PUBLIC PROC [idTab: IdTab, id: Id, val:
REF]
RETURNS [old:
REF ¬
NIL] = {
Stores a new value for the given id only if there was no previous value. Returns the old value (or NullValue if none). Inserting NullValue is a null operation.
WITH idTab.data
SELECT
FROM
array: IdTabArray => {
hash: IdTabIndex ¬ IdHash[id];
start: IdTabEntry ¬ array[hash];
FOR each: IdTabEntry ¬ start, each.next
WHILE each #
NIL
DO
IF id = each.key
THEN {
old ¬ each.value;
IF old = NIL THEN each.value ¬ val;
SELECT
TRUE
FROM
old = val => {};
old = NIL => idTab.entries ¬ idTab.entries + 1;
val = NIL => idTab.entries ¬ idTab.entries - 1;
ENDCASE;
RETURN};
ENDLOOP;
array[hash] ¬ zone.NEW[IdTabEntryRep ¬ [next: start, key: id, value: val]];
idTab.entries ¬ idTab.entries + 1;
RETURN;
};
start: IdTabEntry => {
FOR each: IdTabEntry ¬ start, each.next
WHILE each #
NIL
DO
IF id = each.key
THEN {
old ¬ each.value;
IF old = NIL THEN each.value ¬ val;
SELECT
TRUE
FROM
old = val => {};
old = NIL => idTab.entries ¬ idTab.entries + 1;
val = NIL => idTab.entries ¬ idTab.entries - 1;
ENDCASE;
RETURN};
ENDLOOP;
idTab.data ¬ zone.NEW[IdTabEntryRep ¬ [next: start, key: id, value: val]];
};
ENDCASE =>
idTab.data ¬ zone.NEW[IdTabEntryRep ¬ [next: NIL, key: id, value: val]];
IF (idTab.entries ¬ idTab.entries + 1) > smallTabLimit THEN MakeBigTab[idTab];
};
Enumerate:
PUBLIC
PROC [idTab: IdTab, visitor: IdTabVisitor] = {
Applies the visitor to each association in the table.
WITH idTab.data
SELECT
FROM
array: IdTabArray =>
FOR ax: IdTabIndex
IN IdTabIndex
DO
FOR each: IdTabEntry ¬ array[ax], each.next
WHILE each #
NIL
DO
val: Value ¬ each.value;
IF val # NullValue AND visitor[each.key, val] THEN RETURN;
ENDLOOP;
ENDLOOP;
entry: IdTabEntry =>
FOR each: IdTabEntry ¬ entry, each.next
WHILE each #
NIL
DO
val: Value ¬ each.value;
IF val # NullValue AND visitor[each.key, val] THEN RETURN;
ENDLOOP;
ENDCASE;
};
MakeBigTab:
PROC [idTab: IdTab] = {
Convert a small table into a big table. We require that the table have been small, of course.
chain: IdTabEntry ¬ NARROW[idTab.data];
array: IdTabArray ¬ zone.NEW[IdTabArrayRep ¬ ALL[NIL]];
WHILE chain #
NIL
DO
next: IdTabEntry ¬ chain.next;
hash: IdTabIndex ¬ IdHash[chain.key];
chain.next ¬ array[hash];
array[hash] ¬ chain;
chain ¬ next;
ENDLOOP;
idTab.data ¬ array;
};