-- file SMTreeBuildImpl.mesa rewritten by PGS, 11-Aug-83 14:19
-- last modified by Satterthwaite, August 11, 1983 2:18 pm
-- last edit by Schmidt, June 11, 1982 3:12 pm
-- pgs [defs: SMParseTable, bcd: SMParseData, grammar: SML] ← SMTreeBuildImpl.mesa;
-- output: new version of SMTreeBuildImpl.mesa, tables in SMParseData.bcd
-- interface on SMParseTable.mesa
-- log on PGS.Log, grammar on SML.grammar,
-- errors on SMParseData.errlog
DIRECTORY
Atom: TYPE USING [MakeAtom],
SMP1: TYPE --P1-- USING [ActionStack, LinkStack, Value, ValueStack],
SMParseTable: TYPE ParseTable USING [ProdDataRef],
Rope: TYPE USING [Fetch, Flatten, FromChar, Length, ROPE, Substr, Text],
SMTree: TYPE Tree USING [AttrId, Link, Name, NodeName, null],
SMTreeOps: TYPE --TreeOps-- USING [
TM,
NSons, PopTree, PushTree, PushName, PushNode, PushText, SetAttr, SetInfo, UpdateSons],
SMCommentTable: TYPE USING [Index],
SMOps: TYPE USING [MS];
-- this program is monitored by the ML in SMReaderImpl
SMTreeBuildImpl: CEDAR PROGRAM
IMPORTS Atom, Rope, SMTreeOps
EXPORTS SMP1 ~ {
-- parse tree building
OPEN P1~~SMP1, Tree~~SMTree, TreeOps~~SMTreeOps, SMParseTable, SMCommentTable;
Op: TYPE ~ Tree.NodeName;
-- local data base (supplied by parser)
cm: SMOps.MS;
tm: TreeOps.TM;
v: P1.ValueStack;
l: P1.LinkStack;
q: P1.ActionStack;
prodData: ProdDataRef;
-- initialization/termination
AssignDescriptors: PUBLIC PROC[
qd: P1.ActionStack,
vd: P1.ValueStack, ld: P1.LinkStack,
pp: ProdDataRef,
model: SMOps.MS] ~ {
q ← qd; v ← vd; l ← ld; prodData ← pp;
cm ← model; tm ← cm.tm};
-- stack manipulation
-- note that r and s may be overlaid in some parameterizations
PushHashV: PROC[k: NAT] ~ {
tm.PushName[NARROW[v[k].t]];
tm.PushNode[$locator,1]; LinkToSource[k]};
PushStringLitV: PROC[k: NAT] ~ {
tm.PushText[NARROW[v[k].t]];
tm.PushNode[$locator,1]; LinkToSource[k]};
-- the interpretation rules
LinkToSource: PROC[index: CARDINAL] ~ {tm.SetInfo[l[index]]};
-- propagated attributes
ProcessQueue: PUBLIC PROC[qI, top: CARDINAL] ~ {
FOR i: CARDINAL IN [0..qI) DO
GetRule: PROC[n: CARDINAL] RETURNS [CARDINAL] ~ TRUSTED INLINE {
RETURN [prodData[n].rule]};
top ← top-q[i].tag.pLength+1;
SELECT GetRule[q[i].transition] FROM
-- basic tree building
0 => -- TABLE: SMParseData TYPE: ParseTable EXPORTS: SELF
-- GOAL: goal
-- TERMINALS:
-- name string , : ;
-- ] filename
-- [ . ~ = >
-- + - * / \ ↑
-- ( )
-- LAMBDA LET REC IN
-- TYPE STRING ENV NIL CONTROL
-- THEN CROSS
-- endfile
-- ALIASES:
-- name tokenID
-- string tokenSTR
-- filename tokenFILENAME
-- . initialSymbol
-- endfile tokenEOF
-- PRODUCTIONS:
-- goal ::= . source
NULL;
1 => -- source ::= exp endfile
NULL;
2 => -- exp ::= LAMBDA term = > exp IN exp
{
tm.PushNode[$lambda, 3];
LinkToSource[top];
};
3 => -- exp ::= LAMBDA term IN exp
{
node: Tree.Link = tm.PopTree;
tm.PushTree[Tree.null];
tm.PushTree[node];
tm.PushNode[$lambda, 3];
LinkToSource[top];
};
4 => -- exp ::= LET term IN exp
{
tm.PushNode[$let, 2];
LinkToSource[top];
};
5 => -- exp ::= term - > exp
{
tm.PushNode[$arrow, 2];
LinkToSource[top];
};
6 => -- exp ::= term
NULL;
7 => -- term ::= term + factor
{
tm.PushNode[$union, 2];
LinkToSource[top];
};
8 => -- term ::= term THEN factor
{
tm.PushNode[$then, 2];
LinkToSource[top];
};
9 => -- term ::= term - factor
{
tm.PushNode[$exclusion, 2];
LinkToSource[top];
};
10 => -- term ::= term ↑ factor
{
tm.PushNode[$restriction, 2];
LinkToSource[top];
};
11 => -- term ::= term \ factor
{
tm.PushNode[$splitUpper, 2];
LinkToSource[top];
};
12 => -- term ::= term / factor
{
tm.PushNode[$splitLower, 2];
LinkToSource[top];
};
13 => -- term ::= factor
NULL;
14 => -- factor ::= appl CROSS factor
{
tm.PushNode[$cross, 2];
LinkToSource[top];
};
15 => -- factor ::= appl CROSS CROSS factor
{
tm.PushNode[$cross2, 2];
LinkToSource[top];
};
16 => -- factor ::= appl
NULL;
17 => -- appl ::= appl bracket
{
tm.PushNode[$apply, 2];
LinkToSource[top];
};
18 => -- appl ::= appl * bracket
{
tm.PushNode[$applyDefault, 2];
LinkToSource[top];
};
19 => -- appl ::= primary
NULL;
20 => -- primary ::= name
PushHashV[top];
21 => -- primary ::= string
PushStringLitV[top];
22 => -- primary ::= TYPE
{
tm.PushTree[Tree.null];
tm.PushNode[$type, 1];
LinkToSource[top];
};
23 => -- primary ::= TYPE name
{
PushHashV[top+1];
tm.PushNode[$type, 1];
};
24 => -- primary ::= STRING
tm.PushNode[$typeSTRING, 0];
25 => -- term ::= CONTROL
tm.PushNode[$control, 0];
26 => -- primary ::= ENV
{
tm.PushNode[$env, 0];
LinkToSource[top];
};
27 => -- primary ::= NIL
{
tm.PushNode[$nil, 0];
LinkToSource[top];
};
28 => -- primary ::= filename
ProcessFileName[NARROW[v[top].t]];
29 => -- primary ::= bracket
NULL;
30 => -- primary ::= primary . name
{
PushHashV[top+2];
tm.PushNode[$subscript, 2];
LinkToSource[top];
};
31 => -- bracket ::= group
NULL;
32 => -- bracket ::= [ decl ]
{
tm.PushNode[$decl, v[top+1].n];
tm.SetAttr[1, TRUE];
LinkToSource[top];
};
33 => -- bracket ::= [ binding ]
{
tm.PushNode[$bind, v[top+1].n];
LinkToSource[top];
};
34 => -- bracket ::= REC [ binding ]
{
tm.PushNode[$bindRec, v[top+2].n];
LinkToSource[top];
};
35 => -- bracket ::= ( exp )
NULL;
36 => -- group ::= [ expList ]
tm.PushNode[$group, v[top+1].n];
37 => -- group ::= [ ]
tm.PushNode[$group, 0];
38 => -- expList ::= exp
-- expListC ::= exp ,
-- expListS ::= exp ;
v[top].n ← 1;
39 => -- expList ::= expListC exp
-- expList ::= expListS exp
-- expListC ::= expListC exp ,
-- expListS ::= expListS exp ;
v[top].n ← v[top].n + 1;
40 => -- decl ::= declElem
-- declC ::= declElem ,
-- declS ::= declElem ;
v[top].n ← 1;
41 => -- decl ::= declC declElem
-- decl ::= declS declElem
-- declC ::= declC declElem ,
-- declS ::= declS declElem ;
v[top].n ← v[top].n + 1;
42 => -- declElem ::= name : exp
{
PushHashV[top];
tm.PushNode[$declElem, -2];
};
43 => -- binding ::= bindElem
-- bindingC ::= bindElem ,
-- bindingS ::= bindElem ;
v[top].n ← 1;
44 => -- binding ::= bindingC bindElem
-- binding ::= bindingS bindElem
-- bindingC ::= bindingC bindElem ,
-- bindingS ::= bindingS bindElem ;
v[top].n ← v[top].n + 1;
45 => -- bindElem ::= [ decl ] ~ exp
{
exp: Tree.Link = tm.PopTree;
tm.PushNode[$decl, v[top+1].n];
tm.SetAttr[1, FALSE];
LinkToSource[top];
tm.PushTree[exp];
tm.PushNode[$bindElem, 2];
};
46 => -- bindElem ::= declElem ~ exp
{
exp: Tree.Link = tm.PopTree;
tm.PushNode[$decl, 1]; tm.SetAttr[1, FALSE];
tm.PushTree[exp];
tm.PushNode[$bindElem, 2];
};
47 => -- bindElem ::= name ~ exp
{
exp: Tree.Link = tm.PopTree;
v[top].t ← PushImplicitDecl[tm, v[top].t];
tm.PushNode[$decl, 1]; tm.SetAttr[1, FALSE];
tm.PushTree[exp];
tm.PushNode[$bindElem, 2];
};
48 => -- bindElem ::= group ~ exp
{
exp: Tree.Link = tm.PopTree;
group: Tree.Link = tm.PopTree;
tm.UpdateSons[group, PushImplicitDecl];
tm.PushNode[$decl, TreeOps.NSons[group]]; tm.SetAttr[1, FALSE];
tm.PushTree[exp];
tm.PushNode[$bindElem, 2];
};
-- error or unimplemented
ENDCASE => ERROR;
ENDLOOP};
PushImplicitDecl: PROC[tm: TreeOps.TM, t: Tree.Link] RETURNS[Tree.Link] ~ {
tm.PushTree[t];
tm.PushTree[Tree.null]; tm.PushNode[$declElem, 2];
RETURN[Tree.null]};
MakeName: PROC[r: Rope.ROPE] RETURNS[Tree.Name] ~ {
RETURN[Atom.MakeAtom[r]]};
ProcessFileName: PROC[name: Rope.Text] ~ {
t, sep: Rope.Text ← NIL;
index: CARDINAL ← 0;
n: CARDINAL;
max: INT ~ name.Length[];
GetNext: PROC RETURNS[pat: Rope.Text] ~ {
ch: CHAR;
start: INT;
IF index >= max THEN RETURN[NIL];
ch ← name.Fetch[index];
SELECT ch FROM
'[, '], '<, '>, '↑, '@, '., '! => {
pat ← Rope.FromChar[ch];
index ← index + 1;
RETURN};
ENDCASE;
pat ← NIL;
start ← index;
WHILE index < max DO
ch ← name.Fetch[index];
SELECT ch FROM
'[, '], '<, '>, '*, '↑, '@, '., '! => EXIT;
ENDCASE;
index ← index + 1;
ENDLOOP;
IF index > start THEN pat ← Rope.Flatten[name, start, index-start]};
CheckNext: PROC[ch: CHAR] RETURNS[BOOL] ~ {
t: Rope.Text ~ GetNext[];
RETURN[t.Fetch[0] = ch]};
PushPart: PROC[part: Rope.Text] ~ {
IF (part.Fetch[part.Length[]-1] = '↑) THEN {
tm.PushName[MakeName[part.Substr[0, part.Length[]-1]]];
tm.PushNode[$unQuote, 1]}
ELSE tm.PushText[part]};
IF ~CheckNext['@] THEN ERROR;
t ← GetNext[];
IF t.Fetch[0] = '[ THEN {
t ← GetNext[];
PushPart[t];
IF ~CheckNext[']] THEN {
-- ["Error - missing ']' in '%s'.\n"L, savefn];
ERROR};
t ← GetNext[]}
ELSE tm.PushTree[Tree.null];
IF t.Fetch[0] = '< THEN {
t ← GetNext[]; sep ← GetNext[];
n ← 0;
WHILE sep.Length[] > 0 AND sep.Fetch[0] = '> DO
PushPart[t];
n ← n + 1;
t ← GetNext[]; sep ← GetNext[];
ENDLOOP;
tm.PushNode[$uiList, n]}
ELSE tm.PushTree[Tree.null];
-- now is just a name.ext.ext
-- get name
n ← 1;
PushPart[t];
IF index < name.Length[] OR sep.Length[] > 0 THEN {
IF sep.Length = 0 THEN sep ← GetNext[];
IF sep.Fetch[0] ~= '. THEN {
-- CWF.WF1["Error - missing '.' in '%s'.\n"L, savefn];
ERROR};
DO
PushPart[GetNext[]];
n ← n + 1;
sep ← GetNext[];
IF sep = NIL OR sep.Length = 0 THEN EXIT;
IF sep.Fetch[0] = '! THEN EXIT;
IF sep.Fetch[0] ~= '. THEN {
-- CWF.WF1["Error - missing '.' in '%s'.\n"L, savefn];
ERROR};
ENDLOOP};
tm.PushNode[$uiList, n];
IF sep ~= NIL AND sep.Fetch[0] = '! THEN {
hex, highest: BOOL ← FALSE;
t ← GetNext[];
FOR n: INT IN [0 .. t.Length[]) DO
ch: CHAR ~ t.Fetch[n];
SELECT t.Fetch[n] FROM
IN ['0 .. '9] => NULL;
IN ['a .. 'f], IN ['A..'F] => hex ← TRUE;
'h, 'H => highest ← TRUE;
ENDCASE => {
-- CWF.WF1["Error - invalid version id: %s\n"L, t];
ERROR}
ENDLOOP;
IF (hex AND t.Length # 12) OR (highest AND t.Length # 1) THEN {
-- CWF.WF1["Error - invalid version id: %s\n"L, t];
ERROR};
tm.PushText[t]}
ELSE tm.PushTree[Tree.null];
-- host directory namelist number
tm.PushNode[$unitId, 4]};
}.
xx => -- declElem ::= group : exp
tm.PushNode[$declElem, 2];