-- file BcdTreeBuild.pgs
-- DO NOT CONVERT TO TIOGA!  (PGS requires that comments be mesa-style.)
-- last edited by Satterthwaite on March 14, 1986 11:22:21 am PST
-- last edited by Lewis on 12-Mar-81 18:04:07
-- last edited by Maxwell on August 11, 1983 3:36 pm 

-- pgs [defs: BcdParseTable, grammar: CMesa] _ BcdTreeBuild.pgs


DIRECTORY
  P1: TYPE USING [
    ActionStack, Index, LinkStack, Value, ValueStack, InputLoc, nullId, nullValue],
  ParseTable: TYPE USING [ProdDataRef, Symbol, tokenID],
  Tree: TYPE USING [Link, null],
  TreeOps: TYPE USING [
    PopTree, PushTree, PushHash, PushList, PushNode, SetAttr, SetInfo];

BcdTreeBuild: PROGRAM
    IMPORTS P1, TreeOps
    EXPORTS P1 = {
  OPEN TreeOps;

  -- local data base (supplied by parser)

  v: P1.ValueStack;
  l: P1.LinkStack;
  q: P1.ActionStack;
  proddata: ParseTable.ProdDataRef;

  AssignDescriptors: PUBLIC PROC[
      qd: P1.ActionStack, vd: P1.ValueStack, ld: P1.LinkStack, pp: ParseTable.ProdDataRef] ~ {
    q _ qd;  v _ vd;  l _ ld;  proddata _ pp};


  -- the interpretation rules

  LinkToSource: PROC[index: P1.Index] ~ INLINE {SetInfo[l[index]]};

  exportsALL: BOOL;

  LinkSpec: TYPE ~ {frame, defaultFrame, code, defaultCode};
  CodeLinks: TYPE ~ LinkSpec[$code .. $defaultCode];
  DefaultLinks: ARRAY LinkSpec OF LinkSpec ~ [
    $defaultFrame, $defaultFrame, $defaultCode, $defaultCode];
    
  linkSpec: LinkSpec;
        
  SetLinkAttrs: PROC ~ {
    SetAttr[$codeLinks, (linkSpec IN CodeLinks)];
    SetAttr[$explicitLinkLoc, (linkSpec # DefaultLinks[linkSpec])]};
  

  ProcessQueue: PUBLIC PROC[qI, top: CARDINAL] ~ {
    save: Tree.Link;
    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: BcdParseData  TYPE: ParseTable  EXPORTS: SELF
	    --GOAL:  goal

	    --TERMINALS:
	    --    id 	str	,	;
	    --    :	_	=	~
	    --    ]	[	}	{	.

	    --  DIRECTORY	FROM	PACK	CONFIGURATION	CONFIG
	    --  IMPORTS	EXPORTS	CONTROL	BEGIN
	    --  END 	PLUS	THEN	LINKS
	    --  CODE	FRAME   ALL

	    --ALIASES:
	    --  id       tokenID
	    --  str      tokenSTR
	    --  .        initialSymbol

	    --  PRODUCTIONS:

		-- goal		  ::= . source 
          NULL;

        1  =>	-- source         ::= directory packing init config .
          {PushNode[$source,3];  LinkToSource[top]};

        2  =>	-- directory      ::= DIRECTORY includelist ;
          PushList[v[top+1].s];

        3  =>	-- includeitem    ::= id : FROM str
          {
          PushHash[v[top].r];  PushHash[v[top+3].r];  PushNode[$item,2];
          LinkToSource[top];
          };

        4  =>	-- packing        ::= packlist ;
          PushList[v[top].s];

        5  =>	-- packlist       ::= PACK idlist 
          {PushList[v[top+1].s]; LinkToSource[top]; vTop _ [scalar[1]]};

        6  =>	-- packlist       ::= packlist ; PACK idlist
          {PushList[v[top+3].s]; LinkToSource[top]; vTop _ [scalar[v[top].s+1]]};

        7  =>	-- init           ::= 
          {linkSpec _ $defaultFrame;  exportsALL _ FALSE};

        8  =>	-- config         ::= id : CONFIG links imports exports control tilde body 
             	-- config         ::= id : CONFIGURATION links imports exports control tilde body 
          {
          save _ PopTree[];
          PushHash[v[top].r];  PushTree[save];  PushNode[$config,5];
          SetAttr[$exportsALL, exportsALL];  LinkToSource[top];
          linkSpec _ v[top+3].s;  exportsALL _ v[top+5].s;  -- restore old values
          };

        9  =>	-- links          ::= 
          {vTop _ [scalar[linkSpec]];  linkSpec _ DefaultLinks[linkSpec]};

       10  =>	-- links          ::= LINKS : CODE
          {vTop _ [scalar[linkSpec]];  linkSpec _ $code};

       11  =>	-- links          ::= LINKS : FRAME
          {vTop _ [scalar[linkSpec]];  linkSpec _ $frame};

       12  =>	-- imports        ::= IMPORTS itemlist
		-- body           ::= BEGIN statementlist END
		-- body           ::= { statementlist }
		-- leftside       ::= [ itemlist ]
          PushList[v[top+1].s];

       13  =>	-- control        ::= CONTROL idlist 
          PushList[v[top+1].s];

       14  =>	-- statement      ::= leftside _ module 
          {PushNode[$assign,2];  LinkToSource[top]};

       15  =>	-- statement      ::= leftside _ interface 
          {PushNode[$assign,2];  LinkToSource[top]};

       16  =>	-- statement      ::= item links
          {
          SetLinkAttrs[];
          PushTree[Tree.null];  PushNode[$module,2];
          SetLinkAttrs[];  LinkToSource[top];
          linkSpec _ v[top+1].s;
          };

       17  =>	-- module         ::= item [ ] links
          {
          SetLinkAttrs[];
          PushTree[Tree.null];  PushNode[$module,2];
          SetLinkAttrs[];  LinkToSource[top];
          linkSpec _ v[top+3].s;
          };

       18  =>	-- module         ::= item [ idlist ] links
          {
          PushList[v[top+2].s];  save _ PopTree[];
          SetLinkAttrs[];
          PushTree[save];  PushNode[$module,2];
          SetLinkAttrs[];  LinkToSource[top];
          linkSpec _ v[top+4].s;
          };

       19  =>	-- interface      ::= id 
          PushHash[v[top].r];

       20  =>	-- interface      ::= interface THEN id 
          {PushHash[v[top+2].r];  PushNode[$then,2];  LinkToSource[top]};

       21  =>	-- interface      ::= interface PLUS id 
          {PushHash[v[top+2].r];  PushNode[$plus,2];  LinkToSource[top]};

       22  =>	-- item           ::= id 
          {
          PushHash[v[top].r];  PushTree[Tree.null];  PushNode[$item,2];
          LinkToSource[top];
          };

       23  =>	-- item           ::= id : id 
          {
          PushHash[v[top].r];  PushHash[v[top+2].r];  PushNode[$item,2];
          LinkToSource[top];
          };

       24  =>	-- idlist         ::= id 
          {PushHash[v[top].r];  vTop _ [scalar[1]]};

       25  =>	-- idlist         ::= idlist , id 
          {PushHash[v[top+2].r];  vTop _ [scalar[v[top].s+1]]};

       26  =>	--  tilde        	::= ~
		--  tilde        	::= =
		--  statementlist	::= statementlist ;
		--  statement		::= module
		--  statement		::= config
		--  leftside		::= item
          NULL;

       27  =>	-- imports        ::= 
		-- control        ::= 
		-- directory      ::= 
		-- packing        ::= 
          {PushTree[Tree.null];  l[top] _ P1.InputLoc[]};

       28  =>	-- includelist    ::= includeitem
		-- statementlist  ::= statement
		-- itemlist       ::= item
          vTop _ [scalar[1]];

       29  =>	-- includelist    ::= includelist , includeitem
		-- statementlist  ::= statementlist ; statement
		-- itemlist       ::= itemlist , item
          vTop _ [scalar[v[top].s+1]];

       30  =>	-- exports        ::= EXPORTS expinit exportlist
          {vTop _ v[top+1];  PushList[v[top+2].s]};
	  
       31  =>	-- exports        ::= 
          {PushTree[Tree.null]; l[top] _ P1.InputLoc[]; vTop _ [scalar[exportsALL]]};
	  
       32  =>   -- expinit        ::= 
          {vTop _ [scalar[exportsALL]];  exportsALL _ FALSE};

       33  =>   -- exportlist     ::= item
          vTop _ [scalar[1]];

       34  =>	-- exportlist     ::= ALL
          {exportsALL _ TRUE;  vTop _ [scalar[0]]};

       35  =>   -- exportlist     ::= exportlist , item
          vTop _ [scalar[v[top].s+1]];

       36  =>	-- exportlist     ::= exportlist , ALL
          {exportsALL _ TRUE;  vTop _ v[top]};

       ENDCASE => ERROR;

      v[top] _ vTop;
      ENDLOOP};

  TokenValue: PUBLIC PROC[s: ParseTable.Symbol] RETURNS[P1.Value] ~ {
    RETURN [SELECT s FROM
      ParseTable.tokenID => P1.nullId,
      ENDCASE => P1.nullValue]
    };

  }.