-- MDParseImpl.mesa
-- last edit by Schmidt, January 6, 1983 1:59 pm
-- last edit by Satterthwaite, February 9, 1983 10:37 am
-- Parser for the system modeller

DIRECTORY
  CWF: TYPE USING [WF0, WF1, WF2, WFC],
  Dir: TYPE USING [AddToDep, ADepRecord, DepSeq],
  FileStream: TYPE USING [EndOf],
  LongString: TYPE USING [EqualString],
  MDModel: TYPE USING [
    LISTSymbol, MODELSymbol, ParseLoc, Sym, Symbol, SymbolSeq, TraverseTree],
  ModelParseData: TYPE,
  P1: FROM "ModelParseDefs" USING [GuaranteeScannerCleanedUp, StreamId, TableId],
  Runtime: TYPE USING [GetTableBase],
  STPSubr: TYPE USING [StopSTP],
  Stream: TYPE USING [Delete, GetChar, Handle],
  Subr: TYPE USING [
    AllocateString, FreeString, GetChar, LongZone, NewStream, Read, strcpy,
    TTYProcs, Write],
  TypeScript: TYPE USING [TS],
  UnsafeSTP: TYPE USING [Error];


MDParseImpl: PROGRAM 
  IMPORTS
    CWF, Dir, FileStream, LongString, MDModel, ModelParseData, P1, Runtime,
    STP: UnsafeSTP, STPSubr, Stream, Subr
  EXPORTS MDModel, P1 = {

  -- be sure to update array TokString if you change this
  Token: TYPE = {
	tokBAD, tokEOF, tokLB, tokRB, tokDOT, tokCOLON, tokCOMMA,
	tokEQ, tokTWIDDLE, tokSEMI, tokID, tokNUM, tokTYPE, tokRETURNS,
	tokSTRLIT, tokFROM, tokDIR, tokIMPORTS, tokEXPORTS, tokPROGRAM,
	tokBEGIN, tokDEFINITIONS, tokCONFIG, tokEND, tokUSING, tokSHARES,
	tokMONITOR, tokCEDAR};


 -- MDS usage!!!
  tablesegptr: LONG POINTER;			-- ??
  logsh: Stream.Handle _ NIL;
  streamstack: ARRAY[0 .. 15) OF Stream.Handle _ ALL[NIL];
  streaminx: CARDINAL _ 0;
  parseRoot: PUBLIC MDModel.LISTSymbol _ NIL;	-- exported to MDModel
  -- for config scanner
  peektok: Token;
  peekvalue: LONG STRING;
  nextchar: CHAR;
  init: BOOL _ FALSE;
  savestr: LONG STRING _ NIL;
  toksave: LONG STRING _ NIL;

  -- the parser will close sh for you!!!
  ModelParse: PUBLIC PROC[symbolseq: MDModel.SymbolSeq, typeScript: TypeScript.TS,
	ttywindow: Subr.TTYProcs] = {

    Cleanup: PROC = {
      IF logsh ~= NIL THEN Stream.Delete[logsh];
      logsh _ NIL;
      streaminx _ 0;
      P1.GuaranteeScannerCleanedUp[]};
	
    {  
    ENABLE {
      UNWIND => Cleanup[];
      STP.Error => {
	CWF.WF0["FTP Error. "L];
	IF error ~= NIL THEN CWF.WF1["message: %s\n"L,error];
	Cleanup[];
	GOTO leave};
	};

    nerrors: CARDINAL;

    [symmodel: symbolseq.toploc.nestedmodel, nerrors: nerrors] _ 
	(symbolseq.toploc).ParseLoc[typeScript, ttywindow];
    -- close connections in case any files were brought over
    STPSubr.StopSTP[];
    P1.GuaranteeScannerCleanedUp[];
    IF logsh ~= NIL THEN {
	sh: Stream.Handle;
	Stream.Delete[logsh];  logsh _ NIL;
	-- since there were parsing errors, 
	-- get rid of the internal data structures
	symbolseq.toploc.nestedmodel _ NIL;
	CWF.WF0["Parser error log stored on 'ModelParser.ErrLog'\n"L];
	sh _ Subr.NewStream["ModelParser.ErrLog"L, Subr.Read];
	UNTIL FileStream.EndOf[sh] DO
	  CWF.WFC[Stream.GetChar[sh]];
	  ENDLOOP;
	Stream.Delete[sh]};
    IF symbolseq.toploc.nestedmodel ~= NIL THEN CheckDefined[symbolseq];
    streaminx _ 0;
    EXITS
    leave => NULL;
    }};


  PushInputStream: PUBLIC PROC[sh: Stream.Handle] = {
    IF streaminx >= streamstack.LENGTH THEN ERROR;
    streamstack[streaminx] _ sh;
    streaminx _ streaminx + 1};

  StreamPop: PROC RETURNS[sh: Stream.Handle] = {
    IF streaminx = 0 THEN ERROR;
    streaminx _ streaminx - 1;
    RETURN[streamstack[streaminx]]};


 -- exported to P1, called by P1.Parse[]

  AcquireStream: PUBLIC PROC [id: P1.StreamId] RETURNS [Stream.Handle] = {
    SELECT id FROM
      $source => RETURN[streamstack[streaminx-1]];
      $log => {
	IF logsh = NIL THEN logsh _ Subr.NewStream["ModelParser.ErrLog"L, Subr.Write];
	RETURN[logsh]};
      ENDCASE => ERROR};

  ReleaseStream: PUBLIC PROC [id: P1.StreamId] = {
    SELECT id FROM
      $source => {
	-- this is currently not used because the
	-- scanner frees these in ResetScanIndex in ModelScannerImpl
	sh: Stream.Handle _ StreamPop[];
	Stream.Delete[sh]};
      $log => NULL
      ENDCASE => ERROR};


  AcquireTable: PUBLIC PROC [id: P1.TableId] RETURNS [LONG POINTER] = {
    RETURN[IF id = $parse THEN tablesegptr ELSE ERROR]};
    
  ReleaseTable: PUBLIC PROC [id: P1.TableId] = {
    IF id = $parse THEN NULL ELSE ERROR};


 --
 
  CheckDefined: PROC[symbolseq: MDModel.SymbolSeq] = {
	
    Proc: PROC[sp: MDModel.Symbol, spmodel: MDModel.MODELSymbol] 
		RETURNS[proceed: BOOL _ TRUE] = {
      SELECT sp.stype FROM
	$typeTYPE, $typePROC, $typeAPPL =>
	  IF ~sp.defn THEN 
	    CWF.WF2["In %s: %s not defined.\n"L, spmodel.modelfilename, MDModel.Sym[sp]];
	$typeLET => RETURN[FALSE];
	ENDCASE => NULL};

    (symbolseq.toploc).TraverseTree[symbolseq, Proc]};

-- produces depseq where bcdfilename[i] does not end in "bcd"
-- parse the stream handle, 
-- it turns out we ignore IMPORTS and EXPORTS since those entries must appear
-- in the DIRECTORY clause
  ParseUnit: PUBLIC PROC[sh: Stream.Handle, depseq: Dir.DepSeq, sfn: LONG STRING] = {
    tok: Token _ $tokBAD;
    tokvalue: LONG STRING;
    str: LONG STRING;
    stemp: STRING _ [100];
    imp, isconfig, isdefns: BOOL _ FALSE;
    savename: STRING _ [100];
    formal: STRING _ [100];

    ScanInit[sh];
    WHILE tok ~= $tokBEGIN AND tok ~= $tokEOF DO
      SELECT tok FROM 
	$tokDIR => [tok, tokvalue] _ Direct[sh, depseq, sfn];
	$tokCONFIG => {
	  IF savename.length # 0 THEN 
	    depseq.moduleName _ depseq.CopyString[savename];
	  isconfig _ TRUE;
	  [tok,tokvalue] _ NextTok[sh]};
	$tokPROGRAM, $tokMONITOR => {
	  IF savename.length # 0 THEN 
	    depseq.moduleName _ depseq.CopyString[savename];
	  isconfig _ FALSE;
	  [tok,tokvalue] _ NextTok[sh]};
	$tokDEFINITIONS => {
	  IF savename.length # 0 THEN 
	    depseq.moduleName _ depseq.CopyString[savename];
	  isdefns _ TRUE;
	  [tok,tokvalue] _ NextTok[sh]};
	$tokIMPORTS, $tokEXPORTS => {
	  imp _ tok = $tokIMPORTS;
	  [tok, tokvalue] _ NextTok[sh];
	  WHILE tok = $tokID OR tok = $tokCOMMA DO
	    IF tok = $tokID THEN {
	      adeprecord: Dir.ADepRecord _ [relation: IF imp THEN $imports ELSE $exports];
	      str _ tokvalue;
	      Subr.strcpy[formal, str];
	      -- str: str
	      -- formal: str
	      IF peektok = $tokCOLON THEN {
		[tok, tokvalue] _ NextTok[sh];
		[tok, tokvalue] _ NextTok[sh];
		str _ tokvalue};
	      -- bcdFileName is the formal
	      -- moduleName  is the type name
	      adeprecord.bcdFileName _ depseq.CopyString[formal];
	      adeprecord.moduleName _ depseq.CopyString[str];
	      Dir.AddToDep[depseq, @adeprecord]};
	    [tok, tokvalue] _ NextTok[sh];
	    ENDLOOP};
	$tokID => {	-- this may be the module name
	  Subr.strcpy[savename, tokvalue];
	  [tok,tokvalue] _ NextTok[sh]};
	ENDCASE => [tok,tokvalue] _ NextTok[sh];
      ENDLOOP;
    depseq.isconfig _ isconfig;
    depseq.isdefns _ isdefns;
    -- currently do not need to parse the body of a config
    -- IF isconfig THEN tok _ ConfigBody[sh, sfn, depseq];
    RETURN};

-- Interface: FROM "FileName": TYPE USING [a,b,c],;
-- Interface: TYPE USING [a,b,c],;
-- Interface ,;
-- FileName: TYPE Interface
-- FileName: TYPE
  Direct: PROC [sh: Stream.Handle, depseq: Dir.DepSeq, sfn: LONG STRING]
	RETURNS[tok: Token, tokvalue: LONG STRING] = {

    CheckTok: PROC[tokshouldbe: Token] = {
      IF tok ~= tokshouldbe THEN {
	CWF.WF0["Token is "L]; PrintTok[tok];
	CWF.WF0[", should be "L]; PrintTok[tokshouldbe];
	CWF.WF1[", in file %s\n"L, sfn]}};

    [tok,tokvalue] _ NextTok[sh];
    WHILE tok ~= $tokPROGRAM AND tok ~= $tokEOF AND tok ~= $tokDEFINITIONS
    AND tok ~= $tokSEMI AND tok~= $tokCONFIG DO
      IF tok = $tokID THEN {
	adeprecord: Dir.ADepRecord  _ [relation: $directory];
	filename: LONG STRING _ tokvalue;
	interface: STRING _ [100];
	Subr.strcpy[interface, filename];
	[tok, tokvalue] _ NextTok[sh];
	IF tok = $tokCOLON THEN {
	  [tok, tokvalue] _ NextTok[sh];
	  SELECT tok FROM
	    $tokTYPE => {
	      IF peektok = $tokID THEN {
		stemp: STRING _ [40];
		[tok, tokvalue] _ NextTok[sh];
		filename _ tokvalue;
		Subr.strcpy[stemp, filename];
		Subr.strcpy[filename, interface];
		Subr.strcpy[interface, stemp]}};
	    $tokFROM => {
	      IF peektok = $tokSTRLIT THEN [tok, tokvalue] _ NextTok[sh];
	      Subr.strcpy[filename, interface]};
	    ENDCASE => CheckTok[$tokTYPE]};
	-- filename will not have ".bcd" at end
	adeprecord.bcdFileName _ depseq.CopyString[filename];
	adeprecord.moduleName _ depseq.CopyString[interface];
	Dir.AddToDep[depseq, @adeprecord];
	WHILE tok ~= $tokCOMMA AND tok ~= $tokSEMI AND tok ~= $tokEOF
	AND tok ~= $tokPROGRAM AND tok ~= $tokDEFINITIONS AND
	tok ~= $tokCONFIG DO
	  IF tok = $tokLB THEN {
	    WHILE tok ~= $tokEOF AND tok ~= $tokRB DO
	      [tok,tokvalue] _ NextTok[sh];
	      ENDLOOP;
	    CheckTok[$tokRB]};
	  [tok,tokvalue] _ NextTok[sh];
	  ENDLOOP}
      ELSE [tok,tokvalue] _ NextTok[sh];
      ENDLOOP;
    RETURN};

 -- initiallizes the various data structures
  ScanInit: PROC [st: Stream.Handle]  = {
    IF ~init THEN Init[];
    peektok _ $tokBAD;
    peekvalue _ NIL;
    nextchar _ '\n;
    [] _ NextTok[st]};

 -- to free this memory, simply call StopScanner
  Init: PROC = {
    longzone: UNCOUNTED ZONE = Subr.LongZone[];
    init _ TRUE;
    savestr _ Subr.AllocateString[200];
    toksave _ Subr.AllocateString[200]};

-- frees memory as needed, call only once
  StopScanner: PUBLIC PROC = {
    longzone: UNCOUNTED ZONE = Subr.LongZone[];
    IF ~init THEN RETURN;	-- Init never called
    Subr.FreeString[toksave];
    Subr.FreeString[savestr];
    savestr _ toksave _ NIL;
    init _ FALSE};


 -- NOTE: this checks the type of Token in case the string literal must be saved
  NextTok: PROC [st: Stream.Handle] RETURNS[tok: Token, tokvalue: LONG STRING] = {
    tok _ peektok;
    IF tok = $tokID OR tok = $tokSTRLIT THEN {
      Subr.strcpy[toksave,peekvalue];
      tokvalue _ toksave}
    ELSE tokvalue _ peekvalue;
    [peektok,peekvalue] _ ReadTok[st];
    RETURN};

  ReadTok: PROC [st: Stream.Handle] RETURNS[toktype: Token, tokval: LONG STRING] = {
    i: CARDINAL;
    lastchar: CHAR;
    DO
      WHILE nextchar = '  OR nextchar = '\n OR nextchar = '\t OR nextchar = '\f DO
	nextchar _ Subr.GetChar[st]
	ENDLOOP;
      IF IsAlpha[nextchar] THEN {
	i _ 0;
	WHILE (IsAlpha[nextchar]  OR IsDigit[nextchar]) AND i <= savestr.maxlength DO
	  savestr[i] _ nextchar;
	  i _ i + 1;
	  nextchar _ Subr.GetChar[st];
	  ENDLOOP;
	savestr.length _ i;
	toktype _ KeywordLookup[savestr];
	RETURN (IF toktype ~= $tokBAD THEN [toktype,NIL] ELSE [$tokID,savestr])}
      ELSE IF IsDigit[nextchar] THEN {
	i _ 0;
	WHILE IsDigit[nextchar] AND i <= savestr.maxlength DO
	  savestr[i] _ nextchar;
	  i _ i+1;
	  nextchar _ Subr.GetChar[st];
	  ENDLOOP;
	savestr.length _ i;
	RETURN[$tokNUM,savestr]}
      ELSE {
	lastchar _ nextchar;
	nextchar _ Subr.GetChar[st];
	SELECT lastchar FROM
	  '[ => toktype _ $tokLB;
	  '] => toktype _ $tokRB;
	  '{ => toktype _ $tokBEGIN;
	  '} => toktype _ $tokEND;
	  '. => toktype _ $tokDOT;
	  ': => toktype _ $tokCOLON;
	  ', => toktype _ $tokCOMMA;
	  '; => toktype _ $tokSEMI;
	  '~ => toktype _ $tokTWIDDLE;
	  '\000 => toktype _ $tokEOF;	-- Tioga
	  '= => toktype _ $tokEQ;
	  '- => {
	    IF nextchar ~= '- THEN CWF.WF0["bad comment\n"L];
	    nextchar _ Subr.GetChar[st];
	    WHILE nextchar ~= '\n AND nextchar ~= '\000 DO
	      IF nextchar = '- THEN {
	        nextchar _ Subr.GetChar[st];
	        IF nextchar = '- THEN EXIT};
	      nextchar _ Subr.GetChar[st];
	      ENDLOOP;
	    nextchar _ Subr.GetChar[st];
	    LOOP};
	  '" => {
	    i _ 0;
	    WHILE i < savestr.maxlength DO
	      savestr[i] _ nextchar;
	      nextchar _ Subr.GetChar[st];
	      i _ i + 1;
	      IF nextchar = '" THEN {
		nextchar _ Subr.GetChar[st];
		IF nextchar = '" THEN LOOP;
		EXIT};
	      REPEAT
		FINISHED => CWF.WF0["String literal too long\n"L];
	      ENDLOOP;
	    savestr.length _ i;
	    RETURN[$tokSTRLIT, savestr]};
	  ENDCASE => {
	    i: INTEGER _ lastchar.ORD;
	    CWF.WF1["unknown char %c\n"L,@i];
	    toktype _ $tokEOF};
        RETURN[toktype,NIL]};
      ENDLOOP};

  KeywordLookup: PROC[str: LONG STRING] RETURNS[tok: Token] = {
    -- return the tok if found, return $tokBAD if error
    OPEN LongString;
    SELECT str.length FROM
      3 =>
	IF EqualString[str,"END"L] THEN RETURN[$tokEND];
      4 => {
	IF EqualString[str,"FROM"L] THEN RETURN[$tokFROM];
	IF EqualString[str,"TYPE"L] THEN RETURN[$tokTYPE]};
      5 => {
	IF EqualString[str,"BEGIN"L] THEN RETURN[$tokBEGIN];
	IF EqualString[str,"CEDAR"L] THEN RETURN[$tokCEDAR];
	IF EqualString[str,"USING"L] THEN RETURN[$tokUSING]};
      6 =>
	IF EqualString[str,"SHARES"L] THEN RETURN[$tokSHARES];
      7 => {
	IF EqualString[str,"EXPORTS"L] THEN RETURN[$tokEXPORTS];
	IF EqualString[str,"IMPORTS"L] THEN RETURN[$tokIMPORTS];
	IF EqualString[str,"MONITOR"L] THEN RETURN[$tokMONITOR];
	IF EqualString[str,"PROGRAM"L] THEN RETURN[$tokPROGRAM];
	IF EqualString[str,"RETURNS"L] THEN RETURN[$tokRETURNS]};
      9 => 
	IF EqualString[str,"DIRECTORY"L] THEN RETURN[$tokDIR];
      11 => 
	IF EqualString[str,"DEFINITIONS"L] THEN RETURN[$tokDEFINITIONS];
      13 => 
	IF EqualString[str,"CONFIGURATION"L] THEN RETURN[$tokCONFIG];
      ENDCASE => NULL;
    RETURN[$tokBAD]};


  PrintTok: PROC [tok: Token] = {
    TokString: ARRAY Token OF STRING = [
      "ErrorToken"L, "EndOfFile"L, "["L, "]"L, "."L, ":"L, ","L,
      "="L, "~"L, ";"L, "Identifier"L, "Number"L, "TYPE"L, "RETURNS"L,
      "StringLiteral"L, "FROM"L, "DIRECTORY"L,"IMPORTS"L, "EXPORTS"L, "PROGRAM"L,
      "{"L, "DEFINITIONS"L, "CONFIGURATION", "END"L, "USING"L, "SHARES"L,
      "MONITOR"L, "CEDAR"L];
    CWF.WF0[TokString[tok]]};

  IsDigit: PROC[c: CHAR] RETURNS[BOOL] = INLINE {
    RETURN[c IN ['0 .. '9]]};

  IsAlpha: PROC[c: CHAR] RETURNS[BOOL] = INLINE {
    RETURN[c IN ['a .. 'z] OR c IN ['A .. 'Z]]};

 -- START code
  tablesegptr _ Runtime.GetTableBase[LOOPHOLE[ModelParseData]];
  }.