-- 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