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;

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]];
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]; 
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] = {
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 = {
c: CHAR _ 0C;
IF index < len THEN
IF (c _ text[index]) = '& THEN c _ 'a;
RETURN [c];
};

GetChar2: CedarScanner.GetProc = {
c: CHAR _ 0C;
IF index < len THEN c _ text[index];
IF allcaps AND c NOT IN ['A..'Z] THEN allcaps _ FALSE;
RETURN [c]}; 

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]];
nil =>
left _ nilNode;
literal => -- a number
left _ NEW[LTNode _ [index: 0, value: value, literal: tok]];
atom =>  {
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 {
GetClosure1 _ [GetChar1];
GetClosure2 _ [GetChar2];
};
root _ InternalParse[]; 
IF class # none OR root = NIL THEN ERROR NotSimple
}; 

GetFirstAssign: PROC [tree: PPTree.Link] RETURNS [PPTree.Link] = {
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 = {
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 {
GetClosure1 _ [GetChar1];
};
DO
token _ CedarScanner.GetToken[GetClosure1, index];
index _ token.next;
SELECT token.kind FROM
tokenID => EXIT;
tokenCOMMENT => LOOP;
ENDCASE => RETURN [FALSE];
ENDLOOP;
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;
[] _ 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];

END.



.BBInterpImpl.mesa
Russ Atkinson, May 19, 1983 4:26 pm
global variables
we must parse the long way 
isolate the first assignment
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
PROC [data: REF, index: INT] RETURNS [CHAR]
PROC [data: REF, index: INT] RETURNS [CHAR]
proc to read the chars exactly, setting allcaps as a side effect
an atom literal
due to compilers beyond our control,
we bring you this brief commercial announcement...
returns first assignment in the tree
(where "first" is first in the preorder traversal)
PROC [data: REF, index: INT] RETURNS [CHAR]
due to compilers beyond our control, we bring you this brief commercial announcement...
First, accept an id
Next, accept _
optional symbol stuff
�Ê÷˜š
œ™Jš
œ#™#—J˜š
Ïk	˜	Jšœ	�œ˜'Jšœ�œ-˜:Jšœ�œ˜%Jšœ�œ˜)Jšœ	�œ˜Jšœ	�œ
˜šœ
�œ˜Jš
œƒ
˜ƒ
—Jšœ	�œ˜ Jšœ�œ˜Jšœ�œ˜*Jšœ�œ˜+Jšœ�œ�œ˜9Jšœ�œ�œ˜#Jšœ�œ˜J˜—šœ�œ
�˜š
�˜Jš
œU˜U—Jš�œ	˜Jš�œ˜Jšœ�œ
�œ*˜6J˜Jš�œ�œ�œ
�œ
˜J˜—š
œ™Jšœ�œ˜.Jšœ	�œ ˜,Jšœ	�œ�œ˜/Jšœ�œ"˜+Jšœ�œ�œ
˜J˜—šÏn	œ�œ
�˜Jšœ�œ'�œ˜DJ˜ J˜!š�œ�˜Jš�œ!�œ˜2—Jš
œ™š�œ
�œ�˜ Jš
œ*˜*—J˜/J˜8Jš
œ™Jš�œ˜J˜J˜—šžœ�œ
�˜J˜Jš�œ�œ�œ˜$J˜J˜)Jš�œ�œ�œ˜+J˜J˜/š�œ%�˜+J˜$—J˜J˜—Jšœ�œ�œ˜J˜šœ�œ˜˜dJ˜——šžœ�œ�œ�œ˜>Jš
œ5™5Jš
œ7™7Jš
œ"™"Jš�œ˜J˜Jšœ�œ˜Jšœ�œ�œ�œ
�œ�œ˜2Jšœ	�œ�œ˜Jšœ�œ˜J˜ Jšœ�œ�œ
˜J˜˜"Jš
œ+™+Jšœ�œ˜
š�œ
�˜Jš�œ�œ˜&—Jš�œ˜˜J˜——˜"Jš
œ+™+Jš
œ@™@Jšœ�œ˜
Jš�œ
�œ˜$Jš�œ	�œ�œ
�œ
�œ�œ
˜6š�œ˜
J˜——šžœ�œ�œ�œ˜)Jš�œ�œ�œ
�œ�œ�œ
�œ
˜6J˜š
�˜Jšœ
�œ
˜J˜
J˜1J˜J˜Bš�œ�˜š
œ˜š�œ
�œ
�˜Jš�œ˜J˜ J˜4Jš�œ˜Jš�œ�œ˜J˜——˜
J˜Jšœ�œ
�œ3˜B—˜J˜Jšœ�œ
�œ4˜D—˜J˜J˜6J˜—˜J˜Jšœ�œ
�œ2˜BJ˜—˜J˜
J˜6J˜—š
œ˜Jšœ�œ�œ˜$š�œ�˜
J˜J˜J˜J˜J˜J˜J˜Jš�œ�œ˜—J˜—Jšœ�œ
˜Jš
œ˜Jš�œ�œ
�œ	˜—Jš�œ
˜Jš�œ
˜—š
�˜Jšœ	�œ
�œ
˜Jšœ�œ˜—J˜J˜—šž
œ�œ
�œ˜-J˜J˜$J˜J˜š�œ�œ
˜šœÏc˜Jšœ�œ!˜+—˜J˜—šœŸ˜Jšœ�œ2˜<—š
œ
˜
Jš
œ™Jšœ�œ�œ˜J˜Jšœ
�œ"˜/J˜
—˜J˜Jš�œ�œ
�œ
�œ˜&J˜
—Jš�œ�œ
�œ˜—š
�˜J˜š�œ�œ
˜Jšœ(�œ
˜-š
œ˜Jšœ�œ
�œ�œ
˜%Jšœ�œ˜Jšœ�œ�œ
˜J˜š
�˜Jšœ�œ	˜J˜š�œ�˜Jšœ�œ
˜Jšœ�œ˜š�œ˜J˜
Jšœ�œ˜š�œ�˜Jš
œ˜Jš�œ�œ
�œ˜—J˜——Jš
œ˜Jš�œ�œ�œ˜5Jšœ�
˜Jš�œ�œ
�œ
˜!Jš�œ
˜—š�œ�˜J˜J˜š�œ˜Jšœ�œ˜J˜
J˜š�œ�œ
�œ�˜ J˜J˜Jš�œ˜	———Jšœ�œ
˜J˜J˜J˜J˜
—š
œ	˜	Jšœ�œ�œ˜J˜Jšœ	�œ˜Jš�œ�œ
�œ˜#Jšœ�œ!˜,Jšœ�œ˜J˜J˜J˜J˜J˜—š
œ˜Jšœ�œ�œ˜J˜Jš�œ�œ
�œ
�œ˜ Jšœ�œ˜J˜J˜J˜J˜Jš�œ�œ
�œ˜——Jš�œ�œ
�œ
˜ Jš�œ
˜—Jš�œ˜š
�˜Jšœ�œ
˜—J˜—J˜%J˜%š�œ˜	Jš
œ$™$Jš
œ2™2J˜J˜J˜—J˜Jš
�œ�œ�œ
�œ
�œ
˜2J˜J˜—šžœ�œ�œ˜BJš
œ$™$Jš
œ2™2š�œ�œ
�œ
˜šœ�œ˜Jš
œ#˜#Jšœ�œ˜%Jš�œ�œ
�œ	˜%š�œ�œ
�œ�œ
˜!J˜*Jš�œ�œ
�œ
�œ˜Jš�œ
˜——Jš�œ˜	—Jš�œ�œ
˜J˜J˜—šžœ�œ�œ�œ˜9J˜%˜"Jš
œ+™+Jšœ�œ˜
š�œ
�˜Jš�œ�œ˜&—Jš�œ˜J˜—Jšœ�œ˜Jšœ�œ˜J˜š�œ˜	Jš
œW™WJ˜J˜—Jš
œ™š
�˜Jš
œ2˜2Jš
œ˜š�œ�˜Jšœ�œ
˜Jšœ�œ
˜Jš�œ�œ�œ˜—Jš�œ
˜—Jš
œ™š
�˜Jš
œ2˜2Jš
œ˜š�œ�˜Jšœ�œ˜/Jšœ�œ
˜Jš�œ�œ�œ˜—Jš�œ
˜—J˜J˜—š
žœ�œ�œ�œ�œ˜;š�œ ˜&Jšœ
�œ#˜'—J˜J˜—šžœ�œ�œ˜J˜(Jšœ�œ�œ
˜Jš
œ™Jšœ)�œ
�œ˜7Jšœ/�œ
�œ˜=Jš
œ#˜#Jšœ)�œ
�œ˜6Jšœ-�œ
�œ˜>Jšœ/�œ
�œ˜<Jš
œ$˜$Jšœ(�œ
�œ˜5Jšœ,�œ
�œ˜=Jšœ)�œ
�œ˜7Jšœ,�œ
�œ
�œ
�œ
�œ˜JJšœ,�œ
�œ˜=Jšœ(�œ
�œ˜5Jšœ)�œ
�œ˜7Jšœ)�œ
�œ˜7J˜J˜—J˜J˜#J˜š�œ
˜J˜J˜J˜——…—!01