-- Copyright (C) 1985 by Xerox Corporation. All rights reserved.
-- DO NOT CONVERT TO TIOGA FORMAT! (PGS requires the mesa-style comments)
-- last edit by Satterthwaite, December 12, 1985 1:37:14 pm PST
-- pgs [defs: SMParseTable, bcd: SMParseData, grammar: SML] ← SMTreeBuildImpl.pgs
-- 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],
SMParseTable: TYPE ParseTable USING [ProdDataRef],
SMP1: TYPE P1 USING [
ActionStack, LinkStack, Value, ValueStack],
Rope: TYPE USING [Fetch, Flatten, Length, ROPE, Substr, Text],
SMOps: TYPE USING [MS],
SMTree: TYPE Tree USING [AttrId, Link, Name, NodeName, null],
SMTreeOps: TYPE TreeOps USING [
TM, NSons, PopTree, PushTree, PushName, PushNode, PushText,
SetAttr, SetExt, SetInfo, UpdateSons];
-- this program is monitored by the ML in SMReaderImpl
SMTreeBuildImpl: CEDAR PROGRAM
IMPORTS Atom, Rope, SMTreeOps
EXPORTS SMP1 = {
-- parse tree building
OPEN ParseTable~~SMParseTable, P1~~SMP1, Tree~~SMTree, TreeOps~~SMTreeOps;
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: ParseTable.ProdDataRef;
-- initialization/termination
AssignDescriptors: PUBLIC PROC[
qd: P1.ActionStack,
vd: P1.ValueStack, ld: P1.LinkStack,
pp: ParseTable.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: NAT] = {tm.SetInfo[l[index]]};
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
--ALIASES:
-- name tokenID
-- string tokenSTR
-- filename tokenFILENAME
-- . initialSymbol
--PRODUCTIONS:
-- goal ::= . source
NULL;
1 => -- source ::= exp
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 - > > exp
{
tm.PushNode[$arrow2, 2];
LinkToSource[top];
};
7 => -- exp ::= term
NULL;
8 => -- term ::= term + factor
{
tm.PushNode[$union, 2];
LinkToSource[top];
};
9 => -- term ::= term THEN factor
{
tm.PushNode[$then, 2];
LinkToSource[top];
};
10 => -- term ::= term - factor
{
tm.PushNode[$exclusion, 2];
LinkToSource[top];
};
11 => -- term ::= term ↑ factor
{
tm.PushNode[$restriction, 2];
LinkToSource[top];
};
12 => -- term ::= term \ factor
{
tm.PushNode[$splitUpper, 2];
LinkToSource[top];
};
13 => -- term ::= term / factor
{
tm.PushNode[$splitLower, 2];
LinkToSource[top];
};
14 => -- term ::= factor
NULL;
15 => -- factor ::= appl CROSS factor
{
tm.PushNode[$cross, 2];
LinkToSource[top];
};
16 => -- factor ::= appl CROSS CROSS factor
{
tm.PushNode[$cross2, 2];
LinkToSource[top];
};
17 => -- factor ::= appl
NULL;
18 => -- appl ::= appl bracket
{
tm.PushNode[$apply, 2];
LinkToSource[top];
};
19 => -- appl ::= appl * bracket
{
tm.PushNode[$applyDefault, 2];
LinkToSource[top];
};
20 => -- appl ::= primary
NULL;
21 => -- primary ::= name
PushHashV[top];
22 => -- primary ::= string
PushStringLitV[top];
23 => -- primary ::= TYPE
{
tm.PushTree[Tree.null];
tm.PushNode[$type, 1];
LinkToSource[top];
};
24 => -- primary ::= TYPE name
{
PushHashV[top+1];
tm.PushNode[$type, 1];
LinkToSource[top];
};
25 => -- primary ::= STRING
{
tm.PushNode[$typeSTRING, 0];
LinkToSource[top];
};
26 => -- term ::= CONTROL
{
tm.PushNode[$control, 0];
LinkToSource[top];
};
27 => -- primary ::= ENV
{
tm.PushNode[$env, 0];
LinkToSource[top];
};
28 => -- primary ::= NIL
{
tm.PushNode[$nil, 0];
LinkToSource[top];
};
29 => -- primary ::= filename
ProcessFileName[NARROW[v[top].t]];
30 => -- primary ::= bracket
NULL;
31 => -- primary ::= primary . name
{
PushHashV[top+2];
tm.PushNode[$subscript, 2];
LinkToSource[top];
};
32 => -- bracket ::= group
NULL;
33 => -- bracket ::= [ decl ]
{
tm.PushNode[$decl, v[top+1].n];
tm.SetAttr[1, TRUE];
LinkToSource[top];
};
34 => -- bracket ::= [ binding ]
{
tm.PushNode[$bind, v[top+1].n];
LinkToSource[top];
};
35 => -- bracket ::= REC [ binding ]
{
tm.PushNode[$bindRec, v[top+2].n];
LinkToSource[top];
};
36 => -- bracket ::= ( exp )
NULL;
37 => -- group ::= [ expList ]
tm.PushNode[$group, v[top+1].n];
38 => -- group ::= [ ]
tm.PushNode[$group, 0];
39 => -- expList ::= exp
-- expListC ::= exp ,
-- expListS ::= exp ;
v[top].n ← 1;
40 => -- expList ::= expListC exp
-- expList ::= expListS exp
-- expListC ::= expListC exp ,
-- expListS ::= expListS exp ;
v[top].n ← v[top].n + 1;
41 => -- decl ::= declElem
-- declC ::= declElem ,
-- declS ::= declElem ;
v[top].n ← 1;
42 => -- decl ::= declC declElem
-- decl ::= declS declElem
-- declC ::= declC declElem ,
-- declS ::= declS declElem ;
v[top].n ← v[top].n + 1;
43 => -- declElem ::= name : exp
{
PushHashV[top];
tm.PushNode[$declElem, -2];
};
44 => -- binding ::= bindElem
-- bindingC ::= bindElem ,
-- bindingS ::= bindElem ;
v[top].n ← 1;
45 => -- binding ::= bindingC bindElem
-- binding ::= bindingS bindElem
-- bindingC ::= bindingC bindElem ,
-- bindingS ::= bindingS bindElem ;
v[top].n ← v[top].n + 1;
46 => -- 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];
};
47 => -- bindElem ::= declElem ~ exp
{
exp: Tree.Link ~ tm.PopTree;
tm.PushNode[$decl, 1]; tm.SetAttr[1, FALSE];
tm.PushTree[exp];
tm.PushNode[$bindElem, 2];
};
48 => -- 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];
};
49 => -- 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] ~ {
-- note: the scanner has guaranteed a well-formed file name
index: CARDINAL ← 1;
max: INT ~ name.Length;
s, t, n: INT;
GetNext: PROC RETURNS[start: INT] ~ {
ch: CHAR;
start ← index;
IF index >= max THEN RETURN;
index ← index + 1; -- always include next character
WHILE index < max DO
ch ← name.Fetch[index];
SELECT ch FROM
'/, '@, '! => EXIT;
'↑ => {index ← index + 1; EXIT};
ENDCASE => index ← index + 1;
ENDLOOP;
RETURN};
Empty: PROC[first, next: INT] RETURNS[BOOL] ~ INLINE {
RETURN[first >= next]};
PushPart: PROC[first, next: INT, strip: BOOL←TRUE] ~ {
start: INT ~ (IF strip THEN first+1 ELSE first);
part: Rope.ROPE ~ name.Substr[start, next-start];
IF (part.Length # 0 AND part.Fetch[part.Length-1] = '↑) THEN { -- disabled
tm.PushName[MakeName[part.Substr[0, part.Length-1]]];
tm.PushNode[$unQuote, 1]}
ELSE tm.PushText[part.Flatten[]]};
s ← GetNext[];
IF ~Empty[s, index] AND name.Fetch[s] = '/ THEN { -- host
PushPart[s, index, FALSE]; s ← GetNext[]}
ELSE tm.PushTree[Tree.null];
n ← s;
DO
t ← GetNext[];
IF Empty[t, index] OR name.Fetch[t] # '/ THEN EXIT;
n ← t;
ENDLOOP;
IF ~Empty[s, n] THEN PushPart[s, n, FALSE] -- directory(s)
ELSE tm.PushTree[Tree.null];
-- now is just a name.ext, name at n
PushPart[n, t, (name.Fetch[n]='/)]; -- short name
IF ~Empty[t, index] AND name.Fetch[t] = '! THEN PushPart[t, index] -- version
ELSE tm.PushTree[Tree.null];
-- host directory(s) name(s) version
tm.PushNode[$unitId, 4]; tm.SetExt[Tree.null]};
}.