home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / APPS / lout2.lzh / LOUT2 / z06.c < prev    next >
Text File  |  1994-01-23  |  28KB  |  903 lines
  1. /*@z06.c:Parser:PushObj(), PushToken(), etc.@*********************************/
  2. /*                                                                           */
  3. /*  LOUT: A HIGH-LEVEL LANGUAGE FOR DOCUMENT FORMATTING (VERSION 2.05)       */
  4. /*  COPYRIGHT (C) 1993 Jeffrey H. Kingston                                   */
  5. /*                                                                           */
  6. /*  Jeffrey H. Kingston (jeff@cs.su.oz.au)                                   */
  7. /*  Basser Department of Computer Science                                    */
  8. /*  The University of Sydney 2006                                            */
  9. /*  AUSTRALIA                                                                */
  10. /*                                                                           */
  11. /*  This program is free software; you can redistribute it and/or modify     */
  12. /*  it under the terms of the GNU General Public License as published by     */
  13. /*  the Free Software Foundation; either version 1, or (at your option)      */
  14. /*  any later version.                                                       */
  15. /*                                                                           */
  16. /*  This program is distributed in the hope that it will be useful,          */
  17. /*  but WITHOUT ANY WARRANTY; without even the implied warranty of           */
  18. /*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            */
  19. /*  GNU General Public License for more details.                             */
  20. /*                                                                           */
  21. /*  You should have received a copy of the GNU General Public License        */
  22. /*  along with this program; if not, write to the Free Software              */
  23. /*  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.                */
  24. /*                                                                           */
  25. /*  FILE:         z06.c                                                      */
  26. /*  MODULE:       Parser                                                     */
  27. /*  EXTERNS:      InitParser(), Parse()                                      */
  28. /*                                                                           */
  29. /*****************************************************************************/
  30. #include "externs"
  31. #define    LEFT_ASSOC    0
  32. #define    RIGHT_ASSOC    1
  33. static    OBJECT        cross_name;    /* name of the cr database   */
  34.  
  35.  
  36. #define    MAX_STACK    50            /* size of parser stacks     */
  37. static    OBJECT        obj_stack[MAX_STACK];    /* stack of objects          */
  38. static    int        otop = -1;        /* top of obj_stack          */
  39. static    OBJECT        tok_stack[MAX_STACK];    /* stack of tokens           */
  40. static    int        ttop = -1;        /* top of tok_stack          */
  41. static    BOOLEAN        obj_prev;        /* TRUE when object is prev  */
  42.  
  43.  
  44. /*****************************************************************************/
  45. /*                                                                           */
  46. /*  PushObj(x)                                                               */
  47. /*  PushToken(t)                                                             */
  48. /*  OBJECT PopObj()                                                          */
  49. /*  OBJECT PopToken()                                                        */
  50. /*  OBJECT TokenTop                                                          */
  51. /*  OBJECT ObjTop                                                            */
  52. /*                                                                           */
  53. /*  Push and pop from the object and token stacks; examine top item.         */
  54. /*                                                                           */
  55. /*****************************************************************************/
  56.  
  57. #define PushObj(x)                            \
  58. { zz_hold = x;                                \
  59.   if( ++otop < MAX_STACK ) obj_stack[otop] = zz_hold;            \
  60.   else Error(FATAL, &fpos(obj_stack[otop-1]),                \
  61.     "object stack overflow: need to simplify expression");        \
  62. }
  63.  
  64. #define PushToken(t)                            \
  65. { if( ++ttop < MAX_STACK ) tok_stack[ttop] = t;                \
  66.   else Error(FATAL, &fpos(tok_stack[ttop-1]),                \
  67.     "operator stack overflow: need to simplify expression");    \
  68. }
  69.  
  70. #define PopObj()    obj_stack[otop--]
  71. #define PopToken()    tok_stack[ttop--]
  72. #define    TokenTop    tok_stack[ttop]
  73. #define    ObjTop        obj_stack[otop]
  74.  
  75.  
  76. /*@::DebugStacks(), InsertSpace(), Shift(), ShiftObj()@***********************/
  77. /*                                                                           */
  78. /*  DebugStacks()                                                            */
  79. /*                                                                           */
  80. /*  Print debug output of the stacks state                                   */
  81. /*                                                                           */
  82. /*****************************************************************************/
  83.  
  84. #if DEBUG_ON
  85. static DebugStacks(initial_ttop)
  86. int initial_ttop;
  87. { int i;
  88.   fprintf(stderr, "obj_prev: %s; otop: %d; ttop: %d\n",
  89.     bool(obj_prev), otop, ttop);
  90.   for( i = 0;  i <= otop; i++ )
  91.     fprintf(stderr, "obj[%d] = %s\n", i, EchoObject(obj_stack[i]));
  92.   for( i = 0;  i <= ttop;  i++ )
  93.   { if( i == initial_ttop+1 ) fprintf(stderr, "$\n");
  94.     fprintf(stderr, "tok[%d] = %s.%d\n", i, type(tok_stack[i]) == CLOSURE ?
  95.     SymName(actual(tok_stack[i])) : Image(type(tok_stack[i])),
  96.     precedence(tok_stack[i]));
  97.   }
  98. }
  99. #endif
  100.  
  101.  
  102. /*****************************************************************************/
  103. /*                                                                           */
  104. /*  InsertSpace(t)                                                           */
  105. /*                                                                           */
  106. /*  Add any missing catenation operator in front of token t.                 */
  107. /*                                                                           */
  108. /*****************************************************************************/
  109.  
  110. #define InsertSpace(t)                            \
  111. if( obj_prev )                                \
  112. { int typ, prec;                            \
  113.   if( hspace(t) + vspace(t) > 0 )  typ = TSPACE, prec = ACAT_PREC;    \
  114.   else typ = TJUXTA, prec = JUXTA_PREC;                    \
  115.   while( obj_prev && precedence(TokenTop) >= prec )  Reduce();        \
  116.   if( obj_prev )                            \
  117.   { tmp = New(typ);  precedence(tmp) = prec;                \
  118.     vspace(tmp) = vspace(t);  hspace(tmp) = hspace(t);            \
  119.     mark(gap(tmp)) = FALSE;  join(gap(tmp)) = TRUE;            \
  120.     FposCopy(fpos(tmp), fpos(t));                    \
  121.     PushToken(tmp);                            \
  122.   }                                    \
  123. } /* end InsertSpace */
  124.  
  125.  
  126. /*****************************************************************************/
  127. /*                                                                           */
  128. /*  static Shift(t, prec, rassoc, leftpar, rightpar)                         */
  129. /*  static ShiftObj(t)                                                       */
  130. /*                                                                           */
  131. /*  Shift token or object t onto the stacks; it has the attributes shown.    */
  132. /*                                                                           */
  133. /*****************************************************************************/
  134.  
  135. #define Shift(t, prec, rassoc, leftpar, rightpar)            \
  136. { if( leftpar )                                \
  137.   { for(;;)                                \
  138.     { if( !obj_prev )                            \
  139.       {    PushObj( MakeWord(WORD, STR_EMPTY, &fpos(t)) );            \
  140.     obj_prev = TRUE;                        \
  141.       }                                    \
  142.       else if( precedence(TokenTop) >= prec + rassoc )     Reduce();    \
  143.       else break;                            \
  144.     }                                    \
  145.   }                                    \
  146.   else InsertSpace(t);                            \
  147.   PushToken(t);                                \
  148.   if( rightpar )  obj_prev = FALSE;                    \
  149.   else { obj_prev = TRUE;  Reduce(); }                     \
  150. } /* end Shift */
  151.  
  152. #define ShiftObj(t) { InsertSpace(t); PushObj(t);  obj_prev = TRUE; }
  153.  
  154. /*@::Reduce()@****************************************************************/
  155. /*                                                                           */
  156. /*  static Reduce()                                                          */
  157. /*                                                                           */
  158. /*  Perform a single reduction of the stacks.                                */
  159. /*                                                                           */
  160. /*****************************************************************************/
  161.  
  162. static Reduce()
  163. { OBJECT p1, p2, p3, s1, s2, tmp;
  164.   OBJECT op;
  165.   assert( obj_prev, "Reduce: obj_prev!" );
  166.  
  167.   op = PopToken();
  168.   obj_prev = TRUE;
  169.   switch( type(op) )
  170.   {
  171.  
  172.     case GSTUB_INT:
  173.     case GSTUB_EXT:
  174.     
  175.     TransferEnd( PopObj() );
  176.     obj_prev = TRUE;
  177.     PushObj(New(NULL_CLOS));
  178.     Dispose(op);
  179.     break;
  180.  
  181.  
  182.     case GSTUB_NONE:
  183.  
  184.     PushObj(New(NULL_CLOS));
  185.     Dispose(op);
  186.     break;
  187.  
  188.  
  189.     case NULL_CLOS:
  190.     case CROSS:
  191.     case ONE_ROW:
  192.     case ONE_COL:
  193.     case WIDE:
  194.     case HIGH:
  195.     case HSCALE:
  196.     case VSCALE:
  197.     case SCALE:
  198.     case HCONTRACT:
  199.     case VCONTRACT:
  200.     case HEXPAND:
  201.     case VEXPAND:
  202.     case PADJUST:
  203.     case HADJUST:
  204.     case VADJUST:
  205.     case ROTATE:
  206.     case CASE:
  207.     case YIELD:
  208.     case XCHAR:
  209.     case FONT:
  210.     case SPACE:
  211.     case BREAK:
  212.     case NEXT:
  213.     case TAGGED:
  214.     case INCGRAPHIC:
  215.     case SINCGRAPHIC:
  216.     case GRAPHIC:
  217.     case OPEN:
  218.  
  219.     if( has_rpar(actual(op)) )
  220.     { s2 = PopObj();
  221.       Link(op, s2);
  222.     }
  223.     if( has_lpar(actual(op)) )
  224.     { s1 = PopObj();
  225.       Link(Down(op), s1);
  226.       if( type(op)==CROSS && type(s1)!=CLOSURE ) Error(WARN, &fpos(s1),
  227.         "left parameter of %s is not a symbol (or not visible)", KW_CROSS);
  228.     }
  229.     PushObj(op);
  230.     break;
  231.  
  232.  
  233.     case CLOSURE:
  234.     
  235.     if( has_rpar(actual(op)) )
  236.     { s2 = New(PAR);
  237.       tmp = PopObj();
  238.       Link(s2, tmp);
  239.       FposCopy(fpos(s2), fpos(tmp));
  240.       actual(s2) = ChildSym(actual(op), RPAR);
  241.       Link(op, s2);
  242.     }
  243.     if( has_lpar(actual(op)) )
  244.     { s1 = New(PAR);
  245.       tmp = PopObj();
  246.       Link(s1, tmp);
  247.       FposCopy(fpos(s1), fpos(tmp));
  248.       actual(s1) = ChildSym(actual(op), LPAR);
  249.       Link(Down(op), s1);
  250.     }
  251.     PushObj(op);
  252.     break;
  253.  
  254.  
  255.     case LBR:
  256.     
  257.     Error(WARN, &fpos(op), "unmatched %s - inserted %s", KW_LBR, KW_RBR);
  258.     Dispose(op);
  259.     break;
  260.  
  261.  
  262.     case BEGIN:
  263.     
  264.     Error(INTERN,&fpos(op), "Reduce: unmatched %s", KW_BEGIN);
  265.     break;
  266.  
  267.  
  268.     case RBR:
  269.     
  270.     if( type(TokenTop) == LBR )
  271.     { /* *** FposCopy(fpos(ObjTop), fpos(TokenTop)); *** */
  272.       Dispose( PopToken() );
  273.     }
  274.     else if( type(TokenTop) == BEGIN )
  275.       Error(WARN, &fpos(op), "unmatched %s; inserted %s at%s (after %s)",
  276.         KW_RBR, KW_LBR, EchoFilePos(&fpos(TokenTop)), KW_BEGIN);
  277.     else Error(INTERN, &fpos(op), "Reduce: unmatched %s", KW_RBR);
  278.     Dispose(op);
  279.     break;
  280.  
  281.  
  282.     case END:
  283.     
  284.     if( type(TokenTop) != BEGIN )
  285.       Error(INTERN, &fpos(op), "Reduce: unmatched %s", KW_END);
  286.     else
  287.     { if( actual(op) != actual(TokenTop) )
  288.         if( actual(op) == StartSym )
  289.           Error(WARN, &fpos(op),
  290.         "%s %s appended at end of file to match %s at%s",
  291.         KW_END, SymName(actual(TokenTop)),
  292.         KW_BEGIN, EchoFilePos(&fpos(TokenTop)) );
  293.         else if( actual(op) == nil )
  294.           Error(WARN, &fpos(op),
  295.         "%s replaced by %s %s to match %s at%s", KW_END, KW_END,
  296.         SymName(actual(TokenTop)),
  297.         KW_BEGIN, EchoFilePos(&fpos(TokenTop)) );
  298.         else
  299.           Error(WARN, &fpos(op),
  300.         "%s %s replaced by %s %s to match %s at%s",
  301.         KW_END, SymName(actual(op)), KW_END, SymName(actual(TokenTop)),
  302.         KW_BEGIN, EchoFilePos(&fpos(TokenTop)) );
  303.       Dispose( PopToken() );
  304.     }
  305.     Dispose(op);
  306.     break;
  307.  
  308.  
  309.     case GAP_OBJ:
  310.  
  311.     p1 = PopObj();
  312.     Link(op, p1);
  313.     PushObj(op);
  314.     obj_prev = FALSE;
  315.     break;
  316.  
  317.  
  318.     case VCAT:
  319.     case HCAT:
  320.     case ACAT:
  321.     
  322.     p3 = PopObj();  p2 = PopObj();  p1 = PopObj();
  323.     if( type(p1) == type(op) )  Dispose(op);
  324.     else
  325.     { Link(op, p1);
  326.       p1 = op;
  327.     }
  328.     Link(p1, p2);
  329.     Link(p1, p3);
  330.     PushObj(p1);
  331.     break;
  332.  
  333.  
  334.     case TSPACE:
  335.     case TJUXTA:
  336.  
  337.     p2 = PopObj();  p1 = PopObj();
  338.     if( type(p1) != ACAT )
  339.     { tmp = New(ACAT);
  340.       Link(tmp, p1);
  341.       FposCopy(fpos(tmp), fpos(p1));
  342.       p1 = tmp;
  343.     }
  344.     type(op) = GAP_OBJ;
  345.     Link(p1, op);
  346.     Link(p1, p2);
  347.     PushObj(p1);
  348.     break;
  349.  
  350.  
  351.     default:
  352.     
  353.     Error(INTERN, &fpos(op), "Reduce: %s", Image(type(op)) );
  354.     break;
  355.  
  356.   } /* end switch */
  357.   debug0(DOP, DD, "Reduce returning; ");
  358.   ifdebug(DOP, DD, DebugStacks(0) );
  359. } /* end Reduce */
  360.  
  361.  
  362. /*@::SetScope(), InitParser()@************************************************/
  363. /*                                                                           */
  364. /*  static SetScope(env, count)                                              */
  365. /*                                                                           */
  366. /*  Push scopes required to parse object whose environment is env.           */
  367. /*  Add to *count the number of scope pushes made.                           */
  368. /*                                                                           */
  369. /*****************************************************************************/
  370.  
  371. static SetScope(env, count)
  372. OBJECT env;  int *count;
  373. { OBJECT link, y, yenv;
  374.   debug2(DOP, D, "SetScope( %s, %d )", EchoObject(env), *count);
  375.   assert( env != nil && type(env) == ENV, "SetScope: type(env) != ENV!" );
  376.   if( Down(env) != env )
  377.   { Child(y, Down(env));
  378.     assert( LastDown(y) != y, "SetScope: LastDown(y)!" );
  379.     link = LastDown(env) != Down(env) ? LastDown(env) : LastDown(y);
  380.     Child(yenv, link);
  381.     assert( type(yenv) == ENV, "SetScope: type(yenv) != ENV!" );
  382.     SetScope(yenv, count);
  383.     PushScope(actual(y), FALSE, FALSE);  (*count)++;
  384.   }
  385.   debug1(DOP, D, "SetScope returning, count = %d", *count);
  386. } /* end SetScope */
  387.  
  388.  
  389. /*****************************************************************************/
  390. /*                                                                           */
  391. /*  InitParser()                                                             */
  392. /*                                                                           */
  393. /*  Initialise the parser to contain just GstubExt.                          */
  394. /*  Remember cross_db, the name of the cross reference database, for Parse.  */
  395. /*                                                                           */
  396. /*****************************************************************************/
  397.  
  398. InitParser(cross_db)
  399. FULL_CHAR *cross_db;
  400. { if( StringLength(cross_db) >= MAX_LINE )  Error(FATAL, no_fpos,
  401.     "cross reference database file name %s is too long", cross_db);
  402.   cross_name = MakeWord(WORD, cross_db, no_fpos);
  403.   PushToken( NewToken(GSTUB_EXT, no_fpos, 0, 0, DEFAULT_PREC, StartSym) );
  404. } /* end InitParser */
  405.  
  406.  
  407. /*@::ParseEnvClosure()@*******************************************************/
  408. /*                                                                           */
  409. /*  static OBJECT ParseEnvClosure(t, encl)                                   */
  410. /*                                                                           */
  411. /*  Parse an object which is a closure with environment.  Consume the        */
  412. /*  concluding @Clos.                                                        */
  413. /*                                                                           */
  414. /*****************************************************************************/
  415.  
  416. static OBJECT ParseEnvClosure(t, encl)
  417. OBJECT t, encl;
  418. { OBJECT env, res, y;  int count, i;
  419.   debug0(DOP, DD, "ParseEnvClosure(t, encl)");
  420.   assert( type(t) == ENV, "ParseEnvClosure: type(t) != ENV!" );
  421.   env = t;  t = LexGetToken();
  422.   while( type(t) != CLOS )  switch( type(t) )
  423.   {
  424.     case LBR:    count = 0;
  425.         SetScope(env, &count);
  426.         y = Parse(&t, encl, FALSE, FALSE);
  427.         if( type(y) != CLOSURE )  Error(FATAL, &fpos(y),
  428.             "syntax error in cross reference database");
  429.         for( i = 1;  i <= count;  i++ )  PopScope();
  430.         AttachEnv(env, y);
  431.         debug0(DCR, DD, "  calling SetEnv from ParseEnvClosure (a)");
  432.         env = SetEnv(y, nil);
  433.         t = LexGetToken();
  434.         break;
  435.  
  436.     case ENV:    y = ParseEnvClosure(t, encl);
  437.         debug0(DCR, DD, "  calling SetEnv from ParseEnvClosure (b)");
  438.         env = SetEnv(y, env);
  439.         t = LexGetToken();
  440.         break;
  441.  
  442.     default:    Error(FATAL, &fpos(t), "error in cross reference database");
  443.         break;
  444.   }
  445.   Dispose(t);
  446.   if( Down(env) == env || Down(env) != LastDown(env) )
  447.     Error(FATAL, &fpos(env), "error in cross reference database");
  448.   Child(res, Down(env));
  449.   DeleteNode(env);
  450.   debug1(DOP, DD, "ParseEnvClosure returning %s", EchoObject(res));
  451.   assert( type(res) == CLOSURE, "ParseEnvClosure: type(res) != CLOSURE!" );
  452.   return res;
  453. } /* end ParseEnvClosure */
  454.  
  455.  
  456. /*@::Parse()@*****************************************************************/
  457. /*                                                                           */
  458. /*  OBJECT Parse(token, encl, defs_allowed, transfer_allowed)                */
  459. /*                                                                           */
  460. /*  Parse input tokens, beginning with *token, looking for an object of the  */
  461. /*  form { ... } or @Begin ... @End <sym>, and return the object.            */
  462. /*  The parent definition is encl, and scope has been set appropriately.     */
  463. /*  Parse reads up to and including the last token of the object             */
  464. /*  (the right brace or <sym>), and returns nil in *token.                   */
  465. /*                                                                           */
  466. /*  If defs_allowed == TRUE, there may be local definitions in the object.   */
  467. /*  In this case, encl is guaranteed to be the enclosing definition.         */
  468. /*                                                                           */
  469. /*  If transfer_allowed == TRUE, the parser may transfer components to the   */
  470. /*  galley handler as they are read.                                         */
  471. /*                                                                           */
  472. /*  Note: the lexical analyser returns "@End \Input" at end of input, so the */
  473. /*  parser does not have to handle end of input separately.                  */
  474. /*                                                                           */
  475. /*****************************************************************************/
  476.  
  477. OBJECT Parse(token, encl, defs_allowed, transfer_allowed)
  478. OBJECT *token, encl;  BOOLEAN defs_allowed, transfer_allowed;
  479. { OBJECT t, x, tmp, xsym, env, y, res;
  480.   int i, initial_ttop = ttop;
  481.  
  482.   debug4(DOP, D, "[ Parse(%s, %s, %s, %s)", EchoToken(*token),
  483.     SymName(encl), bool(defs_allowed), bool(transfer_allowed));
  484.   assert( type(*token) == LBR || type(*token) == BEGIN, "Parse: *token!" );
  485.  
  486.   obj_prev = FALSE;
  487.   Shift(*token, precedence(*token), 0, FALSE, TRUE);
  488.   t = LexGetToken();
  489.   if( defs_allowed )
  490.   { ReadDefinitions(&t, encl, LOCAL);
  491.     if( encl == StartSym ) /* transition point from defs to content */
  492.     {
  493.       /* if error in definitions, stop now */
  494.       if( ErrorSeen() )  Error(FATAL, &fpos(t), "Exiting now");
  495.  
  496.       /* load cross-references from previous run, open new cross refs */
  497.       if( AllowCrossDb )
  498.       {    NewCrossDb = DbCreate(MakeWord(WORD, string(cross_name), no_fpos));
  499.     OldCrossDb = DbLoad(cross_name, SOURCE_PATH, FALSE, nil);
  500.       }
  501.       else OldCrossDb = NewCrossDb = nil;
  502.  
  503.       /* tidy up and possibly print symbol table */
  504.       FlattenUses();
  505.       ifdebug(DST, D, DebugObject(StartSym));
  506.  
  507.       /* read @Use, @Database, and @Prepend commands and construct env */
  508.       env = New(ENV);
  509.       for(;;)
  510.       {    if( type(t) == USE )
  511.     {
  512.       OBJECT crs, res_env;  STYLE style;
  513.       Dispose(t);  t = LexGetToken();
  514.       if( type(t) != LBR )
  515.         Error(FATAL, &fpos(t), "%s expected after %s", KW_LBR, KW_USE);
  516.       y = Parse(&t, encl, FALSE, FALSE);
  517.       if( type(y) == CROSS )
  518.       { y = CrossExpand(y, env, &style, FALSE, &crs, &res_env);
  519.         AttachEnv(res_env, y);
  520.         debug0(DCR, DD, "  calling SetEnv from Parse (a)");
  521.         env = SetEnv(y, env);
  522.       }
  523.       else if( type(y) == CLOSURE )
  524.       { AttachEnv(env, y);
  525.         debug0(DCR, DD, "  calling SetEnv from Parse (b)");
  526.         env = SetEnv(y, nil);
  527.       }
  528.       else Error(FATAL, &fpos(y), "invalid parameter of %s", KW_USE);
  529.       PushScope(actual(y), FALSE, TRUE);
  530.       t = LexGetToken();
  531.         }
  532.     else if( type(t) == PREPEND || type(t) == SYS_PREPEND )
  533.     { ReadPrependDef(type(t), encl);
  534.       Dispose(t);
  535.       t = LexGetToken();
  536.     }
  537.     else if( type(t) == DATABASE || type(t) == SYS_DATABASE )
  538.     { ReadDatabaseDef(type(t), encl);
  539.       Dispose(t);
  540.       t = LexGetToken();
  541.     }
  542.     else break;
  543.       }
  544.       TransferInit(env);
  545.     }
  546.   }
  547.  
  548.   for(;;)
  549.   { 
  550.     ifdebug(DOP, DD, DebugStacks(initial_ttop) );
  551.     debug2(DOP, DD, ">> %s.%d", EchoToken(t), precedence(t) );
  552.  
  553.     switch( type(t) )
  554.     {
  555.  
  556.       case WORD:
  557.       
  558.     if( string(t)[0] == CH_SYMSTART )
  559.       Error(WARN, &fpos(t), "symbol %s unknown or misspelt", string(t));
  560.     ShiftObj(t);
  561.     t = LexGetToken();
  562.     break;
  563.  
  564.  
  565.       case QWORD:
  566.       
  567.     ShiftObj(t);
  568.     t = LexGetToken();
  569.     break;
  570.  
  571.  
  572.       case VCAT:
  573.       case HCAT:
  574.       case ACAT:
  575.       
  576.     /* clean up left context */
  577.     Shift(t, precedence(t), LEFT_ASSOC, TRUE, TRUE);
  578.  
  579.     /* invoke transfer subroutines if appropriate */
  580.     if( type(t) == VCAT && !has_join(actual(t))
  581.         && type(tok_stack[ttop-2]) == GSTUB_EXT )
  582.     { TransferComponent( PopObj() );
  583.       obj_prev = FALSE;
  584.       tmp = New(NULL_CLOS);
  585.       FposCopy( fpos(tmp), fpos(t) );
  586.       PushObj(tmp);
  587.     }
  588.  
  589.     /* push GAP_OBJ token, to cope with 3 parameters */
  590.     x = New(GAP_OBJ);
  591.     mark(gap(x)) = has_mark(actual(t));
  592.     join(gap(x)) = has_join(actual(t));
  593.     precedence(x) = GAP_PREC;
  594.     FposCopy( fpos(x), fpos(t) );
  595.     Shift(x, GAP_PREC, LEFT_ASSOC, FALSE, TRUE);
  596.  
  597.     /* if op is followed by space, insert {} */
  598.     t = LexGetToken();
  599.     if( hspace(t) + vspace(t) > 0 )
  600.     { ShiftObj(MakeWord(WORD, STR_EMPTY, &fpos(x)));
  601.     }
  602.     break;
  603.  
  604.  
  605.       case CROSS:
  606.       case NULL_CLOS:
  607.       case ONE_COL:
  608.       case ONE_ROW:
  609.       case WIDE:
  610.       case HIGH:
  611.       case HSCALE:
  612.       case VSCALE:
  613.       case SCALE:
  614.       case HCONTRACT:
  615.       case VCONTRACT:
  616.       case HEXPAND:
  617.       case VEXPAND:
  618.       case PADJUST:
  619.       case HADJUST:
  620.       case VADJUST:
  621.       case ROTATE:
  622.       case CASE:
  623.       case YIELD:
  624.       case XCHAR:
  625.       case FONT:
  626.       case SPACE:
  627.       case BREAK:
  628.       case NEXT:
  629.       case TAGGED:
  630.       case INCGRAPHIC:
  631.       case SINCGRAPHIC:
  632.       case GRAPHIC:
  633.  
  634.     /* clean up left context of t (these ops are all right associative) */
  635.     Shift(t, precedence(t), RIGHT_ASSOC,
  636.         has_lpar(actual(t)), has_rpar(actual(t)));
  637.     t = LexGetToken();
  638.     break;
  639.  
  640.  
  641.       case BEGIN:
  642.       
  643.     if( actual(t) == nil )
  644.     { Error(WARN, &fpos(t), "%s replaced by %s", KW_BEGIN, KW_LBR);
  645.       type(t) = LBR;
  646.     }
  647.     /* NB NO BREAK! */
  648.  
  649.  
  650.       case LBR:
  651.       
  652.     Shift(t, LBR_PREC, 0, FALSE, TRUE);
  653.     t = LexGetToken();
  654.     break;
  655.  
  656.  
  657.       case END:
  658.       
  659.     x = LexGetToken();
  660.     if( type(x) == CLOSURE )
  661.     { actual(t) = actual(x);
  662.       Dispose(x);
  663.       x = nil;
  664.     }
  665.     else if( type(x) == WORD && string(x)[0] == CH_SYMSTART )
  666.     { Error(WARN,&fpos(x),"unknown or misspelt symbol %s after %s deleted",
  667.         string(x), KW_END);
  668.       actual(t) = nil;
  669.       Dispose(x);
  670.       x = nil;
  671.     }
  672.     else
  673.     { Error(WARN, &fpos(x), "symbol expected after %s", KW_END);
  674.       actual(t) = nil;
  675.     }
  676.     Shift(t, precedence(t), 0, TRUE, FALSE);
  677.     if( ttop == initial_ttop )
  678.     { ifdebug(DOP, DD, DebugStacks(initial_ttop));
  679.       *token = x;
  680.       debug0(DOP, D, "] Parse returning");
  681.       ifdebug(DOP, D, DebugObject(ObjTop));
  682.       obj_prev = FALSE;
  683.       return PopObj();
  684.     }
  685.     t = (x != nil) ? x : LexGetToken();
  686.     break;
  687.  
  688.  
  689.       case RBR:
  690.       
  691.     Shift(t, precedence(t), 0, TRUE, FALSE);
  692.     if( ttop == initial_ttop )
  693.     { ifdebug(DOP, DD, DebugStacks(initial_ttop));
  694.       *token = nil;
  695.       debug0(DOP, D, "] Parse returning");
  696.       ifdebug(DOP, D, DebugObject(ObjTop));
  697.       obj_prev = FALSE;
  698.       return PopObj();
  699.     }
  700.     t = LexGetToken();
  701.     break;
  702.                 
  703.  
  704.       case USE:
  705.       case PREPEND:
  706.       case SYS_PREPEND:
  707.       case DATABASE:
  708.       case SYS_DATABASE:
  709.       
  710.     Error(FATAL, &fpos(t), "%s symbol out of place", SymName(actual(t)));
  711.     break;
  712.  
  713.  
  714.       case ENV:
  715.       
  716.     /* only occurs in cross reference databases */
  717.     res = ParseEnvClosure(t, encl);
  718.     ShiftObj(res);
  719.     t = LexGetToken();
  720.     break;
  721.  
  722.  
  723.       case LVIS:
  724.       
  725.     /* only occurs in cross-reference databases */
  726.     SuppressVisible();
  727.     Dispose(t);  t = LexGetToken();
  728.     UnSuppressVisible();
  729.     if( type(t) != CLOSURE )
  730.       Error(FATAL, &fpos(t), "symbol expected following %s", KW_LVIS);
  731.     /* NB NO BREAK! */
  732.  
  733.  
  734.       case CLOSURE:
  735.       
  736.     x = t;  xsym = actual(x);
  737.  
  738.     /* look ahead one token, which could be an NPAR */
  739.     PushScope(xsym, TRUE, FALSE);
  740.     t = LexGetToken();
  741.     PopScope();
  742.  
  743.     /* if x starts a cross-reference, make it a CLOSURE */
  744.     if( type(t) == CROSS )
  745.     { ShiftObj(x);
  746.       break;
  747.     }
  748.  
  749.     /* clean up left context of x */
  750.     Shift(x, precedence(x),right_assoc(xsym),has_lpar(xsym),has_rpar(xsym));
  751.  
  752.     /* update uses relation if required */
  753.     if( encl != StartSym )
  754.     { if( !has_target(xsym) )  InsertUses(encl, xsym);
  755.       else uses_galley(encl) = TRUE;
  756.     }
  757.  
  758.     /* read named parameters */
  759.     while( type(t) == CLOSURE && enclosing(actual(t)) == xsym
  760.                        && type(actual(t)) == NPAR )
  761.     {    
  762.       /* check syntax and attach the named parameter to x */
  763.       OBJECT new_par = t;
  764.       t = LexGetToken();
  765.       if( type(t) != LBR )
  766.       { Error(WARN, &fpos(new_par), "%s must follow named parameter %s",
  767.           KW_LBR, SymName(actual(new_par)));
  768.         Dispose(new_par);
  769.         break;
  770.       }
  771.  
  772.       /* read the body of the named parameter */
  773.       PushScope(actual(new_par), FALSE, FALSE);
  774.       tmp = Parse(&t, encl, FALSE, FALSE);
  775.       type(new_par) = PAR;
  776.       Link(x, new_par);
  777.       Link(new_par, tmp);
  778.       PopScope();
  779.  
  780.       /* get next token, possibly another NPAR */
  781.       PushScope(xsym, TRUE, FALSE);     /* allow NPARs only */
  782.       if( t == nil )  t = LexGetToken();
  783.       PopScope();
  784.  
  785.     } /* end while */
  786.     obj_prev = !has_rpar(xsym);
  787.  
  788.     /* record symbol name in BEGIN following, if any */
  789.     if( type(t) == BEGIN )
  790.     { if( !has_rpar(xsym) )
  791.         Error(WARN, &fpos(x), "%s takes no right parameter", SymName(xsym));
  792.       else actual(t) = xsym;
  793.     }
  794.  
  795.     /* if x can be transferred, do so */
  796.     if( transfer_allowed && has_target(xsym) && !has_key(xsym) )
  797.     {   
  798.       if( !has_rpar(xsym) || uses_count(ChildSym(xsym, RPAR)) <= 1 )
  799.       {
  800.         debug1(DGT, DD, "examining transfer of %s", SymName(xsym));
  801.         ifdebug(DGT, DD, DebugStacks(initial_ttop));
  802.         i = has_rpar(xsym) ? ttop -1 : ttop;
  803.         while( is_cat_op(type(tok_stack[i])) )   i--;
  804.         if( (type(tok_stack[i])==LBR || type(tok_stack[i])==BEGIN)
  805.           && type(tok_stack[i-1]) == GSTUB_EXT )
  806.         {
  807.           /* at this point it is likely that x is transferable */
  808.           if( has_rpar(xsym) )
  809.           { tmp = New(CLOSURE);
  810.         actual(tmp) = InputSym;
  811.         FposCopy( fpos(tmp), fpos(t) );
  812.         PushObj(tmp);  obj_prev = TRUE;
  813.         Reduce();
  814.           }
  815.           x = PopObj();
  816.           x = TransferBegin(x);
  817.           if( type(x) == CLOSURE )    /* failure: unReduce */
  818.           {    if( has_rpar(xsym) )
  819.         { Child(tmp, LastDown(x));
  820.           assert(type(tmp)==PAR && type(actual(tmp))==RPAR,
  821.                 "Parse: cannot undo rpar" );
  822.           DisposeChild(LastDown(x));
  823.           if( has_lpar(xsym) )
  824.           { Child(tmp, Down(x));
  825.             assert(type(tmp)==PAR && type(actual(tmp))==LPAR,
  826.                 "Parse: cannot undo lpar" );
  827.             Child(tmp, Down(tmp));
  828.             PushObj(tmp);
  829.             DeleteLink(Up(tmp));
  830.             DisposeChild(Down(x));
  831.           }
  832.           PushToken(x);  obj_prev = FALSE;
  833.         }
  834.         else
  835.         { PushObj(x);
  836.           obj_prev = TRUE;
  837.         }
  838.           }
  839.           else /* success */
  840.           { obj_prev = FALSE;
  841.             Shift(x, NO_PREC, 0, FALSE, has_rpar(xsym));
  842.           }
  843.         }
  844.       }
  845.     } /* end if has_target */
  846.  
  847.     if( has_body(xsym) )
  848.     { if( type(t) == BEGIN || type(t) == LBR )
  849.       { PushScope(xsym, FALSE, TRUE);
  850.         PushScope(ChildSym(xsym, RPAR), FALSE, FALSE);
  851.         PushObj( Parse(&t, encl, FALSE, TRUE) );
  852.         obj_prev = TRUE;
  853.         Reduce();
  854.         PopScope();
  855.         PopScope();
  856.         if( t == nil )  t = LexGetToken();
  857.       }
  858.       else
  859.       { Error(WARN, &fpos(t),
  860.           "%s parameter of %s must be enclosed in %s .. %s",
  861.           KW_BODY, SymName(xsym), KW_LBR, KW_RBR);
  862.       }
  863.     }
  864.     break;
  865.  
  866.  
  867.       case OPEN:
  868.  
  869.     x = t;  xsym = nil;
  870.     Shift(t, precedence(t), RIGHT_ASSOC, TRUE, TRUE);
  871.     if( type(ObjTop) == CLOSURE )  xsym = actual(ObjTop);
  872.     else if( type(ObjTop) == CROSS && Down(ObjTop) != ObjTop )
  873.     { Child(tmp, Down(ObjTop));
  874.       if( type(tmp) == CLOSURE )  xsym = actual(tmp);
  875.     }
  876.     t = LexGetToken();
  877.  
  878.     if( xsym == nil )  Error(WARN, &fpos(x),
  879.       "invalid left parameter of %s", KW_OPEN);
  880.     else if( type(t) != BEGIN && type(t) != LBR )
  881.       Error(WARN, &fpos(t), "%s parameter of %s not enclosed in %s .. %s",
  882.         KW_RIGHT, KW_OPEN, KW_LBR, KW_RBR);
  883.     else
  884.     { PushScope(xsym, FALSE, TRUE);
  885.       tmp = Parse(&t, encl, FALSE, FALSE);
  886.       ShiftObj(tmp);
  887.       PopScope();
  888.       if( t == nil )  t = LexGetToken();
  889.       Reduce();
  890.     }
  891.     break;
  892.  
  893.  
  894.       default:
  895.       
  896.     Error(INTERN, &fpos(t), "Parse: type %s", Image(type(t)) );
  897.     break;
  898.  
  899.     } /* end switch */
  900.   } /* end for */
  901.  
  902. } /* end Parse */
  903.