BBInterpImpl.mesa
Russ Atkinson, May 19, 1983 4:26 pm
DIRECTORY
AMBridge USING [TVForReadOnlyReferent],
AMTypes USING [NComponents, TVType, TypeClass, UnderType],
BBEmptyReturn USING [TheEmptyReturn],
BBEval USING [Eval, EvalHead, GetSymTab],
BBInterp USING [Tree],
BBSafety USING [Mother],
CedarScanner
USING [
AtomFromToken, CharFromToken, ContentsFromToken, GetClosure, GetProc, GetToken, IntFromToken, RealFromToken, RopeFromToken, Token],
PPLeaves USING [HTNode, LTNode],
PPOps USING [ParseStream],
PPTree USING [Link, Node, NodeName, Null],
PrintTV USING [NullPutClosure, PutClosure],
Rope USING [Equal, Flatten, Replace, ROPE, SkipTo, Text],
RTBasic USING [nullType, TV, Type],
SymTab USING [Ref, Store];
BBInterpImpl:
CEDAR
PROGRAM
IMPORTS
AMBridge, AMTypes, BBEmptyReturn, BBEval, BBSafety, CedarScanner, PPOps, Rope, SymTab
EXPORTS BBInterp
SHARES Rope
= BEGIN OPEN BBEval, BBInterp, PrintTV, Rope, RTBasic;
CARD: TYPE = LONG CARDINAL;
global variables
stmtTemplate: ROPE ← "Expr: PROGRAM = {\n}.";
stmtPos: INT ← stmtTemplate.SkipTo[0, "\n"];
nilNode: REF PPTree.Node ← NEW[PPTree.Node[0]];
empty: TV ← BBEmptyReturn.TheEmptyReturn[];
useSimpleParse: BOOL ← TRUE;
ParseExpr:
PUBLIC
PROC
[expr: ROPE, errout: PutClosure ← NullPutClosure] RETURNS [Tree] = {
tree: PPTree.Link ← PPTree.Null;
text: Rope.Text ← expr.Flatten[];
IF useSimpleParse
THEN
RETURN[SimpleParse[text ! NotSimple => CONTINUE]];
we must parse the long way
IF
NOT IsSimpleAssign[text]
THEN
expr ← Rope.Replace["&←(\n)", 3, 0, text];
expr ← stmtTemplate.Replace[stmtPos, 0, expr];
tree ← PPOps.ParseStream[source: expr, errPut: errout];
isolate the first assignment
RETURN [GetFirstAssign[tree]];
};
EvalExpr:
PUBLIC
PROC
[tree: Tree, head: EvalHead]
RETURNS [rtns: TV, numRtns: NAT] = {
type: Type ← nullType;
rtns ← BBEval.Eval[tree, head, nullType];
IF rtns = empty THEN {numRtns ← 0; RETURN};
numRtns ← 1;
type ← AMTypes.UnderType[AMTypes.TVType[rtns]];
IF AMTypes.TypeClass[type] = structure
THEN
numRtns ← AMTypes.NComponents[type];
};
NotSimple: ERROR = CODE;
SimpleTokenClass:
TYPE =
{none, id, literal, atom, assign, dot, comma, nil, leftParen, rightParen, leftSquare, rightSquare};
SimpleParse:
PROC [rope:
ROPE]
RETURNS [root: PPTree.Link] = {
performs a simple parse of the given rope into a tree
returns the null tree if there is a failure of any kind
or if the expression is not simple
OPEN PPLeaves, PPTree, Rope;
text: Text ← rope.Flatten[];
index: NAT ← 0;
len: NAT ← IF text = NIL THEN 0 ELSE text.length;
allcaps: BOOL ← FALSE;
tok: Text ← NIL;
class: SimpleTokenClass ← none;
value: REF ← NIL;
GetChar1: CedarScanner.GetProc = {
PROC [data: REF, index: INT] RETURNS [CHAR]
c: CHAR ← 0C;
IF index < len
THEN
IF (c ← text[index]) = '& THEN c ← 'a;
RETURN [c];
GetChar2: CedarScanner.GetProc = {
PROC [data: REF, index: INT] RETURNS [CHAR]
proc to read the chars exactly, setting allcaps as a side effect
c: CHAR ← 0C;
IF index < len THEN c ← text[index];
IF allcaps AND c NOT IN ['A..'Z] THEN allcaps ← FALSE;
GetToken:
PROC [idCheck:
BOOL ←
TRUE] = {
ENABLE {ABORTED => GO TO abort; ANY => GO TO complex};
mtok: CedarScanner.Token;
DO
allcaps ← TRUE;
class ← none;
mtok ← CedarScanner.GetToken[GetClosure1, index];
index ← mtok.next;
tok ← CedarScanner.ContentsFromToken[GetClosure2, mtok].Flatten[];
SELECT mtok.kind
FROM
tokenID => {
SELECT
TRUE
FROM
NOT allcaps => class ← id;
tok.Equal["NIL"] => class ← nil;
tok.Equal["TRUE"], tok.Equal["FALSE"] => class ← id;
NOT idCheck => class ← id;
ENDCASE => ERROR NotSimple;
};
tokenINT => {
class ← literal;
value ← NEW[INT ← CedarScanner.IntFromToken[GetClosure2, mtok]]};
tokenREAL => {
class ← literal;
value ← NEW[REAL ← CedarScanner.RealFromToken[GetClosure2, mtok]]};
tokenROPE => {
class ← literal;
value ← CedarScanner.RopeFromToken[GetClosure2, mtok];
};
tokenCHAR => {
class ← literal;
value ← NEW[CHAR ← CedarScanner.CharFromToken[GetClosure2, mtok]];
};
tokenATOM => {
class ← atom;
value ← CedarScanner.AtomFromToken[GetClosure2, mtok];
};
tokenSINGLE => {
c: CHAR ← GetChar2[NIL, mtok.start];
SELECT c
FROM
'← => class ← assign;
'. => class ← dot;
', => class ← comma;
'( => class ← leftParen;
') => class ← rightParen;
'[ => class ← leftSquare;
'] => class ← rightSquare;
ENDCASE => ERROR NotSimple;
};
tokenCOMMENT => LOOP;
tokenEOF => {};
ENDCASE => GO TO complex;
RETURN;
ENDLOOP;
EXITS
abort => ERROR ABORTED;
complex => ERROR NotSimple;
};
InternalParse:
PROC
RETURNS [PPTree.Link] = {
left: Link ← Null;
leftClass: SimpleTokenClass ← none;
GetToken[];
leftClass ← class;
SELECT class
FROM
id =>
-- an identifier
left ← NEW[HTNode ← [index: 0, name: tok]];
literal =>
-- a number
left ← NEW[LTNode ← [index: 0, value: value, literal: tok]];
atom => {
an atom literal
temp: REF Node ← NEW[Node[1]];
temp.name ← atom;
temp[1] ← NEW[HTNode ← [index: 0, name: tok]];
left ← temp};
leftParen => {
left ← InternalParse[];
IF class # rightParen THEN GO TO oops;
class ← none}
ENDCASE => GO TO oops;
DO
GetToken[];
SELECT class
FROM
none, rightParen, rightSquare, comma => EXIT;
leftSquare => {
list, tail, each: LIST OF Link ← NIL;
count: CARDINAL ← 0;
temp, node: REF Node ← NIL;
right: Link ← Null;
DO
save: NAT ← index;
GetToken[];
SELECT class
FROM
rightSquare => EXIT;
comma => each ← LIST[Null];
ENDCASE => {
index ← save;
each ← LIST[InternalParse[]];
SELECT class
FROM
comma, rightSquare => {};
ENDCASE => GO TO oops;
};
count ← count + 1;
IF tail = NIL THEN list ← each ELSE tail.rest ← each;
tail ← each;
IF class = rightSquare THEN EXIT;
ENDLOOP;
SELECT count
FROM
0 => {};
1 => right ← list.first;
ENDCASE => {
temp ← NEW[Node[count]];
right ← temp;
temp.name ← list;
FOR i:
CARDINAL
IN [1..count]
DO
temp[i] ← list.first;
list ← list.rest;
ENDLOOP};
node ← NEW[Node[2]];
node.name ← apply;
node[1] ← left;
node[2] ← right;
left ← node};
dot => {
temp: REF Node ← NIL;
right: Link ← Null;
GetToken[FALSE];
IF class # id THEN ERROR NotSimple;
right ← NEW[HTNode ← [index: 0, name: tok]];
temp ← NEW[Node[2]];
temp.name ← dot;
temp[1] ← left;
temp[2] ← right;
left ← temp;
leftClass ← id};
assign => {
temp: REF Node ← NIL;
right: Link ← InternalParse[];
IF right = Null THEN GO TO oops;
temp ← NEW[Node[2]];
temp.name ← assign;
temp[1] ← left;
temp[2] ← right;
left ← temp}
ENDCASE => GO TO oops;
IF class = rightParen THEN EXIT;
ENDLOOP;
RETURN [left];
EXITS
oops => ERROR NotSimple
};
GetClosure1: CedarScanner.GetClosure;
GetClosure2: CedarScanner.GetClosure;
TRUSTED {
due to compilers beyond our control,
we bring you this brief commercial announcement...
GetClosure1 ← [GetChar1];
GetClosure2 ← [GetChar2];
};
root ← InternalParse[];
IF class # none OR root = NIL THEN ERROR NotSimple
};
GetFirstAssign:
PROC [tree: PPTree.Link]
RETURNS [PPTree.Link] = {
returns first assignment in the tree
(where "first" is first in the preorder traversal)
WITH tree
SELECT
FROM
node:
REF PPTree.Node => {
kind: PPTree.NodeName ← node.name;
nsons: CARDINAL = node.sonLimit - 1;
IF kind = assign THEN RETURN [node];
FOR i:
CARDINAL
IN [1..nsons]
DO
nt: PPTree.Link ← GetFirstAssign[node[i]];
IF nt # NIL THEN RETURN [nt]
ENDLOOP}
ENDCASE;
RETURN [NIL]
};
IsSimpleAssign:
PROC [text: Rope.Text]
RETURNS [
BOOL] = {
GetClosure1: CedarScanner.GetClosure;
GetChar1: CedarScanner.GetProc = {
PROC [data: REF, index: INT] RETURNS [CHAR]
c: CHAR ← 0C;
IF index < len
THEN
IF (c ← text[index]) = '& THEN c ← 'a;
RETURN [c];
};
index: NAT ← 0;
len: NAT ← text.length;
token: CedarScanner.Token;
TRUSTED {
due to compilers beyond our control, we bring you this brief commercial announcement...
GetClosure1 ← [GetChar1];
};
First, accept an id
DO
token ← CedarScanner.GetToken[GetClosure1, index];
index ← token.next;
SELECT token.kind
FROM
tokenID => EXIT;
tokenCOMMENT => LOOP;
ENDCASE => RETURN [FALSE];
ENDLOOP;
Next, accept ←
DO
token ← CedarScanner.GetToken[GetClosure1, index];
index ← token.next;
SELECT token.kind
FROM
tokenSINGLE => RETURN [text[token.start] = '←];
tokenCOMMENT => LOOP;
ENDCASE => RETURN [FALSE];
ENDLOOP;
};
TVForUnderType:
PROC [under: Type]
RETURNS [
TV] =
TRUSTED {
RETURN [AMBridge.TVForReadOnlyReferent
[NEW[Type ← AMTypes.UnderType[under]]]]
};
HelpOurBuddy:
PROC =
TRUSTED {
symtab: SymTab.Ref ← BBEval.GetSymTab[];
lag: TV ← NIL;
optional symbol stuff
[] ← symtab.Store["ATOM", TVForUnderType[CODE[ATOM]]];
[] ← symtab.Store["BOOL", lag ← TVForUnderType[CODE[BOOL]]];
[] ← symtab.Store["BOOLEAN", lag];
[] ← symtab.Store["CARD", TVForUnderType[CODE[CARD]]];
[] ← symtab.Store["CARDINAL", TVForUnderType[CODE[CARDINAL]]];
[] ← symtab.Store["CHAR", lag ← TVForUnderType[CODE[CHAR]]];
[] ← symtab.Store["CHARACTER", lag];
[] ← symtab.Store["INT", TVForUnderType[CODE[INT]]];
[] ← symtab.Store["INTEGER", TVForUnderType[CODE[INTEGER]]];
[] ← symtab.Store["PROC", TVForUnderType[CODE[PROC]]];
[] ← symtab.Store["PROCANY", TVForUnderType[CODE[PROC ANY RETURNS ANY]]];
[] ← symtab.Store["PROCESS", TVForUnderType[CODE[PROCESS]]];
[] ← symtab.Store["REF", TVForUnderType[CODE[REF]]];
[] ← symtab.Store["ROPE", TVForUnderType[CODE[ROPE]]];
[] ← symtab.Store["WORD", TVForUnderType[CODE[WORD]]];
};
nilNode.name ← nil;
[] ← BBSafety.Mother[HelpOurBuddy];