Wild Life  2.29
 All Data Structures Files Functions Variables Typedefs Macros
Functions
parser.c File Reference

Go to the source code of this file.

Functions

int bad_psi_term (ptr_psi_term t)
 
void show (long limit)
 
void push (psi_term tok, long prec, long op)
 
long pop (ptr_psi_term tok, long *op)
 
long look ()
 
long precedence (psi_term tok, long typ)
 
ptr_psi_term stack_copy_psi_term (psi_term t)
 
ptr_psi_term heap_copy_psi_term (psi_term t)
 
void feature_insert (char *keystr, ptr_node *tree, ptr_psi_term psi)
 
psi_term list_nil (ptr_definition type)
 
psi_term parse_list (ptr_definition typ, char e, char s)
 
psi_term read_psi_term ()
 
psi_term make_life_form (ptr_psi_term tok, ptr_psi_term arg1, ptr_psi_term arg2)
 
void crunch (long prec, long limit)
 
psi_term read_life_form (char ch1, char ch2)
 
psi_term parse (long *q)
 

Function Documentation

int bad_psi_term ( ptr_psi_term  t)

Definition at line 20 of file parser.c.

References final_dot, final_question, and TRUE.

22 {
23  char *s,c;
24  long r;
25 
26 
27  if(t->type==final_dot || t->type==final_question) /* RM: Jul 9 1993 */
28  return TRUE;
29 
30  s=t->type->keyword->symbol;
31  c=s[0];
32  r=(s[1]==0 &&
33  (c=='(' ||
34  c==')' ||
35  c=='[' ||
36  c==']' ||
37  c=='{' ||
38  c=='}'
39  /* || c=='.' || c=='?' RM: Jul 7 1993 */
40  )
41  );
42 
43  return r;
44 }
ptr_keyword keyword
Definition: def_struct.h:124
char * symbol
Definition: def_struct.h:91
#define TRUE
Definition: def_const.h:127
ptr_definition final_dot
Definition: def_glob.h:137
ptr_definition final_question
Definition: def_glob.h:138
ptr_definition type
Definition: def_struct.h:165
void crunch ( long  prec,
long  limit 
)

Definition at line 636 of file parser.c.

References error_psi_term, FALSE, fx, look(), make_life_form(), nop, NULL, parse_ok, parser_stack_index, pop(), push(), xf, and xfx.

639 {
640  psi_term t,t1,t2,t3;
641  long op1,op2,op3;
642 
643  if(parse_ok && prec>=look() && parser_stack_index>limit) {
644 
645  (void)pop(&t1,&op1);
646 
647  switch(op1) {
648 
649  case nop:
650  (void)pop(&t2,&op2);
651  if(op2==fx)
652  t=make_life_form(&t2,&t1,NULL);
653  else
654  if(op2==xfx) {
655  (void)pop(&t3,&op3);
656  if(op3==nop)
657  t=make_life_form(&t2,&t3,&t1);
658  else {
659  printf("*** Parser: ooops, NOP expected.\n");
660  parse_ok=FALSE;
661  t= *error_psi_term;
662  }
663  }
664  break;
665 
666  case xf:
667  (void)pop(&t2,&op2);
668  if(op2==nop)
669  t=make_life_form(&t1,&t2,NULL);
670  else {
671  printf("*** Parser: ugh, NOP expected.\n");
672  t= *error_psi_term;
673  parse_ok=FALSE;
674  }
675  break;
676 
677  default:
678  printf("*** Parser: yuck, weirdo operator.\n");
679  }
680 
681  push(t,look(),nop);
682 
683  crunch(prec,limit);
684  }
685 }
#define xfx
Definition: def_const.h:265
#define fx
Definition: def_const.h:262
long look()
Definition: parser.c:146
void push(psi_term tok, long prec, long op)
Definition: parser.c:91
#define NULL
Definition: def_const.h:203
#define nop
Definition: def_const.h:260
long pop(ptr_psi_term tok, long *op)
Definition: parser.c:115
void crunch(long prec, long limit)
Definition: parser.c:636
ptr_psi_term error_psi_term
Definition: def_glob.h:23
#define FALSE
Definition: def_const.h:128
#define xf
Definition: def_const.h:261
psi_term make_life_form(ptr_psi_term tok, ptr_psi_term arg1, ptr_psi_term arg2)
Definition: parser.c:546
long parser_stack_index
Definition: def_glob.h:24
long parse_ok
Definition: def_glob.h:171
void feature_insert ( char *  keystr,
ptr_node tree,
ptr_psi_term  psi 
)

Definition at line 225 of file parser.c.

References FEATCMP, find(), stack_copy_psi_term(), stack_insert_copystr(), and Syntaxerrorline().

229 {
230  ptr_node loc;
231  ptr_psi_term stk_psi;
232 
233  // printf("before find in feature_insert feature=%s\n",keystr);
234  if ((loc=find(FEATCMP,keystr,*tree))) {
235  /* Give an error message if there is a duplicate feature: */
236  Syntaxerrorline("duplicate feature %s\n",keystr);
237  }
238  else {
239  /* If the feature does not exist, insert it. */
240  stk_psi=stack_copy_psi_term(*psi); // 19.8 */
241  stack_insert_copystr(keystr,tree,(GENERIC)stk_psi); /* 10.8 */
242  }
243 }
#define FEATCMP
Definition: def_const.h:257
void Syntaxerrorline(char *format,...)
Definition: error.c:498
ptr_psi_term stack_copy_psi_term(psi_term t)
Definition: parser.c:183
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
unsigned long * GENERIC
Definition: def_struct.h:17
void stack_insert_copystr(char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:260
ptr_psi_term heap_copy_psi_term ( psi_term  t)

Definition at line 202 of file parser.c.

References global_time_stamp, and HEAP_ALLOC.

204 {
205  ptr_psi_term p;
206 
207  p=HEAP_ALLOC(psi_term);
208  (*p)=t;
209 #ifdef TS
210  p->time_stamp=global_time_stamp; /* 9.6 */
211 #endif
212 
213  return p;
214 }
unsigned long global_time_stamp
Definition: login.c:19
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
psi_term list_nil ( ptr_definition  type)

Definition at line 255 of file parser.c.

References wl_psi_term::attr_list, wl_psi_term::coref, disj_nil, disjunction, FALSE, wl_psi_term::flags, nil, NULL, wl_psi_term::resid, wl_psi_term::status, wl_psi_term::type, and wl_psi_term::value_3.

258 {
259  psi_term nihil;
260 
261  if(type==disjunction) /* RM: Feb 1 1993 */
262  nihil.type=disj_nil;
263  else
264  nihil.type=nil;
265 
266  nihil.status=0;
267  nihil.flags=FALSE; /* 14.9 */
268  nihil.attr_list=NULL;
269  nihil.resid=NULL;
270  nihil.value_3=NULL;
271  nihil.coref=NULL;
272 
273  return nihil;
274 }
ptr_residuation resid
Definition: def_struct.h:173
#define NULL
Definition: def_const.h:203
ptr_definition disj_nil
Definition: def_glob.h:85
#define FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
ptr_definition disjunction
Definition: def_glob.h:84
ptr_psi_term coref
Definition: def_struct.h:172
ptr_definition nil
Definition: def_glob.h:97
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
long look ( )

Definition at line 146 of file parser.c.

References int_stack, and parser_stack_index.

147 {
149 }
long parser_stack_index
Definition: def_glob.h:24
long int_stack[PARSER_STACK_SIZE]
Definition: def_glob.h:318
psi_term make_life_form ( ptr_psi_term  tok,
ptr_psi_term  arg1,
ptr_psi_term  arg2 
)

Definition at line 546 of file parser.c.

References wl_psi_term::attr_list, wl_psi_term::coref, deref_ptr, equ_tokch, error_psi_term, FEATCMP, heap_alloc(), integer, minus_symbol, NULL, one, push_psi_ptr_value(), REAL, real, wl_psi_term::resid, stack_copy_psi_term(), stack_insert(), Syntaxerrorline(), top, two, wl_psi_term::type, and wl_psi_term::value_3.

548 {
549  // ptr_list l;
550  ptr_psi_term a1,a2;
551 
552  deref_ptr(tok);
553  tok->attr_list=NULL;
554  tok->resid=NULL;
555 
556 
557  /* Here beginneth a terrible FIX,
558  I will have to rewrite the tokeniser and the parser to handle
559  POINTERS to psi-terms instead of PSI_TERMS !!!
560  */
561 
562  a1=arg1;
563  a2=arg2;
564 
565  if (a1)
566  deref_ptr(a1);
567  if (a2)
568  deref_ptr(a2);
569 
570  /* End of extremely ugly fix. */
571 
572  if (/* UNI FALSE */ equ_tokch((*tok),':') && arg1 && arg2) {
573 
574  if (a1!=a2) {
575  if (a1->type==top &&
576  !a1->attr_list &&
577  !a1->resid) {
578  if (a1!=arg1)
579  /* push_ptr_value(psi_term_ptr,&(a1->coref)); 9.6 */
580  push_psi_ptr_value(a1,(GENERIC *)&(a1->coref));
581  a1->coref=stack_copy_psi_term(*arg2);
582  tok=arg1;
583  }
584  else
585  if(a2->type==top &&
586  !a2->attr_list &&
587  !a2->resid) {
588  if(a2!=arg2)
589  /* push_ptr_value(psi_term_ptr,&(a2->coref)); 9.6 */
590  push_psi_ptr_value(a2,(GENERIC *)&(a2->coref));
591  a2->coref=stack_copy_psi_term(*arg1);
592  tok=arg2;
593  }
594  else { /* RM: Feb 22 1993 Now reports an error */
595  Syntaxerrorline("':' occurs where '&' required (%E)\n");
596  *tok= *error_psi_term;
597  /* make_unify_pair(tok,arg1,arg2); Old code */
598  }
599  }
600  else
601  tok=arg1;
602  }
603  else {
604 
605  /* RM: Jun 21 1993 */
606  /* And now for another nasty hack: reading negative numbers */
607  if(tok->type==minus_symbol &&
608  a1 &&
609  !a2 &&
610  a1->value_3 &&
611  (a1->type==integer || a1->type==real)) {
612 
613  tok->type=a1->type;
614  tok->value_3=(GENERIC)heap_alloc(sizeof(REAL));
615  *(REAL *)tok->value_3 = - *(REAL *)a1->value_3;
616 
617  return *tok;
618  }
619  /* End of other nasty hack */
620 
622  if (arg2)
624  }
625 
626  return *tok;
627 }
ptr_residuation resid
Definition: def_struct.h:173
#define FEATCMP
Definition: def_const.h:257
char * two
Definition: def_glob.h:251
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
Definition: login.c:443
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
#define REAL
Definition: def_const.h:72
ptr_definition minus_symbol
Definition: def_glob.h:96
ptr_definition real
Definition: def_glob.h:102
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:291
#define deref_ptr(P)
Definition: def_macro.h:95
void Syntaxerrorline(char *format,...)
Definition: error.c:498
ptr_psi_term error_psi_term
Definition: def_glob.h:23
ptr_definition integer
Definition: def_glob.h:93
GENERIC value_3
Definition: def_struct.h:170
ptr_psi_term stack_copy_psi_term(psi_term t)
Definition: parser.c:183
ptr_psi_term coref
Definition: def_struct.h:172
char * one
Definition: def_glob.h:250
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
GENERIC heap_alloc(long s)
Definition: memory.c:1518
#define equ_tokch(A, B)
Definition: def_macro.h:66
psi_term parse ( long *  q)

Definition at line 877 of file parser.c.

References eof, EOLN, ERROR, FACT, FALSE, final_dot, final_question, mark_nonstrict(), NULL, parse_ok, parser_stack_index, prompt, put_back_char(), QUERY, read_char(), read_life_form(), read_token(), saved_char, saved_psi_term, stringparse, Syntaxerrorline(), TRUE, and wl_psi_term::type.

879 {
880  psi_term s,t,u;
881  long c;
882 
884  parse_ok=TRUE;
885 
886  /*s=read_life_form('.','?');*/
887  s=read_life_form(0,0);
888 
889  if (parse_ok) {
890  if (s.type!=eof) {
891  read_token(&t);
892 
893  /*
894  if (equ_tokch(t,'?'))
895  *q=QUERY;
896  else if (equ_tokch(t,'.'))
897  *q=FACT;
898  */
899 
900  /* RM: Jul 7 1993 */
901  if (t.type==final_question)
902  {
903  *q=QUERY;
904  }
905  else if (t.type==final_dot)
906  {
907  *q=FACT;
908  }
909  else
910  {
912  else {
913 
914  /*
915  perr("*** Syntax error ");psi_term_error();perr(": ");
916  display_psi_stderr(&t);
917  perr(".\n");
918  */
919 
920  /* RM: Feb 1 1993 */
921  Syntaxerrorline("'%P' (%E)\n",&t);
922 
923  }
924  *q=ERROR;
925  }
926  }
927  }
928 
929 
930  if (!parse_ok) {
931 
932  while (saved_psi_term!=NULL) read_token(&u);
933 
934  prompt="error>";
935  while((c=read_char()) && c!=EOF && c!='.' && c!='?' && c!=EOLN) {}
936 
937  *q=ERROR;
938  }
939  else if (saved_char)
940  do {
941  c=read_char();
942  if (c==EOLN)
943  c=0;
944  else if (c<0 || c>32) {
945  put_back_char(c);
946  c=0;
947  }
948  } while(c && c!=EOF);
949 
950  /* Make sure arguments of nonstrict terms are marked quoted. */
951  if (parse_ok) mark_nonstrict(&s); /* 25.8 */
952 
953  /* mark_eval(&s); 24.8 XXX */
954 
955  /* Mark all the psi-terms corresponding to variables in the var_tree as */
956  /* quoted. This is needed for correct parsing of inputs; otherwise vars */
957  /* that occur in an increment of a query are marked to be evaluated again! */
958  /* mark_quote_tree(var_tree); 24.8 XXX */
959 
960 
961  return s;
962 }
void put_back_char(long c)
Definition: token.c:633
void read_token(ptr_psi_term tok)
Definition: token.c:1063
#define FACT
Definition: def_const.h:151
void mark_nonstrict(ptr_psi_term t)
Definition: copy.c:462
#define NULL
Definition: def_const.h:203
long saved_char
Definition: def_glob.h:192
#define QUERY
Definition: def_const.h:152
#define ERROR
Definition: def_const.h:153
psi_term read_life_form(char ch1, char ch2)
Definition: parser.c:700
#define EOLN
Definition: def_const.h:140
ptr_definition eof
Definition: def_glob.h:86
void Syntaxerrorline(char *format,...)
Definition: error.c:498
#define TRUE
Definition: def_const.h:127
ptr_definition final_dot
Definition: def_glob.h:137
#define FALSE
Definition: def_const.h:128
ptr_definition final_question
Definition: def_glob.h:138
ptr_psi_term saved_psi_term
Definition: def_glob.h:194
char * prompt
Definition: def_glob.h:42
long read_char()
Definition: token.c:587
long parser_stack_index
Definition: def_glob.h:24
long stringparse
Definition: def_glob.h:202
long parse_ok
Definition: def_glob.h:171
ptr_definition type
Definition: def_struct.h:165
psi_term parse_list ( ptr_definition  typ,
char  e,
char  s 
)

Definition at line 304 of file parser.c.

References wl_psi_term::attr_list, display_psi_stderr(), equ_tokc, equ_tokch, FALSE, FEATCMP, list_nil(), NULL, one, parse_ok, perr(), psi_term_error(), put_back_token(), read_life_form(), read_token(), stack_copy_psi_term(), stack_insert(), stringparse, two, and wl_psi_term::type.

308 {
309  ptr_psi_term car=NULL;
310  ptr_psi_term cdr=NULL;
311  psi_term result;
312  psi_term t;
313  char a;
314 
315 
316 
317  result=list_nil(typ); /* RM: Feb 1 1993 */
318 
319  if (parse_ok) {
320 
321  /* Character used for building cons pairs */
322  a='|'; /* RM: Jan 11 1993 */
323 
324 
325  read_token(&t);
326 
327  if(!equ_tokc(t,e)) {
328 
329  /* Read the CAR of the list */
330  put_back_token(t);
332 
333  /* Read the CDR of the list */
334  read_token(&t);
335  if(equ_tokch(t,s))
336  cdr=stack_copy_psi_term(parse_list(typ,e,s));
337  else if(equ_tokch(t,e))
338  cdr=stack_copy_psi_term(list_nil(typ));
339  else if(equ_tokch(t,'|')) {
341  read_token(&t);
342  if(!equ_tokch(t,e)) {
344  else {
345  perr("*** Syntax error ");psi_term_error();
346  perr(": bad symbol for end of list '");
347  display_psi_stderr(&t);
348  perr("'.\n");
349  put_back_token(t);
350  }
351  }
352  }
353  else
355  else {
356  perr("*** Syntax error ");psi_term_error();
357  perr(": bad symbol in list '");
358  display_psi_stderr(&t);
359  perr("'.\n");
360  put_back_token(t);
361  }
362 
363  result.type=typ;
364  if(car)
365  (void)stack_insert(FEATCMP,one,&(result.attr_list),(GENERIC)car);
366  if(cdr)
367  (void)stack_insert(FEATCMP,two,&(result.attr_list),(GENERIC)cdr);
368  }
369  }
370 
371  return result;
372 }
void psi_term_error()
Definition: token.c:661
#define FEATCMP
Definition: def_const.h:257
void perr(char *str)
Definition: error.c:659
#define equ_tokc(A, B)
Definition: def_macro.h:71
void read_token(ptr_psi_term tok)
Definition: token.c:1063
char * two
Definition: def_glob.h:251
#define NULL
Definition: def_const.h:203
psi_term parse_list(ptr_definition typ, char e, char s)
Definition: parser.c:304
void display_psi_stderr(ptr_psi_term t)
Definition: print.c:1438
void put_back_token(psi_term t)
Definition: token.c:647
psi_term read_life_form(char ch1, char ch2)
Definition: parser.c:700
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:291
#define FALSE
Definition: def_const.h:128
ptr_psi_term stack_copy_psi_term(psi_term t)
Definition: parser.c:183
char * one
Definition: def_glob.h:250
psi_term list_nil(ptr_definition type)
Definition: parser.c:255
long stringparse
Definition: def_glob.h:202
long parse_ok
Definition: def_glob.h:171
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
#define equ_tokch(A, B)
Definition: def_macro.h:66
long pop ( ptr_psi_term  tok,
long *  op 
)

Definition at line 115 of file parser.c.

References error_psi_term, FALSE, int_stack, parse_ok, parser_stack_index, and psi_term_stack.

118 {
119  long r=0;
120 
121  if (parser_stack_index==0) {
122  /*
123  perr("*** Parser error ");
124  psi_term_error();
125  perr(": stack empty.\n");
126  */
127 
128  (*tok)= *error_psi_term;
129  parse_ok=FALSE;
130  }
131  else {
133  (*op)=op_stack[parser_stack_index];
136  }
137 
138  return r;
139 }
ptr_psi_term error_psi_term
Definition: def_glob.h:23
#define FALSE
Definition: def_const.h:128
long parser_stack_index
Definition: def_glob.h:24
long parse_ok
Definition: def_glob.h:171
long int_stack[PARSER_STACK_SIZE]
Definition: def_glob.h:318
psi_term psi_term_stack[PARSER_STACK_SIZE]
Definition: def_glob.h:317
long precedence ( psi_term  tok,
long  typ 
)

Definition at line 159 of file parser.c.

References wl_operator_data::next, NOP, and wl_operator_data::precedence.

162 {
163  long r=NOP;
165 
166  o=tok.type->op_data;
167  while(o && r==NOP) {
168  if(typ==o->type)
169  r=o->precedence;
170  else
171  o=o->next;
172  }
173 
174  return r;
175 }
ptr_operator_data next
Definition: def_struct.h:49
#define NOP
Definition: def_const.h:332
ptr_definition type
Definition: def_struct.h:165
ptr_operator_data op_data
Definition: def_struct.h:139
void push ( psi_term  tok,
long  prec,
long  op 
)

Definition at line 91 of file parser.c.

References int_stack, parser_stack_index, PARSER_STACK_SIZE, perr(), psi_term_error(), and psi_term_stack.

95 {
97  perr("*** Parser error ");
99  perr(": stack full.\n");
100  }
101  else {
105  op_stack[parser_stack_index]=op;
106  }
107 }
void psi_term_error()
Definition: token.c:661
void perr(char *str)
Definition: error.c:659
#define PARSER_STACK_SIZE
Definition: def_const.h:100
long parser_stack_index
Definition: def_glob.h:24
long int_stack[PARSER_STACK_SIZE]
Definition: def_glob.h:318
psi_term psi_term_stack[PARSER_STACK_SIZE]
Definition: def_glob.h:317
psi_term read_life_form ( char  ch1,
char  ch2 
)

Definition at line 700 of file parser.c.

References wl_psi_term::attr_list, bad_psi_term(), crunch(), equ_tokc, equ_tokch, error_psi_term, FALSE, fx, fy, line_count, MAX_PRECEDENCE, nop, NOP, parse_ok, parser_stack_index, pop(), precedence(), push(), put_back_token(), read_psi_term(), read_token(), stringparse, Syntaxerrorline(), TRUE, xf, xfx, xfy, yf, and yfx.

702 {
703  psi_term t,t2;
704  long limit,pr_op,pr_1,pr_2,start=0;
705  long fin=FALSE;
706  long state=0;
707  long prec=0;
708 
709  long op;
710 
711  limit=parser_stack_index+1;
712 
713  if (parse_ok)
714  do {
715  if (state)
716  read_token(&t);
717  else
718  t=read_psi_term();
719 
720  if (!start)
721  start=line_count;
722 
723  if (!fin)
724  if (state) {
725  if (equ_tokc(t,ch1) || equ_tokc(t,ch2)) {
726  fin=TRUE;
727  put_back_token(t);
728  }
729  else {
730  pr_op=precedence(t,xf);
731  pr_1=pr_op-1;
732 
733  if(pr_op==NOP) {
734  pr_op=precedence(t,yf);
735  pr_1=pr_op;
736  }
737 
738  if(pr_op==NOP) {
739 
740  pr_op=precedence(t,xfx);
741  pr_1=pr_op-1;
742  pr_2=pr_op-1;
743 
744  if(pr_op==NOP) {
745  pr_op=precedence(t,xfy);
746  pr_1=pr_op-1;
747  pr_2=pr_op;
748  }
749 
750  if(pr_op==NOP) {
751  pr_op=precedence(t,yfx);
752  pr_1=pr_op;
753  pr_2=pr_op-1;
754  }
755 
756  /* if(pr_op==NOP) {
757  pr_op=precedence(t,yfy);
758  pr_1=pr_op;
759  pr_2=pr_op-1;
760  }
761  */
762 
763  if(pr_op==NOP) {
764  fin=TRUE;
765  put_back_token(t);
766  }
767  else
768  {
769  crunch(pr_1,limit);
770  push(t,pr_2,xfx);
771  prec=pr_2;
772  state=0;
773  }
774  }
775  else {
776  crunch(pr_1,limit);
777  push(t,pr_1,xf);
778  prec=pr_1;
779  }
780  }
781  }
782  else {
783 
784  if(t.attr_list)
785  pr_op=NOP;
786  else {
787  pr_op=precedence(t,fx);
788  pr_2=pr_op-1;
789 
790  if(pr_op==NOP) {
791  pr_op=precedence(t,fy);
792  pr_2=pr_op;
793  }
794  }
795 
796  if(pr_op==NOP) {
797  if(equ_tokch(t,'(')) {
798  t2=read_life_form(')',0);
799  if(parse_ok) {
800  push(t2,prec,nop);
801  read_token(&t2);
802  if(!equ_tokch(t2,')')) {
804  else {
805  /*
806  perr("*** Syntax error ");psi_term_error();
807  perr(": ')' missing.\n");
808  */
809 
810  /* RM: Feb 1 1993 */
811  Syntaxerrorline("')' missing (%E)\n");
812 
813  put_back_token(t2);
814  }
815  }
816  state=1;
817  }
818  }
819  else
820  if(bad_psi_term(&t)) {
821  put_back_token(t);
822  /* psi_term_error(); */
823  fin=TRUE;
824  }
825  else {
826  push(t,prec,nop);
827  state=1;
828  }
829  }
830  else {
831  push(t,pr_2,fx);
832  prec=pr_2;
833  }
834 
835  }
836 
837  } while (!fin && parse_ok);
838 
839  if (state)
840  crunch(MAX_PRECEDENCE,limit);
841 
842  if (parse_ok && parser_stack_index!=limit) {
844  else {
845  /*
846  perr("*** Syntax error ");psi_term_error();
847  perr(": bad expression.\n");
848  */
849 
850  /* RM: Feb 1 1993 */
851  Syntaxerrorline("bad expression (%E)\n");
852  }
853  }
854  else
855  (void)pop(&t,&op);
856 
857  if (!parse_ok)
858  t= *error_psi_term;
859 
860  parser_stack_index=limit-1;
861 
862  return t;
863 }
#define yfx
Definition: def_const.h:268
#define equ_tokc(A, B)
Definition: def_macro.h:71
void read_token(ptr_psi_term tok)
Definition: token.c:1063
#define xfx
Definition: def_const.h:265
#define fx
Definition: def_const.h:262
#define NOP
Definition: def_const.h:332
void push(psi_term tok, long prec, long op)
Definition: parser.c:91
long precedence(psi_term tok, long typ)
Definition: parser.c:159
#define xfy
Definition: def_const.h:267
#define nop
Definition: def_const.h:260
void put_back_token(psi_term t)
Definition: token.c:647
long line_count
Definition: def_glob.h:39
psi_term read_life_form(char ch1, char ch2)
Definition: parser.c:700
void Syntaxerrorline(char *format,...)
Definition: error.c:498
#define TRUE
Definition: def_const.h:127
long pop(ptr_psi_term tok, long *op)
Definition: parser.c:115
void crunch(long prec, long limit)
Definition: parser.c:636
ptr_psi_term error_psi_term
Definition: def_glob.h:23
int bad_psi_term(ptr_psi_term t)
Definition: parser.c:20
#define FALSE
Definition: def_const.h:128
#define xf
Definition: def_const.h:261
#define yf
Definition: def_const.h:263
#define MAX_PRECEDENCE
Definition: def_const.h:103
long parser_stack_index
Definition: def_glob.h:24
long stringparse
Definition: def_glob.h:202
long parse_ok
Definition: def_glob.h:171
psi_term read_psi_term()
Definition: parser.c:400
ptr_node attr_list
Definition: def_struct.h:171
#define fy
Definition: def_const.h:264
#define equ_tokch(A, B)
Definition: def_macro.h:66
psi_term read_psi_term ( )

Definition at line 400 of file parser.c.

References add_module1, add_module2, add_module3, alist, apply, wl_psi_term::attr_list, bad_psi_term(), wl_keyword::combined_name, wl_psi_term::coref, current_module, disjunction, eof, equ_tok, equ_tokch, equal_types, error_psi_term, FALSE, FEATCMP, feature_insert(), find(), functor, heap_copy_string(), integer, wl_definition::keyword, wl_module::module_name, NULL, parse_list(), parse_ok, wl_keyword::private_feature, put_back_token(), quoted_string, read_life_form(), read_token(), REAL, wl_psi_term::resid, stack_copy_psi_term(), stack_insert(), stack_psi_term(), stringparse, wl_keyword::symbol, Syntaxerrorline(), TRUE, two, wl_psi_term::type, wl_psi_term::value_3, variable, and wl_const_3.

401 {
402  psi_term t,t2,t3;
403  char s[10];
404  long count=0,f=TRUE,f2,v;
405  ptr_psi_term module;
406 
407 
408  if(parse_ok) {
409 
410  read_token(&t);
411 
412  if(equ_tokch(t,'['))
413  t=parse_list(alist,']',','); /*** RICHARD Nov_4 ***/
414  else
415  if(equ_tokch(t,'{'))
416  t=parse_list(disjunction,'}',';'); /*** RICHARD Nov_4 ***/
417 
418  /* The syntax <a,b,c> for conjunctions has been abandoned.
419  else
420  if(equ_tokch(t,'<'))
421  t=parse_list(conjunction,'>',',');
422  */
423 
424  if(parse_ok
425  && t.type!=eof
426  && !bad_psi_term(&t)
427  /* && (precedence(t,fx)==NOP)
428  && (precedence(t,fy)==NOP) */
429  ) {
430  read_token(&t2);
431  if(equ_tokch(t2,'(')) {
432 
433  do {
434 
435  f2=TRUE;
436  read_token(&t2);
437 
438  if(wl_const_3(t2) && !bad_psi_term(&t2)) {
439  read_token(&t3);
440  if(equ_tok(t3,"=>")) {
441  t3=read_life_form(',',')');
442 
443  if(t2.type->keyword->private_feature) /* RM: Mar 11 1993 */
445  /* RM: Jan 13 1993 */
446  &(t.attr_list),
447  &t3);
448  else
450  /* RM: Jan 13 1993 */
451  &(t.attr_list),
452  &t3);
453 
454  f2=FALSE;
455  }
456  else
457  put_back_token(t3);
458  }
459 
460  if(parse_ok && equal_types(t2.type,integer)) {
461  read_token(&t3);
462  if(equ_tok(t3,"=>")) {
463  t3=read_life_form(',',')');
464  v= *(REAL *)t2.value_3;
465  (void)snprintf(s,10,"%ld",v);
466  feature_insert(s,&(t.attr_list),&t3);
467  f2=FALSE;
468  }
469  else
470  put_back_token(t3);
471  }
472 
473  if(f2) {
474  put_back_token(t2);
475  t2=read_life_form(',',')');
476  ++count;
477  (void)snprintf(s,10,"%ld",count);
478  feature_insert(s,&(t.attr_list),&t2);
479  }
480 
481  read_token(&t2);
482 
483  if(equ_tokch(t2,')'))
484  f=FALSE;
485  else
486  if(!equ_tokch(t2,',')) {
488  else {
489  /*
490  perr("*** Syntax error ");psi_term_error();
491  perr(": ',' expected in argument list.\n");
492  */
493 
494  /* RM: Feb 1 1993 */
495  Syntaxerrorline("',' expected in argument list (%E)\n");
496 
497  f=FALSE;
498  }
499  }
500 
501  } while(f && parse_ok);
502  }
503  else
504  put_back_token(t2);
505  }
506  }
507  else
508  t= *error_psi_term;
509 
510  if(t.type==variable && t.attr_list) {
511  t2=t;
512  t.type=apply;
513  t.value_3=NULL;
514  t.coref=NULL;
515  t.resid=NULL;
516  (void)stack_insert(FEATCMP,(char *)functor->keyword->symbol,
517  &(t.attr_list),
519  }
520 
521 
522  /* RM: Mar 12 1993 Nasty hack for Bruno's features in modules */
523  if((t.type==add_module1 || t.type==add_module2 || t.type==add_module3) &&
524  !find(FEATCMP,two,t.attr_list)) {
525 
526  module=stack_psi_term(4);
527  module->type=quoted_string;
529 
530  (void)stack_insert(FEATCMP,two,&(t.attr_list),(GENERIC)module);
531  }
532 
533  return t;
534 }
ptr_residuation resid
Definition: def_struct.h:173
#define FEATCMP
Definition: def_const.h:257
void read_token(ptr_psi_term tok)
Definition: token.c:1063
char * combined_name
Definition: def_struct.h:92
ptr_module current_module
Definition: def_glob.h:161
char * two
Definition: def_glob.h:251
ptr_keyword keyword
Definition: def_struct.h:124
#define NULL
Definition: def_const.h:203
psi_term parse_list(ptr_definition typ, char e, char s)
Definition: parser.c:304
char * symbol
Definition: def_struct.h:91
ptr_definition apply
Definition: def_glob.h:72
void put_back_token(psi_term t)
Definition: token.c:647
#define REAL
Definition: def_const.h:72
ptr_definition add_module3
Definition: def_glob.h:69
char * heap_copy_string(char *s)
Definition: trees.c:147
psi_term read_life_form(char ch1, char ch2)
Definition: parser.c:700
void feature_insert(char *keystr, ptr_node *tree, ptr_psi_term psi)
Definition: parser.c:225
#define wl_const_3(S)
Definition: def_macro.h:104
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:291
ptr_definition alist
Definition: def_glob.h:94
ptr_definition functor
Definition: def_glob.h:91
ptr_definition eof
Definition: def_glob.h:86
void Syntaxerrorline(char *format,...)
Definition: error.c:498
#define TRUE
Definition: def_const.h:127
ptr_psi_term error_psi_term
Definition: def_glob.h:23
ptr_definition integer
Definition: def_glob.h:93
int bad_psi_term(ptr_psi_term t)
Definition: parser.c:20
#define FALSE
Definition: def_const.h:128
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_psi_term stack_copy_psi_term(psi_term t)
Definition: parser.c:183
char * module_name
Definition: def_struct.h:75
ptr_definition disjunction
Definition: def_glob.h:84
ptr_psi_term coref
Definition: def_struct.h:172
#define equal_types(A, B)
Definition: def_macro.h:106
ptr_definition add_module2
Definition: def_glob.h:68
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
ptr_definition add_module1
Definition: def_glob.h:67
int private_feature
Definition: def_struct.h:95
#define equ_tok(A, B)
Definition: def_macro.h:62
long stringparse
Definition: def_glob.h:202
long parse_ok
Definition: def_glob.h:171
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_definition variable
Definition: def_glob.h:111
ptr_node attr_list
Definition: def_struct.h:171
#define equ_tokch(A, B)
Definition: def_macro.h:66
void show ( long  limit)

Definition at line 52 of file parser.c.

References display_psi_stdout(), fx, int_stack, nop, parser_stack_index, psi_term_stack, xf, and xfx.

54 {
55  long i;
56 
57  for (i=1;i<=parser_stack_index;i++) {
58  if (i==limit)
59  printf("-> ");
60  else
61  printf(" ");
62  printf("%3ld: ",i);
63  switch (op_stack[i]) {
64  case fx:
65  printf("FX ");
66  break;
67  case xfx:
68  printf("XFX ");
69  break;
70  case xf:
71  printf("XF ");
72  break;
73  case nop:
74  printf("NOP ");
75  break;
76  default:
77  printf("??? ");
78  }
79  printf(" prec=%4ld ",int_stack[i]);
81  printf("\n");
82  }
83  printf("\n");
84 }
#define xfx
Definition: def_const.h:265
#define fx
Definition: def_const.h:262
void display_psi_stdout(ptr_psi_term t)
Definition: print.c:1427
#define nop
Definition: def_const.h:260
#define xf
Definition: def_const.h:261
long parser_stack_index
Definition: def_glob.h:24
long int_stack[PARSER_STACK_SIZE]
Definition: def_glob.h:318
psi_term psi_term_stack[PARSER_STACK_SIZE]
Definition: def_glob.h:317
ptr_psi_term stack_copy_psi_term ( psi_term  t)

Definition at line 183 of file parser.c.

References global_time_stamp, and STACK_ALLOC.

185 {
186  ptr_psi_term p;
187 
189  (*p)=t;
190 #ifdef TS
191  p->time_stamp=global_time_stamp; /* 9.6 */
192 #endif
193 
194  return p;
195 }
#define STACK_ALLOC(A)
Definition: def_macro.h:16
unsigned long global_time_stamp
Definition: login.c:19