home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / SOURCE / PARSER.C < prev    next >
C/C++ Source or Header  |  1996-06-04  |  20KB  |  987 lines
  1. /* Copyright 1991 Digital Equipment Corporation.
  2. ** Distributed only by permission.
  3. **
  4. ** Last modified on Thu Mar  3 14:16:16 MET 1994 by rmeyer
  5. **      modified on Mon Sep 27 09:37:03 1993 by Rmeyer
  6. **      modified on Tue Jun  9 14:03:14 1992 by vanroy
  7. **      modified on Thu Aug 22 18:14:49 1991 by herve
  8. *****************************************************************/
  9. /*     $Id: parser.c,v 1.2 1994/12/08 23:32:03 duchier Exp $     */
  10.  
  11. #ifndef lint
  12. static char vcid[] = "$Id: parser.c,v 1.2 1994/12/08 23:32:03 duchier Exp $";
  13. #endif /* lint */
  14.  
  15. #include "extern.h"
  16. #include "memory.h"
  17. #include "trees.h"
  18. #include "token.h"
  19. #include "print.h"
  20. #include "copy.h"
  21. #include "modules.h"
  22. #include "login.h"
  23.  
  24.  
  25. #define NOP 2000
  26.   
  27. psi_term read_life_form();
  28.  
  29. psi_term psi_term_stack[PARSER_STACK_SIZE];
  30. long int_stack[PARSER_STACK_SIZE];
  31. operator op_stack[PARSER_STACK_SIZE];
  32.  
  33. long parse_ok;
  34. long parser_stack_index;
  35. ptr_node var_tree;
  36. long no_var_tree;
  37.  
  38. /*** RICHARD Nov_4 start ***/
  39. psi_term parse_list();
  40. /*** RICHARD Nov_4 end ***/
  41.  
  42.  
  43.  
  44. /******** BAD_PSI_TERM(t)
  45.   This returns true if T is a psi_term which is not allowed to be considered
  46.   as a constant by the parser.
  47.  
  48.   Example: "A=)+6."  would otherwise be parsed as: "=(A,+(')',6))", this was
  49.                  going a bit far.
  50. */
  51. bad_psi_term(t)
  52. ptr_psi_term t;
  53. {
  54.   char *s,c;
  55.   long r;
  56.  
  57.   
  58.   if(t->type==final_dot || t->type==final_question) /*  RM: Jul  9 1993  */
  59.     return TRUE;
  60.   
  61.   s=t->type->keyword->symbol;
  62.   c=s[0];
  63.   r=(s[1]==0 &&
  64.      (c=='(' ||
  65.       c==')' ||
  66.       c=='[' ||
  67.       c==']' ||
  68.       c=='{' ||
  69.       c=='}'
  70.       /* || c=='.' || c=='?'  RM: Jul  7 1993  */
  71.       )
  72.      );
  73.   
  74.   return r;
  75. }
  76.  
  77.  
  78.    
  79. /******** SHOW(limit)
  80.   This prints the parser's stack, for debugging purposes
  81.   only, LIMIT marks the bottom of the current stack.
  82. */
  83. void show(limit)
  84. long limit;
  85. {
  86.   long i;
  87.   
  88.   for (i=1;i<=parser_stack_index;i++) {
  89.     if (i==limit)
  90.       printf("-> ");
  91.     else
  92.       printf("   ");
  93.     printf("%3d: ",i);
  94.     switch (op_stack[i]) {
  95.     case fx:
  96.       printf("FX  ");
  97.       break;
  98.     case xfx:
  99.       printf("XFX ");
  100.       break;
  101.     case xf:
  102.       printf("XF  ");
  103.       break;
  104.     case nop:
  105.       printf("NOP ");
  106.       break;
  107.     default:
  108.       printf("??? ");
  109.     }
  110.     printf(" prec=%4d  ",int_stack[i]);
  111.     display_psi_stdout(&(psi_term_stack[i]));
  112.     printf("\n");
  113.   }
  114.   printf("\n");
  115. }
  116.  
  117.  
  118.  
  119. /******** PUSH(tok,prec,op)
  120.   Push psi_term and precedence and operator onto parser stack.
  121. */
  122. void push(tok,prec,op)
  123. psi_term tok;
  124. long prec;
  125. operator op;
  126. {
  127.   if (parser_stack_index==PARSER_STACK_SIZE) {
  128.     perr("*** Parser error ");
  129.     psi_term_error();
  130.     perr(": stack full.\n");
  131.   }
  132.   else {
  133.     parser_stack_index++;
  134.     psi_term_stack[parser_stack_index]=tok;
  135.     int_stack[parser_stack_index]=prec;
  136.     op_stack[parser_stack_index]=op;
  137.   }
  138. }
  139.  
  140.  
  141.  
  142. /******** POP(psi_term,op);
  143.   This function pops PSI_TERM and OP off the parser stack and returns
  144.   its precedence.
  145. */
  146. long pop(tok,op)
  147. ptr_psi_term tok;
  148. operator *op;
  149. {
  150.   long r=0;
  151.   
  152.   if (parser_stack_index==0) {
  153.     /*
  154.       perr("*** Parser error ");
  155.       psi_term_error();
  156.       perr(": stack empty.\n");
  157.     */
  158.  
  159.     (*tok)= *error_psi_term;
  160.     parse_ok=FALSE;
  161.   }
  162.   else {
  163.     (*tok)=psi_term_stack[parser_stack_index];
  164.     (*op)=op_stack[parser_stack_index];
  165.     r=int_stack[parser_stack_index];
  166.     parser_stack_index--;
  167.   }
  168.   
  169.   return r;
  170. }
  171.  
  172.  
  173.  
  174. /******** LOOK()
  175.   This function returns the precedence of the stack top.
  176. */
  177. long look()
  178. {
  179.   return int_stack[parser_stack_index];
  180. }
  181.  
  182.  
  183.  
  184. /******** PRECEDENCE(tok,typ)
  185.   This function returns the precedence of
  186.   TOK if it is an operator of type TYP where TYP is FX XFX XF etc...
  187.   Note that this allows both a binary and unary minus.
  188.   The result is NOP if tok is not an operator.
  189. */
  190. long precedence(tok,typ)
  191. psi_term tok;
  192. operator typ;
  193. {
  194.   long r=NOP;
  195.   ptr_operator_data o;
  196.  
  197.   o=tok.type->op_data;
  198.   while(o && r==NOP) {
  199.     if(typ==o->type)
  200.       r=o->precedence;
  201.     else
  202.       o=o->next;
  203.   }
  204.   
  205.   return r;
  206. }
  207.  
  208.  
  209.  
  210. /******** STACK_COPY_PSI_TERM(tok)
  211.   Return the address of a copy of TOK on the STACK.
  212.   All psi_terms read in by the parser are read into the stack.
  213. */
  214. ptr_psi_term stack_copy_psi_term(t)
  215. psi_term t;
  216. {
  217.   ptr_psi_term p;
  218.   
  219.   p=STACK_ALLOC(psi_term);
  220.   (*p)=t;
  221. #ifdef TS
  222.   p->time_stamp=global_time_stamp; /* 9.6 */
  223. #endif
  224.   
  225.   return p;
  226. }
  227.  
  228.  
  229.  
  230. /******** HEAP_COPY_PSI_TERM(tok)
  231.   Return the address of a copy of TOK on the HEAP.
  232. */
  233. ptr_psi_term heap_copy_psi_term(t)
  234. psi_term t;
  235. {
  236.   ptr_psi_term p;
  237.   
  238.   p=HEAP_ALLOC(psi_term);
  239.   (*p)=t;
  240. #ifdef TS
  241.   p->time_stamp=global_time_stamp; /* 9.6 */
  242. #endif
  243.   
  244.   return p;
  245. }
  246.  
  247.  
  248.  
  249.  
  250. /******** FEATURE_INSERT(keystr,tree,psi)
  251.   Insert the psi_term psi into the attribute tree.
  252.   If the feature already exists, create a call to the unification
  253.   function.
  254. */
  255. feature_insert(keystr,tree,psi)
  256. char *keystr;
  257. ptr_node *tree;
  258. ptr_psi_term psi;
  259. {
  260.   ptr_node loc;
  261.   /* ptr_psi_term stk_psi=stack_copy_psi_term(*psi); 19.8 */
  262.  
  263.   if (loc=find(featcmp,keystr,*tree)) {
  264.     /* Give an error message if there is a duplicate feature: */
  265.     Syntaxerrorline("duplicate feature %s (%E)\n",keystr);
  266.   }
  267.   else {
  268.     /* If the feature does not exist, insert it. */
  269.     ptr_psi_term stk_psi=stack_copy_psi_term(*psi); /* 19.8 */
  270.     stack_insert_copystr(keystr,tree,(GENERIC)stk_psi); /* 10.8 */
  271.   }
  272. }
  273.  
  274.  
  275.  
  276.  
  277. /*** RM 9 Dec 1992 START ***/
  278.  
  279.  
  280. /******** LIST_NIL(type)
  281.   Returns the atom NIL to mark the end of a list.
  282.   */
  283.  
  284. psi_term list_nil(type) /*  RM: Feb  1 1993  */
  285.  
  286.      ptr_definition type;
  287. {
  288.   psi_term nihil;
  289.  
  290.   if(type==disjunction) /*  RM: Feb  1 1993  */
  291.     nihil.type=disj_nil;
  292.   else
  293.     nihil.type=nil;
  294.   
  295.   nihil.status=0;
  296.   nihil.flags=FALSE; /* 14.9 */
  297.   nihil.attr_list=NULL;
  298.   nihil.resid=NULL;
  299.   nihil.value=NULL;
  300.   nihil.coref=NULL;
  301.  
  302.   return nihil;
  303. }
  304.  
  305.  
  306.  
  307. /******** PARSE_LIST(type,end,separator)
  308.  
  309.   This function provides a replacement for the function 'read_list'. It does
  310.   not create the old (slightly more compact and a lot more complicated) list
  311.   structure, but instead creates a generic psi-term with 2 features. The list
  312.   is terminated by the atom 'nil'.
  313.  
  314.   Example:
  315.  
  316.     [a,b,c|d] -> cons(a,cons(b,cons(c,d))).
  317.     [] -> nil
  318.     {a;b;c} -> disj(a,disj(b,disj(c,{}))).
  319.     {} -> {} = *bottom*
  320.  
  321.     
  322.   Example:
  323.   TYP=disjunction,
  324.   END="}",
  325.   SEPARATOR=";" will read in disjunctions.
  326.  
  327.   Example:
  328.   TYP=list,
  329.   END="]",
  330.   SEPARATOR="," will read lists such as [1,2,a,b,c|d]
  331.   */
  332.  
  333. psi_term parse_list(typ,e,s)
  334.      ptr_definition typ;
  335.      char e,s;
  336.  
  337. {
  338.   ptr_psi_term car=NULL;
  339.   ptr_psi_term cdr=NULL;
  340.   psi_term result;
  341.   psi_term t;
  342.   char a;
  343.  
  344.  
  345.  
  346.   result=list_nil(typ); /*  RM: Feb  1 1993  */
  347.   
  348.   if (parse_ok) {
  349.  
  350.     /* Character used for building cons pairs */
  351.     a='|'; /*  RM: Jan 11 1993  */
  352.     
  353.  
  354.     read_token(&t);
  355.  
  356.     if(!equ_tokc(t,e)) {
  357.  
  358.       /* Read the CAR of the list */
  359.       put_back_token(t);
  360.       car=stack_copy_psi_term(read_life_form(s,a));
  361.  
  362.       /* Read the CDR of the list */
  363.       read_token(&t);
  364.       if(equ_tokch(t,s))
  365.     cdr=stack_copy_psi_term(parse_list(typ,e,s));
  366.       else if(equ_tokch(t,e))
  367.     cdr=stack_copy_psi_term(list_nil(typ));
  368.       else if(equ_tokch(t,'|')) {
  369.     cdr=stack_copy_psi_term(read_life_form(e,0));
  370.     read_token(&t);
  371.     if(!equ_tokch(t,e)) {
  372.       if (stringparse) parse_ok=FALSE;
  373.       else {
  374.         perr("*** Syntax error ");psi_term_error();
  375.         perr(": bad symbol for end of list '");
  376.         display_psi_stderr(&t);
  377.         perr("'.\n");
  378.         put_back_token(t);
  379.       }
  380.     }
  381.       }
  382.       else 
  383.     if (stringparse) parse_ok=FALSE;
  384.     else {
  385.       perr("*** Syntax error ");psi_term_error();
  386.       perr(": bad symbol in list '");
  387.       display_psi_stderr(&t);
  388.       perr("'.\n");
  389.       put_back_token(t);
  390.     }
  391.  
  392.       result.type=typ;
  393.       if(car)
  394.     stack_insert(featcmp,one,&(result.attr_list),car);
  395.       if(cdr)
  396.     stack_insert(featcmp,two,&(result.attr_list),cdr);
  397.     }
  398.   }
  399.   
  400.   return result;
  401. }
  402. /*** RM 9 Dec 1992 END ***/
  403.  
  404.  
  405.  
  406.  
  407. /******** READ_PSI_TERM()
  408.   This reads in a complex object from the input
  409.   stream, that is, a whole psi-term.
  410.  
  411.   Examples:
  412.  
  413.   [A,B,C]
  414.  
  415.   {0;1;2+A}
  416.  
  417.   <a,b,c> death(victim => V,murderer => M)
  418.  
  419.   which(x,y,z)
  420.  
  421.   A:g(f)
  422.  
  423.   I have allowed mixing labelled with unlabelled attributes.
  424.  
  425.   Example:
  426.   
  427.   f(x=>A,B,y=>K,"hklk",D) is parsed as f(1=>B,2=>"hklk",3=>D,x=>A,y=>K).
  428. */
  429. psi_term read_psi_term()
  430. {
  431.   psi_term t,t2,t3;
  432.   char s[10];
  433.   long count=0,f=TRUE,f2,v;
  434.   ptr_psi_term module;
  435.  
  436.   
  437.   if(parse_ok) {
  438.     
  439.     read_token(&t);
  440.     
  441.     if(equ_tokch(t,'['))
  442.       t=parse_list(alist,']',','); /*** RICHARD Nov_4 ***/
  443.     else
  444.       if(equ_tokch(t,'{')) 
  445.     t=parse_list(disjunction,'}',';'); /*** RICHARD Nov_4 ***/
  446.  
  447.       /* The syntax <a,b,c> for conjunctions has been abandoned.
  448.     else
  449.     if(equ_tokch(t,'<'))
  450.     t=parse_list(conjunction,'>',',');
  451.     */
  452.   
  453.     if(parse_ok 
  454.        && t.type!=eof
  455.        && !bad_psi_term(&t)
  456.        /* && (precedence(t,fx)==NOP)
  457.       && (precedence(t,fy)==NOP) */
  458.        ) {
  459.       read_token(&t2);
  460.       if(equ_tokch(t2,'(')) {
  461.     
  462.     do {
  463.       
  464.       f2=TRUE;
  465.       read_token(&t2);
  466.       
  467.       if(wl_const(t2) && !bad_psi_term(&t2)) {
  468.         read_token(&t3);
  469.         if(equ_tok(t3,"=>")) {
  470.           t3=read_life_form(',',')');
  471.           
  472.           if(t2.type->keyword->private_feature) /*  RM: Mar 11 1993  */
  473.         feature_insert(t2.type->keyword->combined_name,
  474.                    /*  RM: Jan 13 1993  */
  475.                    &(t.attr_list),
  476.                    &t3);
  477.           else
  478.         feature_insert(t2.type->keyword->symbol,
  479.                    /*  RM: Jan 13 1993  */
  480.                    &(t.attr_list),
  481.                    &t3);
  482.           
  483.           f2=FALSE;
  484.         }
  485.         else 
  486.           put_back_token(t3);
  487.       }
  488.       
  489.       if(parse_ok && equal_types(t2.type,integer)) {
  490.         read_token(&t3);
  491.         if(equ_tok(t3,"=>")) {
  492.           t3=read_life_form(',',')');
  493.           v= *(REAL *)t2.value;
  494.           sprintf(s,"%ld",v,0);
  495.               feature_insert(s,&(t.attr_list),&t3);
  496.           f2=FALSE;
  497.         }
  498.         else 
  499.           put_back_token(t3);
  500.       }
  501.       
  502.       if(f2) {
  503.         put_back_token(t2);
  504.         t2=read_life_form(',',')');
  505.         ++count;
  506.         sprintf(s,"%ld",count,0);
  507.             feature_insert(s,&(t.attr_list),&t2);
  508.       }
  509.       
  510.       read_token(&t2);
  511.       
  512.       if(equ_tokch(t2,')'))
  513.         f=FALSE;
  514.       else
  515.         if(!equ_tokch(t2,',')) {
  516.               if (stringparse) parse_ok=FALSE;
  517.               else {
  518.         /*
  519.           perr("*** Syntax error ");psi_term_error();
  520.           perr(": ',' expected in argument list.\n");
  521.           */
  522.  
  523.         /*  RM: Feb  1 1993  */
  524.         Syntaxerrorline("',' expected in argument list (%E)\n");
  525.  
  526.             f=FALSE;
  527.               }
  528.         }
  529.       
  530.     } while(f && parse_ok);
  531.       }
  532.       else
  533.     put_back_token(t2);
  534.     }
  535.   }
  536.   else
  537.     t= *error_psi_term;
  538.  
  539.   if(t.type==variable && t.attr_list) {
  540.     t2=t;
  541.     t.type=apply;
  542.     t.value=NULL;
  543.     t.coref=NULL;
  544.     t.resid=NULL;
  545.     stack_insert(featcmp,functor->keyword->symbol,
  546.          &(t.attr_list),
  547.          stack_copy_psi_term(t2));
  548.   }
  549.  
  550.  
  551.   /*  RM: Mar 12 1993  Nasty hack for Bruno's features in modules */
  552.   if((t.type==add_module1 || t.type==add_module2 || t.type==add_module3) &&
  553.      !find(featcmp,two,t.attr_list)) {
  554.  
  555.     module=stack_psi_term(4);
  556.     module->type=quoted_string;
  557.     module->value=(GENERIC)heap_copy_string(current_module->module_name);
  558.     
  559.     stack_insert(featcmp,two,&(t.attr_list),module);
  560.   }
  561.   
  562.   return t;
  563. }
  564.  
  565.  
  566.  
  567. /******** MAKE_LIFE_FORM(tok,arg1,arg2)
  568.   This routine inserts ARG1 and ARG2 as the first and second attributes of
  569.   psi_term TOK, thus creating the term TOK(1=>arg1,2=>arg2).
  570.  
  571.   If TOK is ':' then a conjunction is created if necessary.
  572.   Example:
  573.   a:V:b:5:long => V: <a,b,5,int> (= conjunction list).
  574. */
  575. psi_term make_life_form(tok,arg1,arg2)
  576. ptr_psi_term tok,arg1,arg2;
  577. {  
  578.   ptr_list l;
  579.   ptr_psi_term a1,a2;
  580.  
  581.   deref_ptr(tok);
  582.   tok->attr_list=NULL;
  583.   tok->resid=NULL;
  584.  
  585.     
  586.   /* Here beginneth a terrible FIX,
  587.      I will have to rewrite the tokeniser and the parser to handle
  588.      POINTERS to psi-terms instead of PSI_TERMS !!!
  589.      */
  590.   
  591.   a1=arg1;
  592.   a2=arg2;
  593.  
  594.   if(a1)
  595.     deref_ptr(a1);
  596.   if(a2)
  597.     deref_ptr(a2);
  598.   
  599.   /* End of extremely ugly fix. */
  600.   
  601.   if (/* UNI FALSE */ equ_tokch((*tok),':') && arg1 && arg2) {
  602.     
  603.     if(a1!=a2) {
  604.       if(a1->type==top && 
  605.      !a1->attr_list &&
  606.      !a1->resid) {
  607.     if(a1!=arg1)
  608.       /* push_ptr_value(psi_term_ptr,&(a1->coref)); 9.6 */
  609.       push_psi_ptr_value(a1,&(a1->coref));
  610.     a1->coref=stack_copy_psi_term(*arg2);
  611.     tok=arg1;
  612.       }
  613.       else
  614.     if(a2->type==top && 
  615.        !a2->attr_list &&
  616.        !a2->resid) {
  617.       if(a2!=arg2)
  618.         /* push_ptr_value(psi_term_ptr,&(a2->coref)); 9.6 */
  619.         push_psi_ptr_value(a2,&(a2->coref));
  620.       a2->coref=stack_copy_psi_term(*arg1);
  621.       tok=arg2;
  622.     }
  623.     else { /*  RM: Feb 22 1993  Now reports an error */
  624.       Syntaxerrorline("':' occurs where '&' required (%E)\n");
  625.       *tok= *error_psi_term;
  626.       /* make_unify_pair(tok,arg1,arg2); Old code */
  627.     }
  628.     }
  629.     else
  630.       tok=arg1;
  631.   }
  632.   else {
  633.  
  634.     /*  RM: Jun 21 1993  */
  635.     /* And now for another nasty hack: reading negative numbers */
  636.     if(tok->type==minus_symbol &&
  637.        a1 &&
  638.        !a2 &&
  639.        a1->value &&
  640.        (a1->type==integer || a1->type==real))  {
  641.       
  642.       tok->type=a1->type;
  643.       tok->value=(GENERIC)heap_alloc(sizeof(REAL));
  644.       *(REAL *)tok->value = - *(REAL *)a1->value;
  645.       
  646.       return *tok;
  647.     }
  648.     /* End of other nasty hack */
  649.     
  650.     stack_insert(featcmp,one,&(tok->attr_list),stack_copy_psi_term(*arg1));
  651.     if (arg2)
  652.       stack_insert(featcmp,two,&(tok->attr_list),stack_copy_psi_term(*arg2));
  653.   }
  654.   
  655.   return *tok;
  656. }
  657.  
  658.  
  659.  
  660. /******** CRUNCH(prec,limit)
  661.   Crunch up = work out the arguments of anything on the stack whose precedence
  662.   is <= PREC, and replace it with the corresponding psi-term. Do not go any
  663.   further than LIMIT which is the end of the current expression.
  664. */
  665. void crunch(prec,limit)
  666. long prec;
  667. long limit;
  668. {
  669.   psi_term t,t1,t2,t3;
  670.   operator op1,op2,op3;
  671.   
  672.   if(parse_ok && prec>=look() && parser_stack_index>limit) {
  673.     
  674.     pop(&t1,&op1);
  675.     
  676.     switch(op1) {
  677.       
  678.     case nop:
  679.       pop(&t2,&op2);
  680.       if(op2==fx)
  681.     t=make_life_form(&t2,&t1,NULL);
  682.       else
  683.     if(op2==xfx) {
  684.       pop(&t3,&op3);
  685.       if(op3==nop)
  686.         t=make_life_form(&t2,&t3,&t1);
  687.       else {
  688.         printf("*** Parser: ooops, NOP expected.\n");
  689.         parse_ok=FALSE;
  690.         t= *error_psi_term;
  691.       }
  692.     }
  693.       break;
  694.       
  695.     case xf:
  696.       pop(&t2,&op2);
  697.       if(op2==nop)
  698.     t=make_life_form(&t1,&t2,NULL);
  699.       else {
  700.     printf("*** Parser: ugh, NOP expected.\n");
  701.     t= *error_psi_term;
  702.     parse_ok=FALSE;
  703.       }
  704.       break;
  705.       
  706.     default:
  707.       printf("*** Parser: yuck, weirdo operator.\n");
  708.     }
  709.     
  710.     push(t,look(),nop);
  711.     
  712.     crunch(prec,limit);
  713.   }
  714. }
  715.  
  716.  
  717.  
  718. /******** READ_LIFE_FORM(str1,str2)
  719.   This reads in one life-form from the input stream which finishes with
  720.   the psi_term whose name is STR1 or STR2, typically if we're reading a list
  721.   [A,4*5,b-4!] then STR1="," and STR2="|" . It would be incorrect if "," were
  722.   taken as an operator.
  723.  
  724.   This routine implements the two state expression parser as described in the
  725.   implementation guide. It deals with all the various types of operators,
  726.   precedence is dealt with by the CRUNCH function. Each time an opening
  727.   parenthesis is encountered a new expression is started.
  728. */
  729. psi_term read_life_form(ch1,ch2)
  730. char ch1,ch2;
  731. {
  732.   psi_term t,t2;
  733.   long limit,pr_op,pr_1,pr_2,start=0;
  734.   long fin=FALSE;
  735.   long state=0;
  736.   long prec=0;
  737.   
  738.   operator op;
  739.   
  740.   limit=parser_stack_index+1;
  741.   
  742.   if(parse_ok)
  743.     do {
  744.       if(state)
  745.     read_token(&t);
  746.       else
  747.     t=read_psi_term();
  748.       
  749.       if(!start)
  750.     start=line_count;
  751.       
  752.       if(!fin)
  753.     if(state) {
  754.       if(equ_tokc(t,ch1) || equ_tokc(t,ch2)) {
  755.         fin=TRUE;
  756.         put_back_token(t);
  757.       }
  758.       else {
  759.         
  760.         pr_op=precedence(t,xf);
  761.         pr_1=pr_op-1;
  762.         
  763.         if(pr_op==NOP) {
  764.           pr_op=precedence(t,yf);
  765.           pr_1=pr_op;
  766.         }
  767.         
  768.         if(pr_op==NOP) {
  769.           
  770.           pr_op=precedence(t,xfx);
  771.           pr_1=pr_op-1;
  772.           pr_2=pr_op-1;
  773.           
  774.           if(pr_op==NOP) {
  775.         pr_op=precedence(t,xfy);
  776.         pr_1=pr_op-1;
  777.         pr_2=pr_op;
  778.           }
  779.           
  780.           if(pr_op==NOP) {
  781.         pr_op=precedence(t,yfx);
  782.         pr_1=pr_op;
  783.         pr_2=pr_op-1;
  784.           }
  785.           
  786.           /* if(pr_op==NOP) {
  787.         pr_op=precedence(t,yfy);
  788.         pr_1=pr_op;
  789.         pr_2=pr_op-1;
  790.           }
  791.               */
  792.           
  793.           if(pr_op==NOP) {
  794.         fin=TRUE;
  795.         put_back_token(t);
  796.           }
  797.           else
  798.         {
  799.           crunch(pr_1,limit);
  800.           push(t,pr_2,xfx);
  801.           prec=pr_2;
  802.           state=0;
  803.         }
  804.         }
  805.         else {
  806.           crunch(pr_1,limit);
  807.           push(t,pr_1,xf);
  808.           prec=pr_1;
  809.         }
  810.       }
  811.     }
  812.     else {
  813.  
  814.       if(t.attr_list)
  815.         pr_op=NOP;
  816.       else {
  817.         pr_op=precedence(t,fx);
  818.         pr_2=pr_op-1;
  819.             
  820.         if(pr_op==NOP) {
  821.           pr_op=precedence(t,fy);
  822.           pr_2=pr_op;
  823.         }
  824.       }
  825.  
  826.       if(pr_op==NOP) {
  827.         if(equ_tokch(t,'(')) {
  828.           t2=read_life_form(')',0);
  829.           if(parse_ok) {
  830.         push(t2,prec,nop);
  831.         read_token(&t2);
  832.         if(!equ_tokch(t2,')')) {
  833.                   if (stringparse) parse_ok=FALSE;
  834.                   else {
  835.             /*
  836.               perr("*** Syntax error ");psi_term_error();
  837.               perr(": ')' missing.\n");
  838.               */
  839.  
  840.             /*  RM: Feb  1 1993  */
  841.             Syntaxerrorline("')' missing (%E)\n");
  842.  
  843.             put_back_token(t2);
  844.           }
  845.         }
  846.         state=1;
  847.           }
  848.         }
  849.         else 
  850.           if(bad_psi_term(&t)) {
  851.         put_back_token(t);
  852.         /* psi_term_error(); */
  853.         fin=TRUE;
  854.           }
  855.           else {
  856.         push(t,prec,nop);
  857.         state=1;
  858.           }
  859.       }
  860.       else {
  861.         push(t,pr_2,fx);
  862.         prec=pr_2;
  863.       }
  864.       
  865.     }
  866.       
  867.     } while (!fin && parse_ok);
  868.   
  869.   if (state)
  870.     crunch(MAX_PRECEDENCE,limit);
  871.   
  872.   if (parse_ok && parser_stack_index!=limit) {
  873.     if (stringparse) parse_ok=FALSE;
  874.     else {
  875.       /*
  876.     perr("*** Syntax error ");psi_term_error();
  877.     perr(": bad expression.\n");
  878.     */
  879.       
  880.       /*  RM: Feb  1 1993  */
  881.       Syntaxerrorline("bad expression (%E)\n");
  882.     }
  883.   }
  884.   else
  885.     pop(&t,&op);
  886.   
  887.   if (!parse_ok)
  888.     t= *error_psi_term;
  889.  
  890.   parser_stack_index=limit-1;
  891.   
  892.   return t;
  893. }
  894.  
  895.  
  896.  
  897. /******** PARSE(is_it_a_clause)
  898.   This returns one clause or query from the input stream.
  899.   It also indicates the type psi-term read, that is whether it was a clause
  900.   or a query in the IS_IT_A_CLAUSE variable. This is the top level of the
  901.   parser.
  902.  
  903.   The whole parser is, rather like the psi_termiser, not too well written.
  904.   It handles psi_terms rather than pointers which causes a lot of messy code
  905.   and is somewhat slower.
  906. */
  907. psi_term parse(q)
  908. long *q;
  909. {
  910.   psi_term s,t,u;
  911.   long c;
  912.  
  913.   parser_stack_index=0;
  914.   parse_ok=TRUE;
  915.  
  916.   /*s=read_life_form('.','?');*/
  917.   s=read_life_form(0,0);
  918.  
  919.   if (parse_ok) {
  920.     if (s.type!=eof) {
  921.       read_token(&t);
  922.       
  923.       /*
  924.       if (equ_tokch(t,'?'))
  925.     *q=QUERY;
  926.       else if (equ_tokch(t,'.'))
  927.     *q=FACT;
  928.     */
  929.  
  930.       /*  RM: Jul  7 1993  */
  931.       if (t.type==final_question)
  932.     *q=QUERY;
  933.       else if (t.type==final_dot)
  934.     *q=FACT;
  935.       else {
  936.         if (stringparse) parse_ok=FALSE;
  937.         else {
  938.       /*
  939.           perr("*** Syntax error ");psi_term_error();perr(": ");
  940.       display_psi_stderr(&t);
  941.       perr(".\n");
  942.       */
  943.  
  944.       /*  RM: Feb  1 1993  */
  945.       Syntaxerrorline("'%P' (%E)\n",&t);
  946.  
  947.         }
  948.     *q=ERROR;
  949.       }
  950.     }
  951.   }
  952.  
  953.       
  954.   if (!parse_ok) {
  955.  
  956.     while (saved_psi_term!=NULL) read_token(&u);
  957.  
  958.     prompt="error>";
  959.     while((c=read_char()) && c!=EOF && c!='.' && c!='?' && c!=EOLN) {}
  960.  
  961.     *q=ERROR;
  962.   }
  963.   else if (saved_char)
  964.     do {
  965.       c=read_char();
  966.       if (c==EOLN)
  967.         c=0;
  968.       else if (c<0 || c>32) {
  969.         put_back_char(c);
  970.         c=0;
  971.       }
  972.     } while(c && c!=EOF);
  973.  
  974.   /* Make sure arguments of nonstrict terms are marked quoted. */
  975.   if (parse_ok) mark_nonstrict(&s); /* 25.8 */
  976.  
  977.   /* mark_eval(&s); 24.8 XXX */
  978.  
  979.   /* Mark all the psi-terms corresponding to variables in the var_tree as    */
  980.   /* quoted.  This is needed for correct parsing of inputs; otherwise vars   */
  981.   /* that occur in an increment of a query are marked to be evaluated again! */
  982.   /* mark_quote_tree(var_tree); 24.8 XXX */
  983.  
  984.   
  985.   return s;
  986. }
  987.