-- file PackTreeBuild.mesa rewritten by PGS, 12-Jan-83 10:57
-- last edited by Lewis on  4-Nov-81 15:24:14
-- last edited by Satterthwaite, January 12, 1983 10:57 am

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

PackTreeBuild: PROGRAM
    IMPORTS 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: CARDINAL] ~ INLINE {SetInfo[l[index]]};

  exceptMain, exceptEV, exceptCatch: BOOL;
  primaryComponentId: P1.Value;

  
  ProcessQueue: PUBLIC PROC [qI, top: CARDINAL] ~
    BEGIN
    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  =>	--
	    --TYPE: ParseTable
	    --TABLE: PackParseData    EXPORTS: SELF
	    --GOAL:  Goal

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

	    --  SEGMENT	BEGIN	END	CODE    PACK    DISCARD
	    --  EXCEPT 	MAIN	OF      FRAME   MERGES  CATCH
	    --  ENTRY   VECTOR  EV

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

	    --  PRODUCTIONS:

		-- Goal		     ::= . PackagingDesc 
          NULL;

        1  =>   -- PackagingDesc     ::= DescSeries
          PushList[v[top].s];

        2  =>	-- DescSeries        ::= DescItem ;
             	-- DescSeries        ::= DescItem .
          vTop _ [scalar[1]];

        3  =>	-- DescSeries        ::= DescSeries DescItem ;
             	-- DescSeries        ::= DescSeries DescItem .
          vTop.s _ v[top].s+1;

        4  =>	-- DescItem          ::= CodeSegment
                -- DescItem          ::= FramePack 
                -- DescItem          ::= Merge 
                -- DescItem          ::= MergeFramePack 
          NULL;

        5  =>	--  tilde        	::= ~
                --  tilde        	::= =
          NULL;

        6  =>	-- CodeSegment       ::= id : SEGMENT tilde SegmentBody 
          BEGIN
	  PushHash[v[top].r];  
          PushNode[$codeSeg, -2];  LinkToSource[top];
          END;

        7  =>	-- SegmentBody       ::= { CodePackSeries }
              	-- SegmentBody       ::= BEGIN CodePackSeries END
          PushList[v[top+1].s];

        8  =>	-- CodePackSeries    ::= CodePack
          vTop _ [scalar[1]];

        9  =>	-- CodePackSeries    ::= CodePackSeries ; CodePack
          vTop.s _ v[top].s+1;

       10  =>	-- CodePackSeries    ::= CodePackSeries ;
          NULL;          -- allows trailing ;

       11  =>   -- CodePack          ::= id : CODE PACK tilde InitCodePack CodePackBody
          BEGIN
          save _ PopTree[];
	  PushHash[v[top].r];  PushTree[save];  PushTree[Tree.nullProcs];
          PushNode[$codePack, 3];  LinkToSource[top];  
	  SetAttr[$exceptMAIN, exceptMain];  SetAttr[$exceptEV, exceptEV];
	  SetAttr[$exceptCatch, exceptCatch];
          END;

       12  =>   -- CodePack          ::= ComponentDesc
          BEGIN
          PushList[1];  save _ PopTree[];
	  PushHash[primaryComponentId.r];  PushTree[save];  PushTree[Tree.nullProcs];
          PushNode[$unnamedCodePack, 3];  LinkToSource[top];  
	  SetAttr[$exceptMAIN, FALSE];  SetAttr[$exceptEV, FALSE];
	  SetAttr[$exceptCatch, FALSE];
          END;

       13  =>   -- CodePack          ::= id : DISCARD CODE PACK tilde InitCodePack CodePackBody
          BEGIN
          save _ PopTree[];
	  PushHash[v[top].r];  PushTree[save];  PushTree[Tree.nullProcs];
          PushNode[$discardCodePack, 3];  LinkToSource[top];
	  SetAttr[$exceptMAIN, exceptMain];  SetAttr[$exceptEV, exceptEV];
	  SetAttr[$exceptCatch, exceptCatch];
          END;

       14  =>   -- InitCodePack     ::= 
          exceptMain _ exceptEV _ exceptCatch _ FALSE;

       15  =>   -- CodePackBody      ::= { Exceptions CompSeries }
                -- CodePackBody      ::= BEGIN Exceptions CompSeries END
          PushList[v[top+2].s];

       16  =>   -- Exceptions        ::= 
          NULL;

       17  =>   -- Exceptions        ::= EXCEPT [ ExceptList ] ;
          NULL;

       18  =>   -- ExceptList        ::= ExceptItem
          NULL;

       19  =>   -- ExceptList        ::= ExceptList , ExceptItem
          NULL;

       20  =>   -- ExceptItem        ::= MAIN
          exceptMain _ TRUE;

       21  =>   -- ExceptItem        ::= ENTRY VECTOR
          exceptEV _ TRUE;

       22  =>   -- ExceptItem        ::= EV
          exceptEV _ TRUE;

       23  =>   -- ExceptItem        ::= CATCH CODE
          exceptCatch _ TRUE;

       24  =>   -- ExceptItem        ::= CATCH
          exceptCatch _ TRUE;

       25  =>	-- CompSeries        ::= ComponentDesc 
          vTop _ [scalar[1]];

       26  =>	-- CompSeries        ::= CompSeries ; ComponentDesc 
          vTop.s _ v[top].s+1;

       27  =>	-- CompSeries        ::= CompSeries ;
          NULL;          -- allows trailing ;

       28  =>   -- ComponentDesc     ::= Component
          {PushNode[$allComp, 1];  LinkToSource[top]};

       29  =>   -- ComponentDesc     ::= Component [ ItemList ]
          {PushList[v[top+2].s];  PushNode[$compItems, 2];  LinkToSource[top]};

       30  =>   -- ComponentDesc     ::= Component EXCEPT [ ItemList ]
          {PushList[v[top+3].s];  PushNode[$exceptItems, 2];  LinkToSource[top]};

       31  =>   -- ComponentDesc     ::= Component EXCEPT PackList
          {PushList[v[top+2].s];  PushNode[$exceptPacks, 2];  LinkToSource[top]};

       32  =>   -- ComponentDesc     ::= Component [ ItemList ] EXCEPT PackList
          BEGIN
          PushList[v[top+5].s];  save _ PopTree[];
          PushList[v[top+2].s];  PushTree[save];  
          PushNode[$itemsExceptPacks, 3];  LinkToSource[top];
          END;

       33  =>   -- ComponentDesc     ::= Component EXCEPT PackList , [ ItemList ]
          BEGIN
          PushList[v[top+5].s];  save _ PopTree[];
          PushList[v[top+2].s];  PushTree[save];  
          PushNode[$exceptPacksItems, 3];  LinkToSource[top]
          END;

       34  =>   -- ComponentDesc     ::= MAIN OF PackList
          {PushList[v[top+2].s];  PushNode[$mainOfPL, 1];  LinkToSource[top]};

       35  =>   -- ComponentDesc     ::= ENTRY VECTOR OF PackList
          {PushList[v[top+3].s];  PushNode[$evOfPL, 1];  LinkToSource[top]};

       36  =>   -- ComponentDesc     ::= EV OF PackList
          {PushList[v[top+2].s];  PushNode[$evOfPL, 1];  LinkToSource[top]};

       37  =>   -- ComponentDesc     ::= CATCH CODE OF PackList
          {PushList[v[top+3].s];  PushNode[$catchOfPL, 1];  LinkToSource[top]};

       38  =>   -- ComponentDesc     ::= CATCH OF PackList
          {PushList[v[top+2].s];  PushNode[$catchOfPL, 1];  LinkToSource[top]};

       39  =>   -- Component         ::= OptQualifiedId
          {PushList[v[top].s];  PushNode[$component, 1];  LinkToSource[top]};

       40  =>   -- OptQualifiedId    ::= id
          {PushHash[v[top].r];  vTop _ [scalar[1]];  primaryComponentId _ v[top]};

       41  =>   -- OptQualifiedId    ::= OptQualifiedId . id
          {PushHash[v[top+2].r];  vTop.s _ v[top].s+1;  primaryComponentId _ v[top+2]};

       42  =>   -- ItemList          ::= Item
          vTop _ [scalar[1]];

       43  =>   -- ItemList          ::= ItemList , Item
          vTop.s _ v[top].s+1;

       44  =>	-- Item              ::= MAIN 
          PushNode[$main, 0];

       45  =>	-- Item              ::= ENTRY VECTOR 
          PushNode[$ev, 0];

       46  =>	-- Item              ::= EV 
          PushNode[$ev, 0];

       47  =>	-- Item              ::= CATCH CODE 
          PushNode[$catch, 0];

       48  =>	-- Item              ::= CATCH 
          PushNode[$catch, 0];

       49  =>	-- Item              ::= id 
          PushHash[v[top].r];

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

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

       52  =>	-- FramePack         ::= id : FRAME PACK tilde FramePackBody 
          BEGIN
	  PushHash[v[top].r];  
          PushNode[$framePack, -2];  LinkToSource[top];
          END;

       53  =>	-- FramePackBody     ::= { CompSeries }
              	-- FramePackBody     ::= BEGIN CompSeries END
          PushList[v[top+1].s];

       54  =>	-- Merge             ::= id : SEGMENT MERGES SegList tilde SegmentBody 
          BEGIN
          save _ PopTree[];  PushList[v[top+4].s];  PushTree[save];
	  PushHash[v[top].r];  
          PushNode[$merge, -3];  LinkToSource[top];  -- N.B. SegList is 3rd son
          END;

       55  =>	-- MergeFramePack    ::= id : FRAME PACK MERGES FpList 
          BEGIN
          PushList[v[top+5].s];
	  PushHash[v[top].r];  
          PushNode[$mergeFP, -2];  LinkToSource[top];
          END;

       56  =>   -- SegList           ::= id
                -- FpList            ::= id
          {PushHash[v[top].r];  vTop _ [scalar[1]]};

       57  =>   -- SegList           ::= SegList , id
                -- FpList            ::= FpList , id
          {PushHash[v[top+2].r];  vTop.s _ v[top].s+1};

       ENDCASE => ERROR;

      v[top] _ vTop;
      ENDLOOP;
    END;

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

  }.