-- file CedarToSML.mesa rewritten by PGS, 1-Feb-83 14:41
-- last modified by Satterthwaite, February 1, 1983 2:41 pm
-- last modified by Donahue, 9-Dec-81 10:48:31
DIRECTORY
Dir: TYPE USING [AddToDep, ADepRecord, DepSeq],
MDModel: TYPE USING [],
ParseTable: TYPE USING [ActionEntry, ProdDataRef, TSymbol],
P1: TYPE USING [
ActionStack, LinkStack, Value, ValueStack, nullValue,
InputLoc, IdOfFirst, IdOfLock, IdOfRest];
CedarToSML: PROGRAM
IMPORTS Dir, P1
EXPORTS MDModel, P1 = {
-- converts Cedar source programs to SML values
-- local data base (supplied by parser)
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] = {
q ← qd; v ← vd; l ← ld; prodData ← pp};
-- error recovery (only)
TokenValue: PUBLIC PROC [s: ParseTable.TSymbol] RETURNS [P1.Value] = {
RETURN [P1.nullValue]};
-- state variables
port: {none, import, export} ← $none;
ProcessQueue: PUBLIC PROC [qI, top: CARDINAL] = {
t1, t2: Tree.Link;
FOR i: CARDINAL IN [0..qI) DO
top ← top-q[i].tag.pLength+1;
SELECT prodData[q[i].transition].rule FROM
-- basic tree building
0 => -- TABLE: CedarParseData TYPE: ParseTable EXPORTS: SELF
-- GOAL: goal
--TERMINALS:
-- id num lnum flnum string lstring char atom
-- , ; : .. => ←
-- = # < > <= >= ~
-- + - * / ↑ . @ ! '|
-- RECORD POINTER REF VAR
-- LIST ARRAY SEQUENCE 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 OVERLAID COMPUTED MACHINE DEPENDENT
-- DIRECTORY IMPORTS EXPORTS SHARES LOCKS USING
-- PUBLIC PRIVATE CEDAR CHECKED TRUSTED UNCHECKED
-- ENTRY INTERNAL INLINE 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 DECREASING IN
-- THROUGH UNTIL WHILE REPEAT FINISHED
-- RETURN EXIT LOOP GOTO GO
-- FREE WAIT RESTART NOTIFY BROADCAST STOP
-- RESUME REJECT CONTINUE RETRY TRANSFER STATE
-- OPEN ENABLE ANY EXITS
-- ) ] } END ENDLOOP ENDCASE
-- ( [ { BEGIN DO SELECT
--ALIASES:
-- id tokenID
-- num tokenNUM
-- lnum tokenLNUM
-- flnum tokenFLNUM
-- string tokenSTR
-- lstring tokenLSTR
-- char tokenCHAR
-- atom tokenATOM
-- - tokenMINUS
-- . tokenDOT
-- .. tokenDOTS
-- = tokenEQUAL
-- => tokenARROW
-- < tokenLESS
-- <= tokenLE
-- > tokenGREATER
-- >= tokenGE
-- # tokenNE
-- ~ tokenTILDE
-- . initialSymbol
--PRODUCTIONS:
-- goal ::= . module
NULL;
1 => -- module ::= directory identlist cedar proghead trusted checked begin
{Enter[moduleName: v[top+1].first]};
2 => -- module ::= directory identlist cedar defhead begin
{Enter[moduleName: v[top+1].first]};
3 => -- begin ::= {
-- begin ::= BEGIN
NULL;
4 => -- includeitem ::= id : FROM string using
-- includeitem ::= id : TYPE using
-- includeitem ::= id using
{Enter[relation: $directory, formal: v[top], typeId: v[top]]};
5 => -- includeitem ::= id : TYPE id using
{Enter[relation: $directory, formal: v[top], typeId: v[top+2]]};
6 => -- cedar ::= CEDAR
-- cedar ::=
{port ← $import};
7 => -- proghead ::= resident safe class arguments locks interface tilde public
NULL;
8 => -- resident ::=
NULL;
9 => -- defhead ::= definitions locks imports shares tilde public
NULL;
10 => -- definitions ::= DEFINITIONS
NULL;
11 => -- locks ::= LOCKS primary lambda
-- lambda ::= USING ident typeexp
NULL;
12 => -- moduleitem ::= id
{Enter[relation: port, formal: v[top], type: Copy[v[top]]};
13 => -- moduleitem ::= id : id
{Enter[relation: port, formal: v[top], type: v[top+2]};
14 => -- declaration ::= identlist public entry readonly typeexp initialization
-- declaration ::= identlist public TYPE tilde public typeexp default
-- declaration ::= identlist public TYPE optsize
{FreeString[v[top]]};
15 => -- public ::= PUBLIC
-- public ::= PRIVATE
-- procaccess ::=
-- public ::=
-- entry ::= ENTRY
-- entry ::= INTERNAL
-- entry ::=
NULL;
16 => -- idlist' ::= id
{FreeString[v[top]]};
17 => -- identlist' ::= id :
-- identlist' ::= id position :
NULL;
18 => -- idlist' ::= id , idlist'
{FreeString[v[top]]};
19 => -- identlist' ::= id , identlist'
{FreeString[v[top+2]]};
20 => -- identlist' ::= id position , identlist'
{FreeString[v[top+3]]};
21 => -- position ::= ( exp optbits )
-- optbits ::= : bounds
-- interval ::= [ bounds ]
-- interval ::= [ bounds )
-- interval ::= ( bounds ]
-- interval ::= ( bounds )
NULL;
22 => -- typeexp ::= id
-- range ::= id
{FreeString[v[top]]};
23 => -- typeid' ::= id . id
{FreeString[v[top]]; FreeString[v[top+2]]};
24 => -- typeid' ::= typeid' . id
-- typeappl ::= typeappl . id
{FreeString[v[top+2]]};
25 => -- typeid ::= id id
{FreeString[v[top]]; FreeString[v[top+1]]};
26 => -- typeid ::= id typeid
-- typeappl ::= id length
{FreeString[v[top]]};
27 => -- typeappl ::= typeid length
-- typeappl ::= typeappl length
-- typecons ::= interval
NULL;
28 => -- typecons ::= id interval
-- range ::= id interval
{FreeString[v[top]]};
29 => -- typecons ::= typeid interval
-- range ::= typeid interval
-- typecons ::= dependent { elementlist }
NULL;
30 => -- ident ::= id position :
-- element ::= id ( exp )
{FreeString[v[top]]};
31 => -- element ::= ( exp )
-- 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
{FreeString[v[top]]};
32 => -- typecons ::= typeid RELATIVE typeexp
-- typecons ::= heap ZONE
-- typecons ::= LONG typeexp
-- typecons ::= FRAME [ id ]
{FreeString[v[top+2]]};
33 => -- monitored ::= MONITORED
-- dependent ::= MACHINE DEPENDENT
-- dependent ::=
-- reclist ::= [ ]
-- reclist ::= NULL
-- reclist ::= [ pairlist ]
-- reclist ::= [ typelist ]
-- reclist ::= [ pairlist , variantpair ]
-- reclist ::= [ variantpart default ]
NULL;
34 => -- pairitem ::= identlist public typeexp default
-- variantpair ::= identlist public variantpart default
{FreeString[v[top]]};
35 => -- defaultopt ::= TRASH
-- defaultopt ::= NULL
-- defaultopt ::= exp '| TRASH
-- defaultopt ::= exp '| NULL
-- variantpart ::= SELECT vcasehead FROM variantlist ENDCASE
-- variantpart ::= SELECT vcasehead FROM variantlist , ENDCASE
-- variantpart ::= packed SEQUENCE vcasehead OF typeexp
-- vcasehead ::= ident public tagtype
-- vcasehead ::= COMPUTED tagtype
-- vcasehead ::= OVERLAID tagtype
-- tagtype ::= *
-- variantitem ::= idlist => reclist
-- typelist ::= typecons default
-- typelist ::= typeid default
NULL;
36 => -- typelist ::= id
-- typelist ::= id ← defaultopt
{FreeString[v[top]]};
37 => -- typelist ::= typecons default , typelist
-- typelist ::= typeid default , typelist
-- typelist ::= id , typelist
-- typelist ::= id ← defaultopt , typelist
{FreeString[v[top]]};
38 => -- pointertype ::= pointerprefix
-- pointertype ::= pointerprefix TO readonly typeexp
-- transfermode ::= PROCEDURE
-- transfermode ::= PROC
-- transfermode ::= PORT
-- transfermode ::= SIGNAL
-- transfermode ::= ERROR
-- transfermode ::= PROCESS
-- transfermode ::= PROGRAM
-- initialization ::=
-- initvalue ::= procaccess trusted checked inline block
-- initvalue ::= CODE
-- initvalue ::= procaccess trusted checked MACHINE CODE BEGIN codelist END
-- initvalue ::= procaccess trusted checked MACHINE CODE { codelist }
-- trusted ::=
-- codelist ::= orderlist
-- codelist ::= codelist ; orderlist
-- statement ::= lhs
-- statement ::= lhs ← exp
-- statement ::= [ explist ] ← exp
-- statement ::= trusted checked block
-- statement ::= IF exp THEN statement elsepart
-- statement ::= casehead casestmtlist ENDCASE otherpart
-- statement ::= forclause dotest DO scope doexit ENDLOOP
-- statement ::= EXIT
-- statement ::= LOOP
NULL;
39 => -- statement ::= GOTO id
{FreeString[v[top+1]]};
40 => -- statement ::= GO TO id
{FreeString[v[top+2]]};
41 => -- statement ::= RETURN optargs
-- statement ::= transfer lhs
-- statement ::= free [ exp optcatch ]
-- statement ::= WAIT lhs
-- statement ::= ERROR
-- statement ::= STOP
-- statement ::= NULL
-- statement ::= RESUME optargs
-- statement ::= REJECT
-- statement ::= CONTINUE
-- statement ::= RETRY
-- statement ::= lhs ← STATE
-- statement ::= STATE ← exp
-- block ::= BEGIN scope exits END
-- block ::= { scope exits }
-- scope ::= open enables statementlist
-- scope ::= open enables declist ; statementlist
-- binditem ::= exp
NULL;
42 => -- binditem ::= id : exp
-- binditem ::= id ~ ~ exp
{FreeString[v[top+1]]};
43 => -- exits ::= EXITS exitlist
-- casestmtitem ::= caselabel => statement
-- caseexpitem ::= caselabel => exp
-- exititem ::= idlist => statement
-- casetest ::= optrelation
-- casetest ::= exp
-- caselabel ::= ident typeexp
-- controlid ::= ident typeexp
-- forclause ::= FOR controlid ← exp , exp
-- forclause ::= FOR controlid direction IN range
-- forclause ::= THROUGH range
-- direction ::= DECREASING
-- direction ::=
-- dotest ::= UNTIL exp
-- doexit ::=
-- doexit ::= REPEAT exitlist
-- doexit ::= REPEAT exitlist FINISHED => statement
-- doexit ::= REPEAT exitlist FINISHED => statement ;
-- enables ::= ENABLE catchcase ;
-- enables ::= ENABLE catchany ;
-- enables ::= ENABLE BEGIN catchlist END ;
-- enables ::= ENABLE { catchlist } ;
-- catchlist ::= catchhead
-- catchlist ::= catchhead catchcase
-- catchcase ::= lhslist => statement
-- optargs ::= [ explist ]
-- optargs ::=
-- transfer ::= SIGNAL
-- transfer ::= ERROR
-- transfer ::= RETURN WITH ERROR
-- transfer ::= START
-- transfer ::= RESTART
-- transfer ::= JOIN
-- transfer ::= NOTIFY
-- transfer ::= BROADCAST
-- transfer ::= TRANSFER WITH
-- transfer ::= RETURN WITH
NULL;
44 => -- keyitem ::= id ~ optexp
-- keyitem ::= id : optexp
{FreeString[v[top+1]]};
45 => -- optexp ::= TRASH
-- optexp ::= NULL
-- initvalue ::= TRASH
-- initvalue ::= NULL
-- exp ::= transferop lhs
-- exp ::= IF exp THEN exp ELSE exp
-- exp ::= casehead caseexplist ENDCASE => exp
-- exp ::= lhs ← exp
-- exp ::= [ explist ] ← 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 ::= num
-- primary ::= lnum
-- primary ::= flnum
-- primary ::= string
-- primary ::= lstring
-- primary ::= atom
-- primary ::= NIL
-- primary ::= [ explist ]
-- primary ::= prefixop [ orderlist ]
-- primary ::= VAL [ orderlist ]
-- primary ::= ALL [ orderlist ]
-- primary ::= new [ typeexp initialization optcatch ]
-- primary ::= cons [ explist optcatch ]
-- primary ::= listcons [ explist ]
-- primary ::= typeop [ typeexp ]
-- qualifier ::= . prefixop
-- qualifier ::= . typeop
-- primary ::= SIZE [ typeexp ]
-- qualifier ::= . SIZE
-- primary ::= SIZE [ typeexp , exp ]
-- primary ::= ISTYPE [ exp , typeexp ]
-- primary ::= @ lhs
-- primary ::= DESCRIPTOR [ desclist ]
NULL;
46 => -- lhs ::= id
-- element ::= id
-- ident ::= id :
-- controlid ::= id
{FreeString[v[top+1]]};
47 => -- lhs ::= char
-- lhs ::= NARROW [ exp opttype optcatch ]
-- lhs ::= LOOPHOLE [ exp opttype ]
-- lhs ::= APPLY [ exp , exp optcatch ]
-- qualifier ::= [ explist optcatch ]
NULL;
48 => -- qualifier ::= . id
{FreeString[v[top+1]]};
49 => -- qualifier ::= ↑
-- optcatch ::= ! catchlist
-- 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
-- desclist ::= exp , exp opttype
NULL;
50 => -- directory ::= DIRECTORY ;
NULL;
51 => -- imports ::= IMPORTS
{port ← $exports};
52 => -- exports ::= EXPORTS
NULL;
53 => -- fieldlist ::= [ ]
-- new ::= NEW
-- free ::= FREE
-- cons ::= CONS
-- listcons ::= LIST
-- pointerprefix ::= POINTER
-- using ::= USING [ ]
-- defaultopt ::=
-- elementlist ::=
-- statementlist ::=
-- casestmtlist ::=
-- exitlist ::=
-- catchhead ::=
-- caseexplist ::=
-- includelist ::= includeitem
-- modulelist ::= moduleitem
-- declist ::= declaration
-- pairlist ::= pairitem
-- elementlist' ::= element
-- variantlist ::= variantitem
-- bindlist ::= binditem
-- statementlist' ::= statement
-- casestmtlist' ::= casestmtitem
-- caselabel' ::= casetest
-- exitlist' ::= exititem
-- lhslist ::= lhs
-- orderlist ::= optexp
-- keylist ::= keyitem
-- caseexplist' ::= caseexpitem
-- includelist ::= includelist , includeitem
-- modulelist ::= modulelist , moduleitem
-- declist ::= declist ; declaration
-- pairlist ::= pairlist , pairitem
-- elementlist' ::= elementlist' , element
-- variantlist ::= variantlist , variantitem
-- bindlist ::= bindlist , binditem
-- statementlist' ::= statementlist' ; statement
-- casestmtlist' ::= casestmtlist' ; casestmtitem
-- caselabel' ::= caselabel' , casetest
-- exitlist' ::= exitlist' ; exititem
-- catchhead ::= catchhead catchcase ;
-- lhslist ::= lhslist , lhs
-- orderlist ::= orderlist , optexp
-- keylist ::= keylist , keyitem
-- caseexplist' ::= caseexplist' , caseexpitem
-- idlist ::= idlist'
-- identlist ::= identlist'
-- explist ::= orderlist
-- explist ::= keylist
-- caselabel ::= caselabel'
NULL;
54 => -- directory ::= DIRECTORY includelist ;
NULL;
55 => -- imports ::= IMPORTS modulelist
{port ← $exports};
56 => -- exports ::= EXPORTS modulelist
NULL;
57 => -- open ::= OPEN bindlist ;
-- fieldlist ::= [ pairlist ]
-- fieldlist ::= [ typelist ]
-- class ::= PROGRAM
-- safe ::= UNSAFE
-- initialization ::= ← initvalue
-- casehead ::= SELECT exp FROM
-- class ::= MONITOR
-- packed ::= PACKED
-- safe ::= SAFE
-- readonly ::= READONLY
-- reclist ::= [ variantpair ]
-- ordered ::= ORDERED
-- base ::= BASE
-- heap ::= UNCOUNTED
-- initialization ::= tilde initvalue
-- inline ::= INLINE
-- optargs ::= lhs
-- casehead ::= WITH binditem SELECT optexp FROM
-- packed ::=
-- readonly ::=
-- monitored ::=
-- ordered ::=
-- base ::=
-- heap ::=
-- inline ::=
-- enables ::=
-- exits ::=
-- optcatch ::=
-- using ::= USING [ idlist ]
NULL;
58 => -- interface ::= imports exports shares
NULL;
59 => -- shares ::= SHARES idlist
-- tilde ::= ~
-- tilde ::= =
-- typeid ::= typeid'
-- typeexp ::= typeid
-- typeexp ::= typecons
-- typecons ::= typeappl
-- optsize ::= [ exp ]
-- elementlist ::= elementlist'
-- length ::= [ exp ]
-- default ::= ← defaultopt
-- defaultopt ::= exp
-- tagtype ::= typeexp
-- pointerprefix ::= POINTER interval
-- indextype ::= typeexp
-- arguments ::= arglist returnlist
-- arglist ::= fieldlist
-- returnlist ::= RETURNS fieldlist
-- initvalue ::= exp
-- elsepart ::= ELSE statement
-- otherpart ::= => statement
-- dotest ::= WHILE exp
-- catchany ::= ANY => statement
-- catchlist ::= catchhead catchany
-- catchlist ::= catchhead catchany ;
-- statementlist ::= statementlist'
-- statementlist ::= statementlist' ;
-- casestmtlist ::= casestmtlist'
-- casestmtlist ::= casestmtlist' ;
-- exitlist ::= exitlist'
-- exitlist ::= exitlist' ;
-- caseexplist ::= caseexplist'
-- caseexplist ::= caseexplist' ,
-- optexp ::= exp
-- exp ::= disjunct
-- disjunct ::=C conjunct
-- conjunct ::=C negation
-- negation ::=C relation
-- relation ::= sum
-- optrelation ::= relationtail
-- relationtail ::= relop sum
-- range ::= interval
-- range ::= typeid
-- bounds ::= exp .. exp
-- sum ::=C product
-- product ::=C factor
-- factor ::=C primary
-- primary ::= lhs
-- desclist ::= exp
-- lhs ::= ( exp )
-- lhs ::= lhs qualifier
-- new ::= lhs . NEW
-- free ::= lhs . FREE
-- cons ::= lhs . CONS
-- listcons ::= lhs . LIST
-- opttype ::= , typeexp
NULL;
60 => -- directory ::=
NULL;
61 => -- using ::=
-- locks ::=
-- lambda ::=
NULL;
62 => -- imports ::=
{port ← $exports};
63 =>-- exports ::=
NULL;
64 => -- shares ::=
-- optsize ::=
-- optbits ::=
-- default ::=
-- open ::=
-- arglist ::=
-- returnlist ::=
-- indextype ::=
-- elsepart ::=
-- otherpart ::=
-- forclause ::=
-- dotest ::=
-- optexp ::=
-- opttype ::=
-- checked ::=
-- checked ::= CHECKED
-- checked ::= TRUSTED
-- checked ::= UNCHECKED
NULL;
-- error or unimplemented
ENDCASE => ERROR;
ENDLOOP};
}.