Context
CheckTypeVal:
PROC [lit: PropertyLiteral] = {
type:
ATOM ←
WITH lit.val
SELECT
FROM
a: ATOM => atom,
r: ROPE => rope,
i: REF INT => int,
r: REF REAL => real,
r: REF => ref,
ENDCASE => ERROR;
CheckTypeProp[lit.key, type];
};
CheckTypeProp:
PROC [prop, type:
ATOM] = {
IF ~RefTab.Fetch[propTable, prop].val=type THEN ERROR}; -- prop reg. with another type
-- The properties are older as we move towards the end of the list
-- and this is how the scoping mechanism works
FetchRef:
PROC [context: CContext, prop:
ATOM]
RETURNS [found:
BOOL ←
FALSE, ref:
REF ←
NIL] = {
FOR l: Stack ← context.stack, l.rest
WHILE l#
NIL
DO
IF l.first.key=prop THEN RETURN[TRUE, l.first.val];
ENDLOOP;
};
GetRef:
PUBLIC PROC [context: CContext, prop:
ATOM]
RETURNS [
REF] = {
FOR l: Stack ← context.stack, l.rest
WHILE l#
NIL
DO
IF l.first.key=prop THEN RETURN[l.first.val];
ENDLOOP;
ERROR; -- prop not found
};
GetAtom:
PUBLIC PROC [context: CContext, prop:
ATOM]
RETURNS [
ATOM] = {
CheckTypeProp[prop, atom];
RETURN[NARROW[GetRef[context, prop]]];};
GetRope:
PUBLIC PROC [context: CContext, prop:
ATOM]
RETURNS [
ROPE] = {
CheckTypeProp[prop, rope];
RETURN[NARROW[GetRef[context, prop]]];};
GetInt:
PUBLIC PROC [context: CContext, prop:
ATOM]
RETURNS [
INT] = {
CheckTypeProp[prop, int];
RETURN[NARROW[GetRef[context, prop], REF INT]^];};
GetReal:
PUBLIC PROC [context: CContext, prop:
ATOM]
RETURNS [
REAL] = {
CheckTypeProp[prop, real];
RETURN[NARROW[GetRef[context, prop], REF REAL]^];};
GetBool:
PUBLIC PROC [context: CContext, prop:
ATOM]
RETURNS [
BOOL] = {
CheckTypeProp[prop, bool];
RETURN[NARROW[GetRef[context, prop], REF BOOL]^];};
PushRef:
PUBLIC
PROC [context: CContext, prop:
ATOM, val:
REF] =
TRUSTED{
context.stack ← CONS[[prop, val], context.stack];
[] ← SymTab.Store[context.tab, Atom.GetPName[prop], AMBridge.TVForReferent[val]]};
PushAtom:
PUBLIC
PROC [context: CContext, prop:
ATOM, val:
ATOM] =
TRUSTED{
context.stack ← CONS[[prop, val], context.stack];
[] ← SymTab.Store[context.tab, Atom.GetPName[prop], AMBridge.TVForATOM[val]]};
PushRope:
PUBLIC
PROC [context: CContext, prop:
ATOM, val:
ROPE] =
TRUSTED{
context.stack ← CONS[[prop, val], context.stack];
[] ← SymTab.Store[context.tab, Atom.GetPName[prop], AMBridge.TVForROPE[val]]};
PushInt:
PUBLIC
PROC [context: CContext, prop:
ATOM, val:
INT] =
TRUSTED{
PushRef[context, prop, NEW[INT ← val]]};
PushReal:
PUBLIC
PROC [context: CContext, prop:
ATOM, val:
REAL] =
TRUSTED{
PushRef[context, prop, NEW[REAL ← val]]};
PushBool:
PUBLIC
PROC [context: CContext, prop:
ATOM, val:
BOOL] =
TRUSTED{
PushRef[context, prop, NEW[BOOL ← val]]};
RegisterProperty:
PROC [prop, type:
ATOM] = {
[] ← RefTab.Store[propTable, prop, type]};
FetchPropertyType:
PROC [prop:
ATOM]
RETURNS [type:
ATOM] = {
type ← NARROW[RefTab.Fetch[propTable, prop].val]};
RegisterRefProperty: PUBLIC PROC [prop: ATOM] = {RegisterProperty[prop, ref]};
RegisterAtomProperty: PUBLIC PROC [prop: ATOM] = {RegisterProperty[prop, atom]};
RegisterRopeProperty: PUBLIC PROC [prop: ATOM] = {RegisterProperty[prop, rope]};
RegisterIntProperty: PUBLIC PROC [prop: ATOM] = {RegisterProperty[prop, int]};
RegisterRealProperty: PUBLIC PROC [prop: ATOM] = {RegisterProperty[prop, real]};
RegisterBoolProperty: PUBLIC PROC [prop: ATOM] = {RegisterProperty[prop, bool]};
CreateContext:
PUBLIC
PROC [init: CContext ←
NIL, props: PropertyLiterals ←
NIL]
RETURNS [CContext] = {
new: CContext ← init;
IF new=NIL THEN new ← NEW[ContextRec ← [tab: SymTab.Create[ ]]];
FOR l: PropertyLiterals ← props, l.rest
WHILE l#
NIL
DO
lit: PropertyLiteral ← l.first;
CheckTypeVal[lit];
PushRef[new, lit.key, lit.val];
ENDLOOP;
RETURN[new];
};
MarkContext:
PUBLIC PROC [context: CContext, mark:
ATOM] = {
context.stack ← CONS[[stMark, mark], context.stack]};
Equal:
PROC [lit1, lit2: PropertyLiteral]
RETURNS [
BOOL] = {
RETURN[lit1.key=lit2.key AND lit1.val=lit2.val];
};
PopLit:
PROC [context: CContext]
RETURNS [lit: PropertyLiteral] =
TRUSTED{
older: REF; found: BOOL;
IF context.stack=NIL THEN ERROR; -- empty stack
lit ← context.stack.first;
context.stack ← context.stack.rest;
[found, older] ← FetchRef[context, lit.key]; -- found in stack
IF found THEN [] ← SymTab.Store[context.tab, Atom.GetPName[lit.key], AMBridge.TVForReferent[NEW[REF ← older]]]
ELSE [] ← SymTab.Delete[context.tab, Atom.GetPName[lit.key]];
};
PopContext:
PUBLIC PROC [context: CContext, mark:
ATOM] = {
lit: PropertyLiteral ← PopLit[context];
goal: PropertyLiteral ← [stMark, mark];
UNTIL Equal[lit, goal]
DO
-- mark is the last one popped
lit ← PopLit[context];
ENDLOOP;
};
RegisterStructureProc:
PUBLIC PROC [name:
ROPE, proc: StructureProc]
RETURNS [
ROPE] = {
val: REF StructureProc ← NEW[StructureProc ← proc];
ok: BOOL ← SymTab.Store[structProcTable, name, val]; -- larger table!
IF ~ok THEN ERROR; -- double registration?
RETURN[name]};
CreateStructure:
PUBLIC PROC [name:
ROPE, context: CContext]
RETURNS [ct: Core.CellType] = {
val: REF; found: BOOL; proc: StructureProc;
[found, val] ← SymTab.Fetch[structProcTable, name];
IF ~found THEN ERROR; -- proc not registered: should we return NIL?
proc ← NARROW[val, REF StructureProc]^;
MarkContext[context, procMark];
ct ← proc[context];
PopContext[context, procMark];
};
Wires
-- w1.structure=record and w2.structure=record
WireUnion:
PROC [w1, w2: Wire]
RETURNS [union: Wire] = {
size1: INT;
IF w1=NIL THEN RETURN[w2];
IF w2=NIL THEN RETURN[w1];
union ← NEW[Core.WireRec ← w1^];
size1 ← w1.elements.size;
union.elements ← NEW[Core.WireSequenceRec[size1+w2.elements.size]];
FOR i: INT IN [0..w1.elements.size) DO union.elements[i] ← w1.elements[i] ENDLOOP;
FOR i: INT IN [0..w2.elements.size) DO union.elements[i+size1] ← w2.elements[i] ENDLOOP;
};
CreateSequenceWire:
PROC [wire: Wire, n:
INT]
RETURNS [seq: Wire] = {
comp: LIST OF Wire ← NIL;
IF wire=NIL THEN wire ← CoreOps.CreateAtomWire[];
FOR i: INT IN [0..n) DO comp ← CONS[CoreOps.CopyWire[wire], comp]; ENDLOOP;
seq ← CoreOps.CreateSequenceWire[components: comp];
};
-- Return a public or internal wire
CreateWires:
PUBLIC
PROC [context: CContext, rope:
ROPE]
RETURNS [wire: Wire] = {
wire ← Eval[Parse[rope], NIL, context].compWire;
-- A public wire should be a record
IF wire.structure#record
THEN
wire ← CoreOps.CreateRecordWire[components: LIST[wire]];
};
-- top level only
FindNamedWire:
PROC [name:
ROPE, public: Wire]
RETURNS [wire: Wire] = {
RETURN[public.elements[FindIndexWire[name, public]]]};
FindIndexWire:
PROC [name:
ROPE, public: Wire]
RETURNS [
INT ← -1] = {
FOR i:
INT
IN [0..public.elements.size)
DO
IF Rope.Equal[name, public.elements[i].name] THEN RETURN[i];
ENDLOOP;
};
Parser and Evaluators
-- Evaluator for Actual Wires
-- The tree is of type list, unless there is only one binding, . . .
-- Parse a list of "formal:actual", check that formal is in ct.publicWire, return actual
-- Completes by implicit binding (same names)
EvalListOfBinding:
PROC [tree: Tree, public, internal: Wire, context: Context]
RETURNS [wire: Wire] = {
comp: LIST OF Wire ← NIL;
refTab: RefTab.Ref ← RefTab.Create[];
IF tree#
NIL
THEN {
WITH tree
SELECT
FROM
node: Node => {
formal, actual: Wire;
IF node.name=list
THEN
-- list of bindings
{
FOR i:
INT
IN [1..node.sonLimit)
DO
[formal, actual] ← EvalActBinding[Nth[node, i], public, internal, context];
[] ← RefTab.Store[refTab, formal, actual];
ENDLOOP;
}
ELSE {
-- single binding
[formal, actual] ← EvalActBinding[tree, public, internal, context];
[] ← RefTab.Store[refTab, formal, actual];};
};
ENDCASE => ERROR};
-- now implicit binding
FOR i:
INT
IN [0..public.elements.size)
DO
subW: Wire ← public.elements[i];
IF ~RefTab.Fetch[refTab, subW].found
THEN [] ← RefTab.Store[
refTab,
subW,
FindNamedWire[subW.name, internal]];
ENDLOOP;
comp ← VisitTopWire[public, refTab];
wire ← CoreOps.CreateRecordWire[components: RevLOW[comp]];
};
VisitTopWire:
PROC [wire: Wire, refTab: RefTab.Ref]
RETURNS [lw:
LIST
OF Wire ←
NIL] = {
FOR i:
INT
IN [0..wire.elements.size)
DO
lw ← CONS[NARROW[RefTab.Fetch[refTab, wire.elements[i]].val], lw];
ENDLOOP;
};
EvalActBinding:
PROC [tree: Tree, public, internal: Wire, context: Context]
RETURNS [formal, actual: Wire] = {
WITH tree
SELECT
FROM
node: Node => {
IF node.name#item THEN ERROR; -- must be an item formal:actual
formal ← FindFormal[Left[node], public]; -- a public wire of small cell
actual ← EvalActual[Right[node], NIL, internal, context].compWire; -- an internal of record cell
};
ENDCASE => ERROR;
};
EvalActual:
PROC [tree: Tree, wire: Wire ←
NIL, internal: Wire, context: Context]
RETURNS [leftTree: Tree ←
NIL, compWire: Wire] = {
IF tree=NIL THEN RETURN[NIL, wire];
WITH tree
SELECT
FROM
ident: PPLeaves.HTIndex => {
-- find the wire with this name
wire ← FindNamedWire[ident.name, internal];
RETURN[NIL, wire]};
const: PPLeaves.LTIndex => {ERROR}; -- constant?
node: Node => {
-- node
l: Tree ← Left[node];
r: Tree ← Right[node];
SELECT node.name
FROM
dot => {
-- field selection
field: ROPE ← InterpreterOps.TreeToName[r];
compWire ← FindNamedWire[field, EvalActual[l, wire, internal, context].compWire];
};
apply => {
-- array indexing or subrange
right: Node ← NARROW[r];
SELECT right.name
FROM
list => {
-- subrange
start, length: INT;
comp: LIST OF Wire ← NIL;
[start, length] ← EvalSubrange[r, context];
FOR i:
INT
IN [start..start+length)
DO
comp ← CONS[EvalActual[l, wire, internal, context].compWire.elements[i], comp];
ENDLOOP;
compWire ← CoreOps.CreateRecordWire[components: RevLOW[comp]]
};
ENDCASE => {
-- array indexing
n: INT ← EvalToInt[r, context];
compWire ← EvalActual[l, wire, internal, context].compWire.elements[n];
};
};
ENDCASE => ERROR;
};
ENDCASE => ERROR;
};
FindFormal:
PROC [tree: Tree, public: Wire]
RETURNS [formal: Wire] = {
WITH tree
SELECT
FROM
ident: PPLeaves.HTIndex => {formal ← FindNamedWire[ident.name, public]};
ENDCASE => ERROR;
};
-- Evaluator for Public and Internal Wires
Eval:
PROC [tree: Tree, wire: Wire ←
NIL, context: Context]
RETURNS [leftTree: Tree ←
NIL, compWire: Wire] = {
IF tree=NIL THEN RETURN[NIL, wire];
WITH tree
SELECT
FROM
ident: PPLeaves.HTIndex => {
-- name
IF wire=NIL THEN wire ← CoreOps.CreateAtomWire[ident.name]
ELSE wire.name ← ident.name;
RETURN[NIL, wire]};
const: PPLeaves.LTIndex => {ERROR}; -- what is a constant doing here?
node: Node => {
-- node
l: Tree ← Left[node];
r: Tree ← Right[node];
SELECT node.name
FROM
apply => {
[leftTree, compWire] ← Eval[l, Eval[r, wire, context].compWire, context];
RETURN[leftTree, compWire]};
list => {
-- record wire
comp: LIST OF Wire ← NIL;
IF wire#NIL THEN ERROR; -- record has nothing on the right
FOR i:
INT
IN [1..node.sonLimit)
DO
comp ← CONS[Eval[Nth[node, i], NIL, context].compWire, comp];
ENDLOOP;
compWire ← CoreOps.CreateRecordWire[components: RevLOW[comp]];
};
item
=> {
-- sequence spec
SELECT
TRUE
FROM
Rope.Equal[InterpreterOps.TreeToName[l], "SEQ"] => {
compWire ← CreateSequenceWire[wire, EvalToInt[r, context]];
};
Rope.Equal[InterpreterOps.TreeToName[l], "ENUM"] => {
IF wire#NIL THEN ERROR; -- enum has nothing on the right
compWire ← CreateSequenceWire[wire, EvalEnum[r]];
};
ENDCASE => ERROR;
};
ENDCASE => ERROR;
};
ENDCASE => ERROR;
};
};
-- Parser and tree browsing primitives
-- Given a rope, return the parse tree rooted as a list, or NIL if rope=NIL
Parse:
PROC [rope:
ROPE]
RETURNS [parseTree: Tree] = {
node: Node;
IF rope=NIL THEN RETURN[NIL];
parseTree ← InterpreterOps.ParseExpr[Rope.Cat["&fake ← [", rope, "]"]];
node ← NARROW[parseTree];
node ← NARROW[Right[node]]; -- remove "&fake ← "
RETURN[Right[node]]; -- remove "[ ]"
};
Left: PROC [node: Node] RETURNS [Tree] = {RETURN[node[1]]};
Right: PROC [node: Node] RETURNS [Tree] = {RETURN[node[2]]};
Nth:
PROC [node: Node, i:
INT]
RETURNS [Tree] = {
IF i IN [1..node.sonLimit) THEN RETURN[node.son[i]] ELSE RETURN[NIL]};
EvalToInt:
PROC [parseTree: Tree, context: Context]
RETURNS [n:
INT] =
TRUSTED {
tv: AMTypes.
TV ← InterpreterOps.Eval[
head: InterpreterOps.NewEvalHead[
context: AMModel.RootContext[WorldVM.LocalWorld[ ]],
specials: context.tab], -- put the symbol table from the context here
tree: parseTree];
n ← AMBridge.TVToLI[tv];
};
EvalSubrange:
PROC [tree: Tree, context: Context]
RETURNS [start, length:
INT] = {
start ← EvalAndCheck[Left[NARROW[tree]], "ST", context];
length ← EvalAndCheck[Right[NARROW[tree]], "LEN", context];
};
EvalAndCheck:
PROC [tree: Tree, rope:
ROPE, context: Context]
RETURNS [n:
INT] = {
IF ~Rope.Equal[InterpreterOps.TreeToName[Left[NARROW[tree]]], rope, FALSE] THEN ERROR;
n ← EvalToInt[Right[NARROW[tree]], context];
};
RevLOW:
PROC [wires:
LIST
OF Wire]
RETURNS [seriw:
LIST
OF Wire ←
NIL] = {
FOR l:
LIST
OF Wire ← wires, l.rest
WHILE l#
NIL
DO
seriw ← CONS[l.first, seriw];
ENDLOOP;
};