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 lit.key=stMark THEN RETURN;
IF found THEN [] ← SymTab.Store[context.tab, Atom.GetPName[lit.key], AMBridge.TVForReferent[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: 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];
};
IsRegistered:
PUBLIC PROC [name:
ROPE]
RETURNS [
BOOL] = {
RETURN [SymTab.Fetch[structProcTable, name].found];
};
Wires
w1.elements#NIL and w2.elements#NIL
WireUnion:
PROC [w1, w2: WireSequence]
RETURNS [union: WireSequence] = {
IF w1=NIL THEN RETURN [w2];
IF w2=NIL THEN RETURN [w1];
union ← NEW [Core.WireSequenceRec[w1.size+w2.size]];
FOR i: INT IN [0..w1.size) DO union[i] ← w1[i] ENDLOOP;
FOR i: INT IN [0..w2.size) DO union[i+w1.size] ← w2[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: WireSequence] = {
justAWire: Wire ← Eval[Parse[rope], NIL, context].compWire;
wire ← IF CoreOps.GetWireName[justAWire]#NIL THEN CoreOps.WiresToWireSequence[LIST [justAWire]] ELSE justAWire.elements;
};
-- top level only
FindNamedWire:
PROC [name:
ROPE, public: WireSequence]
RETURNS [wire: Wire] = {
RETURN [public[FindIndexWire[name, public]]];
};
FindIndexWire:
PROC [name:
ROPE, public: WireSequence]
RETURNS [
INT ← -1] = {
FOR i:
INT
IN [0 .. public.size)
DO
IF Rope.Equal[name, NARROW [CoreProperties.GetWireProp[public[i], CoreOps.nameProp]]] 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.public, return actual
-- Completes by implicit binding (same names)
EvalListOfBinding:
PROC [tree: Tree, public, internal: WireSequence, context: Context]
RETURNS [wire: WireSequence] = {
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.size)
DO
subW: Wire ← public[i];
IF ~RefTab.Fetch[refTab, subW].found
THEN [] ← RefTab.Store[
refTab,
subW,
FindNamedWire[CoreOps.GetWireName[subW], internal]];
ENDLOOP;
comp ← VisitTopWire[public, refTab];
wire ← CoreOps.WiresToWireSequence[CoreOps.Reverse[comp]];
};
VisitTopWire:
PROC [wire: WireSequence, refTab: RefTab.Ref]
RETURNS [lw:
LIST
OF Wire ←
NIL] = {
FOR i:
INT
IN [0..wire.size)
DO
lw ← CONS[NARROW[RefTab.Fetch[refTab, wire[i]].val], lw];
ENDLOOP;
};
EvalActBinding:
PROC [tree: Tree, public, internal: WireSequence, 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: WireSequence, 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.elements];
};
apply => {
-- array indexing, subrange or record constructor
IF l=
NIL
THEN {
-- record constructor
comp: LIST OF Wire ← NIL;
list: Node ← NARROW[r]; -- a list
IF list.name#list THEN ERROR; -- check that it is a list
FOR i:
INT
IN [1..list.sonLimit)
DO
comp ← CONS[EvalActual[Nth[NARROW[list], i], NIL, internal, context].compWire, comp];
ENDLOOP;
compWire ← CoreOps.CreateRecordWire[components: CoreOps.Reverse[comp]]
}
ELSE {
Added by BS November 9, 1985 11:17:16 pm PST, SANS RIEN Y BITER
WITH r
SELECT
FROM
right: Node => {
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: CoreOps.Reverse[comp]]
};
ENDCASE => {
-- array indexing
n: INT ← EvalToInt[r, context];
compWire ← EvalActual[l, wire, internal, context].compWire.elements[n];
};
};
right: PPLeaves.HTIndex => {
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: CoreOps.Reverse[comp]]
};
ENDCASE => {
-- array indexing
n: INT ← EvalToInt[r, context];
compWire ← EvalActual[l, wire, internal, context].compWire.elements[n];
};
};
ENDCASE => ERROR
};
};
ENDCASE => ERROR;
};
ENDCASE => ERROR;
};
FindFormal:
PROC [tree: Tree, public: WireSequence]
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 CoreProperties.PutWireProp[wire, CoreOps.nameProp, 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: CoreOps.Reverse[comp]];
};
item
=> {
-- sequence spec
SELECT
TRUE
FROM
Rope.Equal[InterpreterOps.TreeToName[l], "seq",
FALSE] => {
compWire ← CreateSequenceWire[wire, EvalToInt[r, context]];
};
Rope.Equal[InterpreterOps.TreeToName[l], "enum",
FALSE] => {
IF wire#NIL THEN ERROR; -- enum has nothing on the right
};
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[],
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]], "start", 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];
};