-- Copyright (C) 1985, 1986 by Xerox Corporation. All rights reserved.
-- DO NOT CONVERT TO TIOGA FORMAT! (PSG requires the mesa-style comments)
-- last edit by Satterthwaite, May 30, 1986 11:10:35 am PDT
-- pgs [defs: CtoSParseTable, bcd: CtoSParseData, grammar: CtoS] ← CtoSTreeBuildImpl.pgs
-- output: new version of CtoSTreeBuildImpl.mesa, tables in CtoSParseData.bcd
-- interface on ParseTable.mesa
-- log on PGS.log, grammar on CtoS.grammar
-- errors on CtoSParseData.errlog
DIRECTORY
Atom: TYPE USING [GetPName, MakeAtom],
CtoSParseTable: TYPE ParseTable USING [ActionEntry, ProdDataRef, TSymbol],
CtoSP1: TYPE P1 USING [
ActionStack, LinkStack, TValue, ValueStack, nullTValue, nullValue, Substr],
Rope: TYPE USING [Concat],
SMTree: TYPE Tree USING [Link, null],
SMTypeCons: TYPE USING [
TM, Domain, MkArrow, MkArrow2, MkCrossReverse, MkCross2, MkDeclElem,
MkDeclReverse, MkInterfaceType, MkPair, MkStringType, MkUnitDecl, PushLink, Range],
SMOps: TYPE USING [MS];
CtoSTreeBuildImpl: CEDAR PROGRAM
IMPORTS Atom, CtoSP1, Rope, SMTypeCons
EXPORTS CtoSP1 ~ {
-- parse tree building
OPEN ParseTable~~CtoSParseTable, P1~~CtoSP1, Tree~~SMTree, TypeCons~~SMTypeCons;
-- local data base (supplied by parser)
v: P1.ValueStack;
l: P1.LinkStack;
q: P1.ActionStack;
prodData: ParseTable.ProdDataRef;
tm: TypeCons.TM;
-- 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;
tm ← [model.tm]};
-- error recovery (only)
TokenValue: PUBLIC PROC[s: ParseTable.TSymbol] RETURNS[P1.TValue] ~ {
RETURN[P1.nullTValue]};
-- interpretation routines
definitions: BOOL;
AtomList: TYPE ~ LIST OF ATOM;
AtomV: PROC[i: CARDINAL] RETURNS[ATOM] ~ {
RETURN[Atom.MakeAtom[P1.Substr[l[i], v[i].t]]]};
ConsAtom: PROC[i: CARDINAL, rest: AtomList] RETURNS[AtomList] ~ {
RETURN[CONS[AtomV[i], rest]]};
InstName: PROC[type: ATOM] RETURNS[ATOM] ~ {
RETURN[Atom.MakeAtom[(Atom.GetPName[type]).Concat["Impl"]]]};
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: CtoSParseData TYPE: ParseTable EXPORTS: SELF
-- GOAL: goal
--TERMINALS:
-- id num lnum flnum string lstring char atom
-- bracketed
-- , ; : => ←
-- = # < > <= >= ~
-- + - * / ↑ . @
-- RECORD POINTER REF VAR
-- LIST ARRAY DESCRIPTOR
-- PROCEDURE PROC PORT SIGNAL ERROR PROCESS
-- PROGRAM MONITOR DEFINITIONS ZONE RELATIVE LONG
-- TYPE FRAME TO ORDERED UNCOUNTED
-- BASE OF PACKED RETURNS SAFE UNSAFE
-- MONITORED MACHINE DEPENDENT
-- DIRECTORY IMPORTS EXPORTS SHARES LOCKS USING
-- PUBLIC PRIVATE CEDAR CHECKED TRUSTED UNCHECKED
-- READONLY CODE
-- ABS ALL AND APPLY CONS MAX MIN MOD
-- NOT OR ORD PRED LENGTH NEW START SUCC VAL
-- FORK JOIN LOOPHOLE NARROW ISTYPE SIZE
-- FIRST LAST NIL TRASH NULL IF THEN ELSE
-- WITH FROM FOR IN
-- ANY
-- } ENDCASE
-- { BEGIN SELECT
--ALIASES:
-- id tokenID
-- num tokenNUM
-- lnum tokenLNUM
-- flnum tokenFLNUM
-- string tokenSTR
-- lstring tokenLSTR
-- char tokenCHAR
-- atom tokenATOM
-- bracketed tokenBRACKET
-- - tokenMINUS
-- . tokenDOT
-- = tokenEQUAL
-- => tokenARROW
-- < tokenLESS
-- <= tokenLE
-- > tokenGREATER
-- >= tokenGE
-- # tokenNE
-- ~ tokenTILDE
-- . initialSymbol
--PRODUCTIONS:
-- goal ::= . module
NULL;
1 => -- module ::= directory identlist cedar proghead trusted checked begin
{
d: Tree.Link ~ tm.Domain[v[top+3].n];
r: Tree.Link ← tm.Range[v[top+3].n];
IF v[top+1].t = 1 THEN {
name: ATOM ~ NARROW[v[top+1].n];
t : Tree.Link ~
tm.MkCross2[
tm.MkUnitDecl[tm.MkDeclElem[name, tm.MkInterfaceType[name]]],
name];
r ← (IF r # Tree.null THEN tm.MkPair[r, t] ELSE t)}
ELSE
FOR ids: AtomList ← NARROW[v[top+1].n], ids.rest UNTIL ids = NIL DO
name: ATOM ~ ids.first;
t : Tree.Link ~
tm.MkCross2[
tm.MkUnitDecl[tm.MkDeclElem[name, tm.MkInterfaceType[name]]],
name];
r ← (IF r # Tree.null THEN tm.MkPair[r, t] ELSE t)
ENDLOOP;
tm.PushLink[tm.MkArrow2[v[top].n, tm.MkArrow[d, r]]];
v[top].n ← v[top+1].n ← v[top+3].n ← NIL;
};
2 => -- module ::= directory identlist cedar defhead begin
{
range: Tree.Link;
IF v[top+1].t # 1 THEN {
typeList: LIST OF Tree.Link ← NIL;
FOR ids: AtomList ← NARROW[v[top+1].n], ids.rest UNTIL ids = NIL DO
typeList ← CONS[tm.MkInterfaceType[ids.first], typeList];
ENDLOOP;
range ← tm.MkCrossReverse[typeList]}
ELSE range ← tm.MkInterfaceType[NARROW[v[top+1].n]];
tm.PushLink[tm.MkArrow[v[top].n, range]];
v[top].n ← v[top+1].n ← NIL
};
3 => -- begin ::= {
-- begin ::= BEGIN
NULL;
4 => -- includeitem ::= id : FROM string using
-- includeitem ::= id : TYPE using
-- includeitem ::= id using
{
name: ATOM ~ AtomV[top];
v[top].n ← tm.MkDeclElem[name, tm.MkInterfaceType[name]];
};
5 => -- includeitem ::= id : TYPE id using
v[top].n ← tm.MkDeclElem[AtomV[top], tm.MkInterfaceType[AtomV[top+3]]];
6 => -- cedar ::= CEDAR
-- cedar ::=
NULL;
7 => -- proghead ::= resident safe class arguments locks interface tilde public
{v[top].n ← v[top+5].n; v[top+5].n ← NIL};
8 => -- resident ::=
NULL;
9 => -- defhead ::= definitions locks imports shares tilde public
NULL;
10 => -- definitions ::= DEFINITIONS
definitions ← TRUE;
11 => -- locks ::= LOCKS primary lambda
-- lambda ::= USING ident typeexp
NULL;
12 => -- importitem ::= id
IF ~definitions THEN {
name: ATOM ~AtomV[top];
v[top].n ← tm.MkDeclElem[InstName[name], name]};
13 => -- importitem ::= id : id
IF ~definitions THEN v[top].n ← tm.MkDeclElem[AtomV[top], AtomV[top+2]];
14 => -- exportitem ::= id
IF ~definitions THEN v[top].n ← AtomV[top];
15 => -- public ::= PUBLIC
-- public ::= PRIVATE
-- public ::=
-- idlist' ::= id
NULL;
16 => -- identlist' ::= id :
-- identlist' ::= id position :
{v[top].n ← AtomV[top]; v[top].t ← 1};
17 => -- idlist' ::= id , idlist'
NULL;
18 => -- identlist' ::= id , identlist'
{
v[top].n ← ConsAtom[top,
(IF v[top+2].t = 1
THEN CONS[NARROW[v[top+2].n], NIL]
ELSE NARROW[v[top+2].n])];
v[top].t ← v[top+2].t + 1; v[top+2].n ← NIL;
};
19 => -- identlist' ::= id position , identlist'
{
v[top].n ← ConsAtom[top,
(IF v[top+3].t = 1
THEN CONS[NARROW[v[top+3].n], NIL]
ELSE NARROW[v[top+3].n])];
v[top].t ← v[top+3].t + 1; v[top+3].n ← NIL;
};
20 => -- position ::= bracketed
-- interval ::= bracketed
-- typeexp ::= id
-- range ::= id
-- typeid' ::= id . id
-- typeid' ::= typeid' . id
-- typeappl ::= typeappl . id
-- typeid ::= id id
-- typeid ::= id typeid
-- typeappl ::= id bracketed
-- typeappl ::= typeid bracketed
-- typeappl ::= typeappl bracketed
-- typecons ::= interval
-- range ::= id interval
-- range ::= typeid interval
-- typecons ::= dependent { elementlist }
-- ident ::= id position :
-- element ::= id bracketed
-- element ::= bracketed
-- typecons ::= dependent monitored RECORD reclist
-- typecons ::= ordered base pointertype
-- typecons ::= VAR typeexp
-- typecons ::= REF readonly typeexp
-- typecons ::= REF readonly ANY
-- typecons ::= REF
-- typecons ::= LIST OF readonly typeexp
-- typecons ::= packed ARRAY indextype OF typeexp
-- typecons ::= DESCRIPTOR FOR readonly typeexp
-- typecons ::= safe transfermode arguments
-- safe ::=
-- arglist ::= ANY
-- returnlist ::= RETURNS ANY
-- typecons ::= id RELATIVE typeexp
-- typecons ::= typeid RELATIVE typeexp
-- typecons ::= heap ZONE
-- typecons ::= LONG typeexp
-- typecons ::= FRAME bracketed
-- monitored ::= MONITORED
-- dependent ::= MACHINE DEPENDENT
-- dependent ::=
-- reclist ::= bracketed
-- reclist ::= NULL
-- pointertype ::= pointerprefix
-- pointertype ::= pointerprefix TO readonly typeexp
-- transfermode ::= PROCEDURE
-- transfermode ::= PROC
-- transfermode ::= PORT
-- transfermode ::= SIGNAL
-- transfermode ::= ERROR
-- transfermode ::= PROCESS
-- transfermode ::= PROGRAM
-- trusted ::=
-- binditem ::= exp
-- binditem ::= id : exp
-- binditem ::= id ~ ~ exp
-- caseexpitem ::= caselabel => exp
-- casetest ::= optrelation
-- casetest ::= exp
-- caselabel ::= ident typeexp
-- optexp ::= trash
-- exp ::= IF exp THEN exp ELSE exp
-- exp ::= casehead caseexplist ENDCASE => exp
-- exp ::= lhs ← exp
-- exp ::= ERROR
-- disjunct ::= disjunct OR conjunct
-- conjunct ::= conjunct AND negation
-- negation ::= ~ relation
-- negation ::= NOT relation
-- relation ::= sum optrelation
-- sum ::= sum addop product
-- product ::= product multop factor
-- optrelation ::= NOT relationtail
-- relationtail ::= IN range
-- relop ::= =
-- relop ::= #
-- relop ::= <
-- relop ::= <=
-- relop ::= >
-- relop ::= >=
-- addop ::= +
-- addop ::= -
-- multop ::= *
-- multop ::= /
-- multop ::= MOD
-- factor ::= addop primary
-- primary ::= prefixop bracketed
-- primary ::= VAL bracketed
-- primary ::= ALL bracketed
-- primary ::= new bracketed
-- primary ::= cons bracketed
-- primary ::= listcons bracketed
-- primary ::= NIL
-- primary ::= typeop bracketed
-- exp ::= transferop lhs
-- qualifier ::= . prefixop
-- qualifier ::= . typeop
-- primary ::= SIZE bracketed
-- qualifier ::= . SIZE
-- primary ::= ISTYPE bracketed
-- primary ::= @ lhs
-- primary ::= DESCRIPTOR bracketed
NULL;
21 => -- lhs ::= id
-- element ::= id
-- ident ::= id :
-- lhs ::= num
-- lhs ::= string
-- lhs ::= lnum
-- lhs ::= flnum
-- lhs ::= char
-- lhs ::= lstring
-- lhs ::= atom
-- lhs ::= NARROW bracketed
-- lhs ::= LOOPHOLE bracketed
-- lhs ::= APPLY bracketed
-- qualifier ::= bracketed
-- qualifier ::= . id
-- qualifier ::= ↑
-- transferop ::= SIGNAL
-- transferop ::= ERROR
-- transferop ::= START
-- transferop ::= JOIN
-- transferop ::= NEW
-- transferop ::= FORK
-- prefixop ::= LONG
-- prefixop ::= ABS
-- prefixop ::= PRED
-- prefixop ::= SUCC
-- prefixop ::= ORD
-- prefixop ::= MIN
-- prefixop ::= MAX
-- prefixop ::= BASE
-- prefixop ::= LENGTH
-- typeop ::= CODE
-- typeop ::= FIRST
-- typeop ::= LAST
-- typeop ::= NIL
NULL;
22 => -- directory ::= DIRECTORY ;
v[top].n ← tm.MkUnitDecl[OptionDecl[tm]];
23 => -- imports ::= IMPORTS
v[top].n ← (IF ~definitions THEN tm.MkDeclReverse[NIL] ELSE Tree.null);
24 => -- exports ::= EXPORTS
v[top].n ← Tree.null;
25 => -- new ::= NEW
-- cons ::= CONS
-- listcons ::= LIST
-- pointerprefix ::= POINTER
-- using ::= USING bracketed
-- elementlist ::=
-- caseexplist ::=
NULL;
26 => -- includelist ::= includeitem
v[top] ← [n~CONS[v[top].n, NIL], t~1];
27 => -- importlist ::= importitem
IF ~definitions THEN v[top].t ← 1;
28 => -- exportlist ::= exportitem
-- elementlist' ::= element
-- bindlist ::= binditem
-- caselabel' ::= casetest
-- caseexplist' ::= caseexpitem
NULL;
29 => -- includelist ::= includelist , includeitem
{v[top] ← [n~CONS[v[top+2].n, NARROW[v[top].n]], t~v[top].t+1]; v[top+2].n ← NIL};
30 => -- importlist ::= importlist , importitem
IF ~definitions THEN {
v[top].n ← CONS[
v[top+2].n,
IF v[top].t = 1 THEN CONS[v[top].n, NIL] ELSE NARROW[v[top].n]];
v[top].t ← v[top].t+1;
v[top+2].n ← NIL};
31 => -- exportlist ::= exportlist , exportitem
{v[top].n ← tm.MkPair[v[top].n, v[top+2].n]; v[top+2].n ← NIL};
32 => -- elementlist' ::= elementlist' , element
-- bindlist ::= bindlist , binditem
-- caselabel' ::= caselabel' , casetest
-- caseexplist' ::= caseexplist' , caseexpitem
-- idlist ::= idlist'
-- identlist ::= identlist'
-- caselabel ::= caselabel'
NULL;
33 => -- directory ::= DIRECTORY includelist ;
{
decls: LIST OF Tree.Link ~ CONS[OptionDecl[tm], NARROW[v[top+1].n]];
v[top].n ← tm.MkDeclReverse[decls];
v[top+1].n ← NIL;
};
34 => -- imports ::= IMPORTS importlist
IF ~definitions THEN {
v[top].n ← (IF v[top+1].t =1
THEN tm.MkUnitDecl[v[top+1].n]
ELSE tm.MkDeclReverse[NARROW[v[top+1].n]]);
v[top+1].n ← NIL}
ELSE v[top] ← P1.nullValue;
35 => -- exports ::= EXPORTS exportlist
{v[top].n ← v[top+1].n; v[top+1].n ← NIL};
36 => -- class ::= PROGRAM
definitions ← FALSE;
37 => -- safe ::= UNSAFE
-- casehead ::= SELECT exp FROM
NULL;
38 => -- class ::= MONITOR
definitions ← FALSE;
39 => -- packed ::= PACKED
-- safe ::= SAFE
-- readonly ::= READONLY
-- ordered ::= ORDERED
-- base ::= BASE
-- heap ::= UNCOUNTED
-- casehead ::= WITH binditem SELECT optexp FROM
-- packed ::=
-- readonly ::=
-- monitored ::=
-- ordered ::=
-- base ::=
-- heap ::=
NULL;
40 => -- interface ::= imports exports shares
{v[top].n ← tm.MkArrow[v[top].n, v[top+1].n]; v[top+1].n ← NIL};
41 => -- shares ::= SHARES idlist
-- tilde ::= ~
-- tilde ::= =
-- typeid ::= typeid'
-- typeexp ::= typeid
-- typeexp ::= typecons
-- typecons ::= typeappl
-- elementlist ::= elementlist'
-- pointerprefix ::= POINTER interval
-- indextype ::= typeexp
-- arguments ::= arglist returnlist
-- arglist ::= bracketed
-- returnlist ::= RETURNS bracketed
-- caseexplist ::= caseexplist'
-- caseexplist ::= caseexplist' ,
-- trash ::= TRASH
-- trash ::= NULL
-- optexp ::= exp
-- exp ::= disjunct
-- disjunct ::=C conjunct
-- conjunct ::=C negation
-- negation ::=C relation
-- relation ::= sum
-- optrelation ::= relationtail
-- relationtail ::= relop sum
-- range ::= interval
-- range ::= typeid
-- sum ::=C product
-- product ::=C factor
-- factor ::=C primary
-- primary ::= lhs
-- lhs ::= bracketed
-- lhs ::= lhs qualifier
-- new ::= lhs . NEW
-- cons ::= lhs . CONS
-- listcons ::= lhs . LIST
NULL;
42 => -- directory ::=
v[top].n ← tm.MkUnitDecl[OptionDecl[tm]];
43 => -- using ::=
-- locks ::=
-- lambda ::=
NULL;
44 => -- imports ::=
v[top].n ← (IF ~definitions THEN tm.MkDeclReverse[NIL] ELSE NIL);
45 => -- exports ::=
v[top].n ← NIL;
46 => -- shares ::=
-- arglist ::=
-- returnlist ::=
-- indextype ::=
-- optexp ::=
-- checked ::=
-- checked ::= CHECKED
-- checked ::= TRUSTED
-- checked ::= UNCHECKED
NULL;
-- error or unimplemented
ENDCASE => ERROR;
ENDLOOP};
OptionDecl: PROC[tm: TypeCons.TM] RETURNS[Tree.Link] ~ {
name: ATOM ~ Atom.MakeAtom["&options"];
RETURN [tm.MkDeclElem[name, tm.MkStringType]]};
}.