-- file MDRulesImpl.mesa rewritten by PGS, 31-Jan-83 11:08
-- last edit by Schmidt, January 6, 1983 2:00 pm
-- last edit by Satterthwaite, January 31, 1983 11:08 am
-- Pilot 6.0/ Mesa 7.0
-- ParseTable becomes ModelParseTable
-- Note this module can be called recusively by nested instances
-- of parsers
DIRECTORY
CWF: TYPE USING [WF0, WF1],
Dir: TYPE USING [FileInfo],
FileStream: TYPE USING [SetIndex],
LongString: TYPE USING [AppendChar, EquivalentString],
MDModel: TYPE USING [
AddToEndOfList, APPLSymbol, CheckNotNil, CkType, FreeStringsOf,
GetFileInfo, GetSrcCreate, HasAStringName, LETSymbol, LISTSymbol, LocForSp,
LOCSymbol, MergeIntoList, MODELSymbol, NarrowToAPPL, NarrowToLOC,
NarrowToSTRING, NarrowToTYPE, NewSymAPPL, NewSymLET, NewSymLOC,
NewSymMODEL, NewSymOPEN, NewSymPROC, NewSymSTRING, NewSymTYPE,
OPENSymbol, PROCSymbol, PushInputStream, STRINGSymbol, Sym, Symbol, SymbolSeq,
TYPESymbol, ZeroOut],
ModelParseTable: TYPE USING [ProdDataRef, tokenID, TSymbol],
MoveFiles: TYPE USING [BringOverRemoteFile],
P1: FROM "ModelParseDefs" USING [
ActionStack, InvokeParser, LinkStack, Value, ValueStack],
Stream: TYPE USING [Handle],
String: TYPE USING [AppendChar, AppendString],
Subr: TYPE USING [
CopyString, debugflg, EndsIn, FileError, FreeString, GetLine, LongZone,
NewStream, Prefix, Read, strcpy, SubStrCopy, TTYProcs],
TypeScript: TYPE USING[TS];
MDRulesImpl: PROGRAM
IMPORTS CWF, FileStream, LongString, MDModel, MoveFiles, P1, String, Subr
EXPORTS P1, MDModel = {
-- MDS usage!!!
parseRoot: MDModel.LISTSymbol ← NIL;
symbolseq: MDModel.SymbolSeq;
contseq: ContSeq;
-- these four variables are saved and restored by recursive calls to the parser
v: P1.ValueStack;
l: P1.LinkStack;
q: P1.ActionStack;
proddata: ModelParseTable.ProdDataRef;
--
makethismodel: BOOL;
officialwindow: Subr.TTYProcs ← NIL;
officialTypeScript: TypeScript.TS ← NIL;
-- endof MDS usage!!!
MAXCONT: NAT = 500;
ContSeq: TYPE = LONG POINTER TO ContSeqRecord;
ContSeqRecord: TYPE = RECORD[
size: CARDINAL ← 0,
body: SEQUENCE maxsize: CARDINAL OF ContRecord
];
ContRecord: TYPE = RECORD[
ptr: MDModel.Symbol ← NIL,
isopen: BOOL ← FALSE,
block: BOOL ← FALSE
];
-- ptr is either a list of terms or a single element within this scope
-- an entry that is "block" stops the context scan
-- the entry is not included in the smaller scope
-- this is called ONCE from MDParseImpl
ParseInit: PUBLIC PROC[
ss: MDModel.SymbolSeq, make: BOOL,
typeScript: TypeScript.TS, ttywindow: Subr.TTYProcs] = {
longzone: UNCOUNTED ZONE = Subr.LongZone[];
symbolseq ← ss;
contseq ← longzone.NEW[ContSeqRecord[MAXCONT]];
symbolseq.controlv ← MDModel.NewSymTYPE[symbolseq];
symbolseq.controlv.defn ← TRUE;
symbolseq.controlv.typesym ← Subr.CopyString["CONTROL"L];
symbolseq.controlv.typeName ← Subr.CopyString["CONTROL"L];
makethismodel ← make;
officialwindow ← ttywindow;
officialTypeScript ← typeScript};
AssignDescriptors: PUBLIC PROC [
qd: P1.ActionStack, vd: P1.ValueStack, ld: P1.LinkStack, pp: ModelParseTable.ProdDataRef] = {
q ← qd; v ← LOOPHOLE[vd]; l ← ld; proddata ← pp};
-- the interpretation rules
LinkToSource: PROC [index: CARDINAL] = {};
-- links: BOOL;
codelinks: BOOL = TRUE;
framelinks: BOOL = FALSE;
-- this is called by the parser
ProcessQueue: PUBLIC PROC [qI, top: CARDINAL] =
BEGIN
-- save: CARDINAL;
vTop: P1.Value;
FOR i: CARDINAL IN [0 .. qI)
DO
top ← top-q[i].tag.pLength+1; vTop ← v[top];
SELECT proddata[q[i].transition].rule FROM
0 => --
-- TABLE: ModelParseData
-- TYPE: ModelParseTable
-- EXPORTS: SELF
-- GOAL: goal
-- TERMINALS:
-- id str , :
-- ; ]
-- [ . ( ) *
-- = ~ ! filename
-- number
-- LET OPEN FRAMEPTRTYPE
-- TYPE STRING
-- PLUS THEN PROC RETURNS
--
-- ALIASES:
-- id tokenID
-- str tokenSTR
-- number tokenNUM
-- filename tokenFILENAME
-- . initialSymbol
-- PRODUCTIONS:
-- goal ::= . source
NULL;
1 => -- source ::= first exp
{
parseRoot ← MakeProperList[v[top+1].r];
IF Subr.debugflg THEN CWF.WF0["source reduction\n"L];
-- pop off the last ]
Pop[];
-- IF contseq.size = 1 THEN {
-- pop off CONTROL context
-- Pop[];
-- };
};
2 => -- first ::=
{
-- This context is the first one available to the model
Push[val~NIL, isopen~FALSE, isqualified~FALSE];
};
3 => -- exp ::= explist part
-- exp ::= expseq part
-- explist ::= explist part ,
-- expseq ::= expseq part ;
{
old: MDModel.Symbol = vTop.r;
c: CARDINAL;
IF v[top+1].r ~= NIL THEN -- not syntax error
vTop ← [ref[MDModel.MergeIntoList[vTop.r, v[top+1].r,
symbolseq, normal]]];
-- skip any OPEN's that may have been added
-- during the insertion of this scope
IF contseq.size = 0 THEN ERROR;
c ← contseq.size-1;
WHILE c > 0 AND contseq[c].isopen DO
c ← c - 1;
ENDLOOP;
IF old ~= NIL AND contseq[c].ptr = old THEN {
contseq[c].ptr ← vTop.r;
contseq[c].ptr.qualified ← old.qualified;
};
-- CWF.WF1["list is:\n%z\n"L, vTop.r];
};
4 => -- exp ::= part
-- explist ::= part ,
-- expseq ::= part ;
{
c: CARDINAL;
-- this is the first element in a scope
IF contseq.size = 0 THEN ERROR;
c ← contseq.size-1;
WHILE c > 0 AND contseq[c].isopen DO
c ← c - 1;
ENDLOOP;
IF contseq[c].ptr = NIL THEN
contseq[c].ptr ← vTop.r;
};
5 => -- part ::= id : call
{
sym: MDModel.Symbol = v[top+2].r;
str: LONG STRING ← vTop.r;
sp: MDModel.Symbol = HandleContAPPL[str, contseq, symbolseq, TRUE];
MDModel.CheckNotNil[sp];
-- IF sp.defn THEN CWF.WF1["sym %s already defn\n"L,
-- MDModel.Sym[sp]];
MergeTypes[sto~sp,sfrom~sym];
sp.defn ← TRUE;
vTop ← [ref[sp]];
Subr.FreeString[str];
-- CWF.WF1["part is:\n%z\n"L, sp];
};
6 => -- part ::= : call
{
sp: MDModel.Symbol;
str: LONG STRING;
stemp: STRING ← [40];
sym: MDModel.Symbol = v[top+1].r;
sploc: MDModel.LOCSymbol ← MDModel.LocForSp[sym];
IF sploc = NIL THEN {
CWF.WF0["Error - no principal part specified.\n"L];
RETURN;
};
MDModel.CkType[sploc, $typeLOC];
IF sploc.prinpart = 0 THEN str ← sploc.tail
ELSE {
i: CARDINAL ← sploc.prinpart;
WHILE i < sploc.sext.length AND sploc.sext[i] ~= '! DO
String.AppendChar[stemp, sploc.sext[i]];
i ← i + 1;
ENDLOOP;
str ← stemp;
};
sp ← HandleContAPPL[str, contseq, symbolseq, TRUE];
MDModel.CheckNotNil[sp];
-- IF sp.defn THEN CWF.WF1["sym %s already defn\n"L,
-- MDModel.Sym[sp]];
MergeTypes[sto~sp,sfrom~sym];
sp.defn ← TRUE;
vTop ← [ref[sp]];
-- now we fix the IdImpl problem:
-- what is its type?
WITH sp SELECT FROM
spt: MDModel.APPLSymbol => {
stemp: STRING ← [100];
Subr.strcpy[stemp, spt.applsym];
stemp.length ← stemp.length - 4;
spt.appltype ← HandleContTYPE[stemp, contseq, symbolseq, FALSE];
}
ENDCASE => MDModel.CkType[sp, $typeTYPE];
-- note this doesn't work for
-- :@idImpl[];
};
7 => -- part ::= call
NULL;
8 => -- part ::= * : id
{
-- short for "idImpl: id"
sptype, spappl: MDModel.Symbol;
str: STRING ← [30];
Subr.strcpy[str, v[top+2].r];
Subr.FreeString[v[top+2].r];
sptype ← HandleContTYPE[str, contseq,symbolseq, FALSE];
String.AppendString[str, "Impl"L];
spappl ← HandleContAPPL[str, contseq,symbolseq, TRUE];
-- IF spappl.defn THEN
-- CWF.WF1["sym %s already defn\n"L,MDModel.Sym[spappl]];
MergeTypes[sto~spappl, sfrom~sptype];
spappl.defn ← TRUE;
vTop ← [ref[spappl]];
};
9 => -- part ::= id : *
{
-- short for "id: TYPE, idImpl: id"
sp, sptype: MDModel.Symbol;
sym: MDModel.LISTSymbol;
str: STRING ← [30];
Subr.strcpy[str, vTop.r];
Subr.FreeString[vTop.r];
sptype ← HandleContTYPE[str, contseq, symbolseq, TRUE];
String.AppendString[str, "Impl"L];
sp ← HandleContAPPL[str, contseq, symbolseq, TRUE];
WITH sp SELECT FROM
spappl: MDModel.APPLSymbol =>
spappl.appltype ← sptype;
ENDCASE =>
CWF.WF1["Error -- %s should be an interface record.\n"L, str];
sym ← MDModel.AddToEndOfList[NIL, sptype, normal, symbolseq];
sym ← MDModel.AddToEndOfList[sym, sp, normal, symbolseq];
vTop ← [ref[sym]];
};
10 => -- part ::= id *
{
-- short for "id, idImpl"
sid1, sid2: MDModel.Symbol;
sym: MDModel.LISTSymbol;
str: STRING ← [30];
Subr.strcpy[str, vTop.r];
Subr.FreeString[vTop.r];
[sid1] ← LookupInContext[str, contseq];
String.AppendString[str, "Impl"L];
[sid2] ← LookupInContext[str, contseq];
sym ← MDModel.AddToEndOfList[NIL, sid1, normal, symbolseq];
sym ← MDModel.AddToEndOfList[sym, sid2, normal, symbolseq];
vTop ← [ref[sym]];
};
11 => -- part ::= LET group
{
splet: MDModel.LETSymbol = MDModel.NewSymLET[symbolseq];
splet.letgrp ← MakeProperList[v[top+1].r];
vTop ← [ref[splet]];
-- this makes the variables defined in group accessible
-- to stmts below
Push[val~splet.letgrp, isopen~TRUE, isqualified~FALSE]; -- OPENS the Let group
-- now set LET parent
FOR splist: MDModel.LISTSymbol ← splet.letgrp, splist.rest
WHILE splist ~= NIL DO
FillInLetParent[splist.first, splet];
ENDLOOP;
};
12 => -- part ::= LET group bindop call
{
splet: MDModel.LETSymbol = MDModel.NewSymLET[symbolseq];
splet.letgrp ← MakeProperList[v[top+1].r];
splet.letval ← v[top+3].r;
vTop ← [ref[splet]];
-- this makes the variables defined in group accessible
-- to stmts below
Push[val~splet.letgrp, isopen~TRUE, isqualified~FALSE]; -- OPENS the Let group
-- now set LET parent
FOR splist: MDModel.LISTSymbol ← splet.letgrp, splist.rest
WHILE splist ~= NIL DO
FillInLetParent[splist.first, splet];
ENDLOOP;
};
13 => -- part ::= OPEN call
{
sp: MDModel.OPENSymbol = MDModel.NewSymOPEN[symbolseq];
sp.open ← v[top+1].r;
vTop ← [ref[sp]];
-- if call is a filename the just process include file
IF sp.open ~= NIL AND sp.open.stype = $typeLOC THEN {
sploc: MDModel.LOCSymbol = MDModel.NarrowToLOC[sp.open];
IF sploc.nestedmodel ~= NIL THEN
Push[val~sploc.nestedmodel.model, isopen~TRUE, isqualified~FALSE];
}
ELSE IF sp.open ~= NIL THEN {
-- this is the qualified case, an OPEN of a variable
Push[val~MDModel.NarrowToAPPL[sp.open].appltype, isopen~TRUE, isqualified~TRUE];
};
};
14 => -- call ::= primary
NULL;
15 => -- call ::= primary group
{
sp: MDModel.Symbol = vTop.r;
splist: MDModel.Symbol = v[top+1].r;
IF sp = NIL THEN RETURN; -- syntax error
WITH sp SELECT FROM
spt: MDModel.LOCSymbol => {
spl: MDModel.LISTSymbol ← (spt.parmlist ← MakeProperList[splist]);
-- this makes any variables mentioned in "group"
-- that are not yet defined accessible
-- to scopes below this, so they may be defined there:
Push[val~spl, isopen~TRUE, isqualified~FALSE];
-- why doesn't this work?
-- WHILE spl ~= NIL DO
-- IF ~spl.first.defn THEN
-- Push[val~spl.first, isopen~TRUE, isqualified~FALSE];
-- spl ← spl.rest;
-- ENDLOOP;
};
spt: MDModel.PROCSymbol =>
spt.procval ← MakeProperList[splist];
ENDCASE => NULL;
};
16 => -- call ::= primary bindop call
{
sp: MDModel.Symbol = vTop.r;
spval: MDModel.Symbol = v[top+2].r;
IF sp = NIL THEN RETURN; -- syntax error
IF sp.stype = $typeTYPE
AND MDModel.NarrowToTYPE[sp].typesym = NIL THEN {
-- is being declared?
MDModel.NarrowToTYPE[sp].typeval ← spval;
vTop ← [ref[sp]];
}
ELSE {
spa: MDModel.APPLSymbol = MDModel.NewSymAPPL[symbolseq];
spa.appltype ← vTop.r;
spa.applval ← spval;
vTop ← [ref[spa]];
};
-- this makes anything defined in the PLUS or THEN list
-- available. This might happen if the variables are used
-- before they are defined.
WITH spval SELECT FROM
splist: MDModel.LISTSymbol =>
Push[val~splist, isopen~TRUE, isqualified~FALSE];
ENDCASE => NULL;
};
17 => -- call ::= primary PLUS call
{
vTop ← [ref[MDModel.MergeIntoList[vTop.r, v[top+2].r, symbolseq, plus]]];
};
18 => -- call ::= primary THEN call
{
vTop ← [ref[MDModel.MergeIntoList[vTop.r, v[top+2].r, symbolseq, then]]];
};
19 => -- primary ::= subprimary
NULL;
20 => -- subprimary ::= str
{
str: LONG STRING ← vTop.r;
sp: MDModel.STRINGSymbol = MDModel.NewSymSTRING[symbolseq];
IF str ~= NIL THEN {
sp.strval ← Subr.CopyString[str];
Subr.FreeString[str];
};
vTop ← [ref[sp]];
};
21 => -- subprimary ::= id
{
str: LONG STRING ← vTop.r;
IF str ~= NIL THEN {
sp: MDModel.Symbol = HandleContTYPE[str, contseq, symbolseq, FALSE];
-- could be part of a LET
-- IF ~sp.defn THEN
-- CWF.WF1["Symbol %s not defn\n"L,MDModel.Sym[sp]];
vTop ← [ref[sp]];
Subr.FreeString[str];
};
};
22 => -- primary ::= unitid
NULL;
23 => -- subprimary ::= ( call )
vTop ← v[top+1];
24 => -- primary ::= group
NULL;
25 => -- subprimary ::= TYPE
{
sp: MDModel.TYPESymbol = MDModel.NewSymTYPE[symbolseq];
vTop ← [ref[sp]];
};
26 => -- subprimary ::= FRAMEPTRTYPE
{
sp: MDModel.TYPESymbol = MDModel.NewSymTYPE[symbolseq];
sp.frameptr ← TRUE;
vTop ← [ref[sp]];
};
27 => -- subprimary ::= TYPE id
{
-- although id is of type id, we never look it up, just use it as a string
str: LONG STRING ← v[top+1].r;
sp: MDModel.TYPESymbol = MDModel.NewSymTYPE[symbolseq];
sp.typeName ← Subr.CopyString[str];
vTop ← [ref[sp]];
Subr.FreeString[str];
};
28 => -- subprimary ::= FRAMEPTRTYPE id
{
-- although id is of type id, we never look it up, just use it as a string
str: LONG STRING ← v[top+1].r;
sp: MDModel.TYPESymbol = MDModel.NewSymTYPE[symbolseq];
sp.typeName ← Subr.CopyString[str];
sp.frameptr ← TRUE;
vTop ← [ref[sp]];
Subr.FreeString[str];
};
29 => -- subprimary ::= STRING
{
sp: MDModel.STRINGSymbol = MDModel.NewSymSTRING[symbolseq];
vTop ← [ref[sp]];
};
30 => -- primary ::= PROC group
{
sp: MDModel.PROCSymbol = MDModel.NewSymPROC[symbolseq];
sp.procparm ← MakeProperList[v[top+1].r];
Push[val~sp.procparm, isopen~TRUE, isqualified~FALSE]; -- OPENS the procedure parameters
vTop ← [ref[sp]];
};
31 => -- primary ::= PROC group RETURNS group
{
sp: MDModel.PROCSymbol = MDModel.NewSymPROC[symbolseq];
sp.procparm ← MakeProperList[v[top+1].r];
sp.procret ← MakeProperList[v[top+3].r];
Push[val~sp.procparm, isopen~TRUE, isqualified~FALSE]; -- OPENS the procedure parameters
Push[val~sp.procret, isopen~TRUE, isqualified~FALSE]; -- OPENS the procedure results
vTop ← [ref[sp]];
};
32 => -- subprimary ::= subprimary . id
{
sp: MDModel.Symbol = FindElementOf[vTop.r, v[top+2].r];
Subr.FreeString[v[top+2].r];
IF sp ~= NIL THEN sp.qualified ← TRUE;
vTop ← [ref[sp]];
};
33 => -- group ::= lb rb
vTop ← [ref[(NIL).LONG]];
34 => -- group ::= lb exp rb
vTop ← v[top+1];
35 => -- lb ::= [
Push[val~NIL, isopen~FALSE, isqualified~FALSE];
36 => -- rb ::= ]
Pop[];
37 => -- bindop ::= = =
-- bindop ::= ~
NULL;
38 => -- unitid ::= filename
{
sp: MDModel.LOCSymbol;
IF vTop.r = NIL THEN GOTO out; -- syntax error
sp ← ProcessFilename[vTop.r];
Subr.FreeString[vTop.r];
vTop ← [ref[sp]];
IF sp = NIL THEN GOTO out;
IF LongString.EquivalentString[sp.sext, "model"L] THEN
[sp.nestedmodel] ← ParseLoc[sp, officialTypeScript, officialwindow];
EXITS
out => NULL;
};
39 => -- unitid ::= filename ! number
{
sp: MDModel.LOCSymbol;
IF vTop.r = NIL THEN GOTO out; -- syntax error
sp ← ProcessFilename[vTop.r];
Subr.FreeString[vTop.r];
vTop ← [ref[sp]];
IF sp = NIL THEN GOTO out;
sp.createtime ← v[top+2].s;
IF LongString.EquivalentString[sp.sext, "model"L] THEN
[sp.nestedmodel] ← ParseLoc[sp, officialTypeScript, officialwindow];
EXITS
out => NULL;
};
ENDCASE => ERROR;
v[top] ← vTop;
ENDLOOP;
END;
MakeProperList: PROC[oldlist: MDModel.Symbol] RETURNS[MDModel.LISTSymbol] = {
RETURN [WITH oldlist SELECT FROM
splist: MDModel.LISTSymbol => splist,
ENDCASE => IF oldlist = NIL
THEN MDModel.LISTSymbol.NIL
ELSE MDModel.AddToEndOfList[NIL, oldlist, $normal, symbolseq]]};
FillInLetParent: PROC[spelem1: MDModel.Symbol, splet: MDModel.LETSymbol] = {
WITH spelem1 SELECT FROM
spelem: MDModel.TYPESymbol => {
IF spelem.typeval ~= NIL THEN
CWF.WF1["Warning: %s is defined in a TYPE and a LET stmt.\n"L, spelem.typesym];
IF spelem.letparent ~= NIL THEN
CWF.WF1["Warning: %s is defined in two LET stmts.\n"L, spelem.typesym];
spelem.letparent ← splet};
spelem: MDModel.APPLSymbol => {
IF spelem.applval ~= NIL THEN
CWF.WF1["Warning: %s is defined in an APPL and a LET stmt.\n"L, spelem.applsym];
IF spelem.letparent ~= NIL THEN
CWF.WF1["Warning: %s is defined in two LET stmts.\n"L, spelem.applsym];
spelem.letparent ← splet};
ENDCASE => NULL};
-- only retrieves models
-- returns NIL if the loc is not a model
-- need to save a few descriptors
ParseLoc: PUBLIC PROC[
sploc: MDModel.LOCSymbol, typeScript: TypeScript.TS, ttywindow: Subr.TTYProcs]
RETURNS[symmodel: MDModel.MODELSymbol, nerrors: CARDINAL ← 0] = {
savev: P1.ValueStack;
savel: P1.LinkStack;
saveq: P1.ActionStack;
saveproddata: ModelParseTable.ProdDataRef;
parsed: BOOL;
sh: Stream.Handle;
savecontinx: CARDINAL;
fi: Dir.FileInfo;
IF ~LongString.EquivalentString[sploc.sext, "model"L] THEN RETURN[NIL];
symmodel ← NIL;
-- this procedure is only executed for MODEL files
MoveFiles.BringOverRemoteFile[sploc, makethismodel, typeScript, ttywindow];
fi ← MDModel.GetFileInfo[sploc];
IF ~fi.srcPresent THEN RETURN;
-- lookup to see if we already analyzed it
FOR i:CARDINAL IN [0 .. symbolseq.modelSeq.size) DO
symmodel ← symbolseq.modelSeq[i];
IF symmodel.modelcreate = MDModel.GetSrcCreate[fi] THEN RETURN[symmodel, 0];
ENDLOOP;
sh ← Subr.NewStream[fi.srcFileName, Subr.Read
! Subr.FileError => GOTO err];
IF sploc.host = NIL THEN {
-- peek in first line of model
line: STRING ← [400];
newloc: MDModel.LOCSymbol;
[] ← Subr.GetLine[sh, line];
IF Subr.Prefix[line, "--["L] THEN {
line[1] ← '@; -- keeps ProcessFilename happy
Subr.SubStrCopy[line, line, 1];
newloc ← ProcessFilename[line];
sploc.host ← newloc.host;
sploc.path ← newloc.path;
newloc.host ← NIL;
newloc.path ← NIL;
};
FileStream.SetIndex[sh, 0]};
MDModel.PushInputStream[sh];
savev ← v; savel ← l; saveq ← q; saveproddata ← proddata;
CWF.WF1["Nested Parse of %s.\n"L, fi.srcFileName];
savecontinx ← IF contseq.size = 0 THEN 0 ELSE contseq.size - 1;
IF savecontinx > 0 THEN
contseq[savecontinx].block ← TRUE;
Push[val~symbolseq.controlv, isopen~FALSE, isqualified~FALSE]; -- push on control context
[complete~parsed, nErrors~nerrors] ← P1.InvokeParser[];
CWF.WF1["End of nested Parse, %u errors.\n"L, @nerrors];
Pop[]; -- pop off control
contseq[savecontinx].block ← FALSE;
v ← savev; l ← savel; q ← saveq; proddata ← saveproddata;
symmodel ← MDModel.NewSymMODEL[symbolseq];
symmodel.modelfilename ← Subr.CopyString[fi.srcFileName];
symmodel.modelcap ← fi.srcCap;
symmodel.modelcreate ← MDModel.GetSrcCreate[fi];
symmodel.model ← parseRoot;
-- add to model list
IF symbolseq.modelSeq.size >= symbolseq.modelSeq.maxsize THEN
CWF.WF0["Error - too many models.\n"L]
ELSE {
symbolseq.modelSeq[symbolseq.modelSeq.size] ← symmodel;
symbolseq.modelSeq.size ← symbolseq.modelSeq.size + 1};
EXITS
err => NULL;
};
ProcessFilename: PUBLIC PROC[fn: LONG STRING] RETURNS[sploc: MDModel.LOCSymbol] = {
host: STRING ← [40]; -- Ivy
directory: STRING ← [60]; -- Schmidt>Pilot
body: STRING ← [50]; -- Junk
ext: STRING ← [50]; -- Mesa
prinpart: CARDINAL ← 0;
t: STRING ← [100];
sep: STRING ← [20];
savefn: STRING ← [100];
GetNext: PROC[pat: LONG STRING] = {
i: CARDINAL ← 0;
pat.length ← 0;
IF fn[i] = '[ OR fn[i] = '] OR fn[i] = '< OR fn[i] = '>
OR fn[i] = '* OR fn[i] = '↑ OR fn[i] = '@ OR fn[i] = '.
THEN {
LongString.AppendChar[pat, fn[0]];
Subr.SubStrCopy[fn, fn, 1];
RETURN};
WHILE i < fn.length DO
IF fn[i] = '[ OR fn[i] = '] OR fn[i] = '< OR fn[i] = '>
OR fn[i] = '* OR fn[i] = '↑ OR fn[i] = '@ OR fn[i] = '.
THEN EXIT;
LongString.AppendChar[pat, fn[i]];
i ← i + 1;
ENDLOOP;
Subr.SubStrCopy[fn, fn, i]};
sploc ← NIL;
IF fn = NIL THEN ERROR;
Subr.strcpy[savefn, fn];
IF fn[0] ~= '@ THEN ERROR;
GetNext[t]; -- skip @
GetNext[t];
IF t[0] = '[ THEN {
GetNext[t];
Quote[t];
Subr.strcpy[host, t];
GetNext[t];
IF t[0] ~= '] THEN {
CWF.WF1["Error - missing ']' in '%s'.\n"L, savefn];
RETURN};
GetNext[t]};
IF t[0] = '< THEN {
GetNext[t];
GetNext[sep];
WHILE sep.length # 0 AND sep[0] = '> DO
Quote[t];
String.AppendString[directory, t];
GetNext[t];
GetNext[sep];
IF sep.length # 0 AND sep[0] = '> THEN
String.AppendChar[directory, '>];
ENDLOOP};
-- now is just a name.ext.ext
-- get name
Quote[t];
Subr.strcpy[body, t];
IF fn.length > 0 OR sep.length > 0 THEN {
IF sep.length = 0 THEN GetNext[sep];
IF sep[0] ~= '. THEN {
CWF.WF1["Error - missing '.' in '%s'.\n"L, savefn];
RETURN};
DO
GetNext[t];
IF t[0] = '* THEN {
prinpart ← ext.length;
GetNext[t]};
Quote[t];
IF ext.length > 0 THEN String.AppendChar[ext, '.];
String.AppendString[ext, t];
GetNext[sep];
IF sep.length = 0 THEN EXIT;
IF sep[0] ~= '. THEN {
CWF.WF1["Error - missing '.' in '%s'.\n"L, savefn];
RETURN};
ENDLOOP};
sploc ← MDModel.NewSymLOC[symbolseq];
sploc.host ← IF host.length = 0 THEN NIL
ELSE Subr.CopyString[host];
sploc.path ← IF directory.length = 0 THEN NIL
ELSE Subr.CopyString[directory];
sploc.tail ← Subr.CopyString[body];
sploc.sext ← Subr.CopyString[IF ext.length = 0 THEN "Mesa" ELSE ext];
sploc.prinpart ← prinpart;
-- CWF.WF4["Debug: [%s]<%s>%s.%s\n"L, sploc.host, sploc.path, sploc.tail, sploc.sext]--};
Quote: PROC[s: STRING] = {
sp: MDModel.Symbol;
IF s[s.length - 1] ~= '↑ THEN RETURN;
s.length ← s.length - 1;
[sp] ← LookupInContext[s, contseq];
IF sp = LONG[NIL] OR sp.stype ~= $typeSTRING THEN CWF.WF0["error"L];
Subr.strcpy[s,MDModel.NarrowToSTRING[sp].strval]};
-- if the file is not on local disk, we must retrieve it,
-- then we stack the stream handle
TokenValue: PUBLIC PROC [s: ModelParseTable.TSymbol] RETURNS [P1.Value] = {
RETURN [SELECT s FROM
ModelParseTable.tokenID => LOOPHOLE[LONG[0]],
ENDCASE => LOOPHOLE[LONG[0]]]};
FindElementOf: PROC[sym: MDModel.Symbol, element: LONG STRING]
RETURNS[node: MDModel.Symbol] = {
node ← NIL;
WITH sym SELECT FROM
record: MDModel.APPLSymbol => {
WITH record.appltype SELECT FROM
spstart: MDModel.LISTSymbol => {
WHILE spstart ~= NIL DO
stry: MDModel.Symbol;
MDModel.CkType[spstart, $typeLIST];
stry ← spstart.first;
IF stry.stype IN MDModel.HasAStringName AND MDModel.Sym[stry] ~= NIL
AND LongString.EquivalentString[MDModel.Sym[stry], element] THEN
RETURN[stry];
spstart ← spstart.rest;
ENDLOOP};
ENDCASE => {
CWF.WF1["Error - %s is not a record\n"L, MDModel.Sym[sym]];
RETURN};
};
ENDCASE => {
CWF.WF1["Error - %s has wrong type-- should be record.\n"L, MDModel.Sym[sym]];
RETURN}};
MergeTypes: PROC[sto: MDModel.Symbol, sfrom: MDModel.Symbol] = {
s: LONG STRING;
IF sto.stype IN MDModel.HasAStringName THEN s ← MDModel.Sym[sto];
-- this is for the case idImpl: id, where sfrom is id and
-- idImpl should have type id
IF (sfrom.stype = $typeTYPE AND MDModel.NarrowToTYPE[sfrom].typesym ~= NIL)
OR sfrom.stype = $typeLIST THEN {
sto↑ ← [vpart~typeAPPL[
appltype~sfrom, applval~NIL, applsym~s,
configname~NIL, letparent~NIL, interfaceseq~NIL]];
RETURN};
-- this is for the :@file default
IF sfrom.stype = $typeLOC THEN {
-- distinguish two cases: :@id[] and :@idImpl
-- the :@id[] returns a TYPE
-- the :@idImpl returns a typeAPPL
IF Subr.EndsIn[s, "impl"L] THEN
sto↑ ← [vpart~typeAPPL[
applsym~s, appltype~NIL, applval~sfrom,
configname~NIL, letparent~NIL, interfaceseq~NIL]]
ELSE
sto↑ ← [vpart~typeTYPE[
typeval~sfrom, typesym~s, typeName~Subr.CopyString[s],
frameptr~FALSE, letparent~NIL, uniqueno~0]];
RETURN};
sto↑ ← sfrom↑;
IF sto.stype IN MDModel.HasAStringName THEN
WITH sto SELECT FROM
sto1: MDModel.TYPESymbol => {
sto1.typesym ← s;
sto1.typeName ← Subr.CopyString[IF sto1.typeName = NIL THEN s ELSE sto1.typeName]};
sto1: MDModel.PROCSymbol => sto1.procsym ← s;
sto1: MDModel.STRINGSymbol => sto1.strsym ← s;
sto1: MDModel.APPLSymbol => sto1.applsym ← s;
ENDCASE => ERROR; -- bad select MergeTypes
MDModel.FreeStringsOf[sfrom];
MDModel.ZeroOut[sfrom]};
Push: PROC[val: MDModel.Symbol, isopen, isqualified: BOOL] = {
newcont: ContRecord = [val, isopen, FALSE];
IF val ~= NIL THEN {
WITH val SELECT FROM
splist: MDModel.LISTSymbol => {
-- if a list, then set the qualified bit to isqualified for each elem
WHILE splist ~= NIL DO
splist.first.qualified ← isqualified;
splist ← splist.rest;
ENDLOOP};
ENDCASE;
val.qualified ← isqualified};
IF contseq.size >= contseq.maxsize THEN
CWF.WF0["Too many pushes.\n"L]
ELSE {
contseq[contseq.size] ← newcont;
contseq.size ← contseq.size + 1}};
Pop: PROC = {
newcont: ContRecord = [];
WHILE contseq.size > 0 AND contseq[contseq.size-1].isopen DO
contseq.size ← contseq.size - 1;
ENDLOOP;
IF contseq.size = 0 THEN
CWF.WF0["Too many pops\n"L]
ELSE {
contseq.size ← contseq.size - 1;
contseq[contseq.size] ← newcont}};
LookupInContext: PROC[sym: LONG STRING, contseq: ContSeq]
RETURNS[sp: MDModel.Symbol, isnewscope: BOOL] = {
spsym: LONG STRING;
isnewscope ← TRUE;
FOR i: CARDINAL DECREASING IN [0 .. contseq.size) DO
{
IF contseq[i].block THEN EXIT;
sp ← contseq[i].ptr;
IF sp = NIL THEN GOTO loop;
WITH sp SELECT FROM
splist: MDModel.LISTSymbol => {
-- sp is a list
WHILE splist ~= NIL DO
spa: MDModel.Symbol = splist.first;
IF spa.stype IN MDModel.HasAStringName
AND (spsym ← MDModel.Sym[spa]) ~= NIL
AND spsym.length = sym.length
AND LongString.EquivalentString[sym, spsym]
THEN RETURN[spa, isnewscope];
splist ← splist.rest;
ENDLOOP};
ENDCASE => {
IF sp.stype NOT IN MDModel.HasAStringName THEN GOTO loop;
spsym ← MDModel.Sym[sp];
IF spsym ~= NIL
AND spsym.length = sym.length
AND LongString.EquivalentString[sym, spsym]
THEN RETURN[sp, isnewscope]};
GOTO loop;
EXITS
loop => IF ~contseq[i].isopen THEN isnewscope ← FALSE;
};
ENDLOOP;
RETURN[NIL, TRUE]};
-- if the sym is already defined, assume it is a new definition
-- if definitional then this is a context where something can be defined
HandleContTYPE: PROC[sym: LONG STRING, contseq: ContSeq,
symbolseq: MDModel.SymbolSeq, definitional: BOOL]
RETURNS[sp: MDModel.Symbol] = {
news: BOOL;
[sp, news] ← LookupInContext[sym, contseq];
IF sp = NIL OR (sp.defn AND definitional) THEN {
IF ~news THEN CWF.WF1["Error -%s is multiply defined.\n"L, sym];
sp ← IdInsertTYPE[sym, symbolseq]}};
-- if the sym is already defined, assume it is a new definition
HandleContAPPL: PROC[sym: LONG STRING, contseq: ContSeq,
symbolseq: MDModel.SymbolSeq, definitional: BOOL]
RETURNS[sp: MDModel.Symbol] = {
news: BOOL;
[sp, news] ← LookupInContext[sym, contseq];
IF sp = NIL OR (sp.defn AND definitional) THEN {
IF ~news THEN CWF.WF1["Error -%s is multiply defined.\n"L, sym];
sp ← IdInsertAPPL[sym, symbolseq]}};
IdInsertTYPE: PROC[s: LONG STRING, symbolseq: MDModel.SymbolSeq]
RETURNS[sto: MDModel.TYPESymbol] = {
sto ← MDModel.NewSymTYPE[symbolseq];
sto.typesym ← Subr.CopyString[s];
sto.typeName ← Subr.CopyString[s]}; -- questionable
IdInsertAPPL: PROC[s: LONG STRING, symbolseq: MDModel.SymbolSeq]
RETURNS[sto: MDModel.APPLSymbol] = {
sto ← MDModel.NewSymAPPL[symbolseq];
sto.applsym ← Subr.CopyString[s]};
}.
UNUSED PRODUCTIONS
-- callexplist ::= callexplist ; call => exp
NULL;
-- callexplist ::= call => exp
NULL;
-- call ::= SELECT call FROM [ callexplist ]
NULL;
-- also, we need to get rid of the $ stuff from the source reduction