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

Go to the source code of this file.

Functions

void print_def_type (def_type t)
 
long yes_or_no ()
 
void remove_cycles (ptr_definition d, ptr_int_list *dl)
 
long redefine (ptr_psi_term t)
 
ptr_int_list cons (GENERIC v, ptr_int_list l)
 
long assert_less (ptr_psi_term t1, ptr_psi_term t2)
 
void assert_protected (ptr_node n, long prot)
 
void assert_args_not_eval (ptr_node n)
 
void assert_delay_check (ptr_node n)
 
void clear_already_loaded (ptr_node n)
 
void assert_type (ptr_psi_term t)
 
void assert_complicated_type (ptr_psi_term t)
 
void assert_attributes (ptr_psi_term t)
 
void find_adults ()
 
void insert_own_prop (ptr_definition d)
 
void insert_prop (ptr_definition d, ptr_triple_list prop)
 
void propagate_definitions ()
 
long count_sorts (long c0)
 
void clear_coding ()
 
void least_sorts ()
 
void all_sorts ()
 
ptr_int_list two_to_the (long p)
 
ptr_int_list copyTypeCode (ptr_int_list u)
 
void or_codes (ptr_int_list u, ptr_int_list v)
 
void equalize_codes (int len)
 
long type_member ()
 
void make_type_link (ptr_definition t1, ptr_definition t2)
 
long type_member (ptr_definition t, ptr_int_list tlst)
 
void perr_sort (ptr_definition d)
 
void perr_sort_list (ptr_int_list anc)
 
void perr_sort_cycle (ptr_int_list anc)
 
long type_cyclicity (ptr_definition d, ptr_int_list anc)
 
void propagate_always_check (ptr_definition d, long *ch)
 
void one_pass_always_check (long *ch)
 
void inherit_always_check ()
 
void encode_types ()
 
void print_codes ()
 
long sub_CodeType ()
 
long glb_value (long result, long f, GENERIC c, GENERIC value1, GENERIC value2, GENERIC *value)
 
long glb_code (long f1, GENERIC c1, long f2, GENERIC c2, long *f3, GENERIC *c3)
 
long glb (ptr_definition t1, ptr_definition t2, ptr_definition *t3, ptr_int_list *c3)
 
long overlap_type (ptr_definition t1, ptr_definition t2)
 
long sub_CodeType (ptr_int_list c1, ptr_int_list c2)
 
long sub_type (ptr_definition t1, ptr_definition t2)
 
long matches (ptr_definition t1, ptr_definition t2, long *smaller)
 
long strict_matches (ptr_psi_term t1, ptr_psi_term t2, long *smaller)
 
long bit_length (ptr_int_list c)
 
ptr_int_list decode (ptr_int_list c)
 

Variables

ptr_definitiongamma_table = NULL
 

Function Documentation

void all_sorts ( )

Definition at line 716 of file types.c.

References cons(), first_definition, wl_definition::next, nothing, wl_definition::parents, wl_definition::type_def, and type_it.

718 {
719  ptr_definition d;
720 
721  for(d=first_definition;d;d=d->next)
722  if (d->type_def==(def_type)type_it && d!=nothing)
724 }
def_type type_def
Definition: def_struct.h:133
ptr_int_list cons(GENERIC v, ptr_int_list l)
Definition: types.c:164
#define type_it
Definition: def_const.h:363
ptr_definition next
Definition: def_struct.h:148
ptr_definition first_definition
Definition: def_glob.h:3
ptr_definition nothing
Definition: def_glob.h:98
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_int_list parents
Definition: def_struct.h:130
void assert_args_not_eval ( ptr_node  n)

Definition at line 273 of file types.c.

References deref_ptr, wl_definition::evaluate_args, FALSE, wl_definition::keyword, wl_keyword::symbol, wl_psi_term::type, wl_definition::type_def, type_it, and warningline().

275 {
276  ptr_psi_term t;
277 
278  if (n) {
280 
281  t=(ptr_psi_term)n->data;
282  deref_ptr(t);
283  if (t->type) {
284  if (t->type->type_def==(def_type)type_it) {
285  warningline("'%s' is a sort--only functions and predicates\
286  can have unevaluated arguments.\n",t->type->keyword->symbol);
287  }
288  else
290  }
291 
293  }
294 }
char evaluate_args
Definition: def_struct.h:136
void assert_args_not_eval(ptr_node n)
Definition: types.c:273
def_type type_def
Definition: def_struct.h:133
ptr_keyword keyword
Definition: def_struct.h:124
GENERIC data
Definition: def_struct.h:185
char * symbol
Definition: def_struct.h:91
ptr_node left
Definition: def_struct.h:183
#define type_it
Definition: def_const.h:363
#define deref_ptr(P)
Definition: def_macro.h:95
#define FALSE
Definition: def_const.h:128
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void warningline(char *format,...)
Definition: error.c:327
ptr_definition type
Definition: def_struct.h:165
ptr_node right
Definition: def_struct.h:184
void assert_attributes ( ptr_psi_term  t)

Definition at line 468 of file types.c.

References add_rule(), wl_psi_term::attr_list, deref_ptr, Errorline(), function_it, get_two_args(), wl_definition::keyword, NULL, predicate, wl_keyword::symbol, TRUE, wl_psi_term::type, wl_definition::type_def, type_it, types_modified, and wl_const_3.

470 {
471  ptr_psi_term arg1,arg2,pred=NULL,typ;
472  ptr_definition d;
473 
474  get_two_args(t->attr_list,&arg1,&arg2);
475 
476  if (arg1) {
477  typ=arg1;
478  deref_ptr(arg1);
479  if (!strcmp(arg1->type->keyword->symbol,"|")) {
480  get_two_args(arg1->attr_list,&arg1,&pred);
481  if (arg1) {
482  typ=arg1;
483  deref_ptr(arg1);
484  }
485  }
486 
487  if (arg1 && wl_const_3(*arg1)) {
488  /* if (!redefine(arg1)) return; RM: Feb 19 1993 */
489  d=arg1->type;
491  Errorline("the %T '%s' may not be redefined as a sort.\n",
492  d->type_def, d->keyword->symbol);
493  }
494  else {
497  add_rule(typ,pred,(def_type)type_it);
498  }
499  }
500  else {
501  Errorline("bad argument in sort declaration '%P' (%E).\n",t);
502  }
503  }
504  else {
505  Errorline("argument missing in sort declaration (%E).\n");
506  }
507 }
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
struct wl_definition * def_type
Definition: def_struct.h:32
def_type type_def
Definition: def_struct.h:133
ptr_keyword keyword
Definition: def_struct.h:124
#define NULL
Definition: def_const.h:203
char * symbol
Definition: def_struct.h:91
long types_modified
Definition: def_glob.h:47
#define type_it
Definition: def_const.h:363
void Errorline(char *format,...)
Definition: error.c:414
#define wl_const_3(S)
Definition: def_macro.h:104
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
void add_rule(ptr_psi_term head, ptr_psi_term body, def_type typ)
Definition: login.c:148
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
void assert_complicated_type ( ptr_psi_term  t)

Definition at line 375 of file types.c.

References add_rule(), assert_less(), assert_ok, wl_psi_term::attr_list, deref_ptr, disjunction, equ_tok, Errorline(), FALSE, get_two_args(), wl_definition::keyword, nil, NULL, wl_keyword::symbol, TRUE, wl_psi_term::type, type_it, and warningline().

377 {
378  ptr_psi_term arg2,typ1,typ2,pred=NULL;
379  // ptr_list lst;
380  long eqflag = equ_tok((*t),":=");
381  long ok, any_ok=FALSE;
382 
383  get_two_args(t->attr_list,&typ1,&arg2);
384 
385  if (typ1 && arg2) {
386  deref_ptr(typ1);
387  deref_ptr(arg2);
388  typ2=arg2;
389  if (!strcmp(arg2->type->keyword->symbol,"|")) {
390  typ2=NULL;
391  get_two_args(arg2->attr_list,&arg2,&pred);
392  if (arg2) {
393  deref_ptr(arg2);
394  typ2=arg2;
395  }
396  }
397  if (typ2) {
398  if (typ2->type==disjunction) {
399 
400  if (typ1->attr_list && eqflag) {
401  warningline("attributes ignored left of ':=' declaration (%E).\n");
402  }
403  while(typ2 && typ2->type!=nil) {
404  get_two_args(typ2->attr_list,&arg2,&typ2); /* RM: Dec 14 1992 */
405  if(typ2)
406  deref_ptr(typ2);
407  if (arg2) {
408  deref_ptr(arg2);
409  if (eqflag) {
410  ok=assert_less(arg2,typ1);
411  if (ok) any_ok=TRUE;
412  if (ok && (arg2->attr_list || pred!=NULL)) {
413  add_rule(arg2,pred,(def_type)type_it);
414  }
415  }
416  else {
417  ok=assert_less(typ1,arg2);
418  if (ok) any_ok=TRUE;
419  if (ok && arg2->attr_list) {
420  warningline("attributes ignored in sort declaration (%E).\n");
421  }
422  }
423  }
424  }
425  assert_ok=TRUE;
426  }
427  else if (eqflag) {
428  if (typ1->attr_list) {
429  warningline("attributes ignored left of ':=' declaration (%E).\n");
430  }
431  ok=assert_less(typ1,typ2);
432  if (ok) any_ok=TRUE;
433  typ2->type=typ1->type;
434  if (ok && (typ2->attr_list || pred!=NULL))
435  add_rule(typ2,pred,(def_type)type_it);
436  else
437  assert_ok=TRUE;
438  }
439  else {
440  if (typ2->attr_list) {
441  warningline("attributes ignored right of '<|' declaration (%E).\n");
442  }
443  ok=assert_less(typ1,typ2);
444  if (ok) any_ok=TRUE;
445  if (ok && (typ1->attr_list || pred!=NULL))
446  add_rule(typ1,pred,(def_type)type_it);
447  else
448  assert_ok=TRUE;
449  }
450  }
451  else {
452  Errorline("argument missing in sort declaration (%E).\n");
453  }
454  }
455  else {
456  Errorline("argument missing in sort declaration (%E).\n");
457  }
458  if (!any_ok) assert_ok=FALSE;
459 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
long assert_less(ptr_psi_term t1, ptr_psi_term t2)
Definition: types.c:183
ptr_keyword keyword
Definition: def_struct.h:124
#define NULL
Definition: def_const.h:203
char * symbol
Definition: def_struct.h:91
long assert_ok
Definition: def_glob.h:59
#define type_it
Definition: def_const.h:363
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_definition disjunction
Definition: def_glob.h:84
ptr_definition nil
Definition: def_glob.h:97
#define equ_tok(A, B)
Definition: def_macro.h:62
void add_rule(ptr_psi_term head, ptr_psi_term body, def_type typ)
Definition: login.c:148
void warningline(char *format,...)
Definition: error.c:327
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
void assert_delay_check ( ptr_node  n)

Definition at line 303 of file types.c.

References wl_definition::always_check, deref_ptr, FALSE, and wl_psi_term::type.

305 {
306  if (n) {
307  ptr_psi_term t;
309 
310  t=(ptr_psi_term)n->data;
311  deref_ptr(t);
312  if (t->type) {
313  t->type->always_check=FALSE;
314  }
315 
317  }
318 }
GENERIC data
Definition: def_struct.h:185
char always_check
Definition: def_struct.h:134
ptr_node left
Definition: def_struct.h:183
#define deref_ptr(P)
Definition: def_macro.h:95
#define FALSE
Definition: def_const.h:128
void assert_delay_check(ptr_node n)
Definition: types.c:303
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_definition type
Definition: def_struct.h:165
ptr_node right
Definition: def_struct.h:184
long assert_less ( ptr_psi_term  t1,
ptr_psi_term  t2 
)

Definition at line 183 of file types.c.

References deref_ptr, Errorline(), FALSE, function_it, wl_definition::keyword, make_type_link(), predicate, redefine(), wl_keyword::symbol, top, TRUE, wl_definition::type_def, type_it, and types_modified.

185 {
186  ptr_definition d1,d2;
187  long ok=FALSE;
188  deref_ptr(t1);
189  deref_ptr(t2);
190 
191  if (t1->type==top) {
192  Errorline("the top sort '@' may not be a subsort.\n");
193  return FALSE;
194  }
195  if (t1->value_3 || t2->value_3) {
196  Errorline("the declaration '%P <| %P' is illegal.\n",t1,t2);
197  return FALSE;
198  }
199  /* Note: A *full* cyclicity check of the hierarchy is done in encode_types. */
200  if (t1->type==t2->type) {
201  Errorline("cyclic sort declarations are not allowed.\n");
202  return FALSE;
203  }
204 
205  if (!redefine(t1)) return FALSE;
206  if (!redefine(t2)) return FALSE;
207  d1=t1->type;
208  d2=t2->type;
210  Errorline("the %T '%s' may not be redefined as a sort.\n",
211  d1->type_def, d1->keyword->symbol);
212  }
213  else if (d2->type_def==(def_type)predicate || d2->type_def==(def_type)function_it) {
214  Errorline("the %T '%s' may not be redefined as a sort.\n",
215  d2->type_def, d2->keyword->symbol);
216  }
217  else {
221  make_type_link(d1, d2); /* 1.7 */
222  /* d1->parents=cons(d2,d1->parents); */
223  /* d2->children=cons(d1,d2->children); */
224  ok=TRUE;
225  }
226 
227  return ok;
228 }
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
struct wl_definition * def_type
Definition: def_struct.h:32
long redefine(ptr_psi_term t)
Definition: types.c:91
def_type type_def
Definition: def_struct.h:133
ptr_keyword keyword
Definition: def_struct.h:124
ptr_definition top
Definition: def_glob.h:106
char * symbol
Definition: def_struct.h:91
long types_modified
Definition: def_glob.h:47
#define type_it
Definition: def_const.h:363
void make_type_link(ptr_definition t1, ptr_definition t2)
Definition: types.c:848
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
ptr_definition type
Definition: def_struct.h:165
void assert_protected ( ptr_node  n,
long  prot 
)

Definition at line 235 of file types.c.

References wl_definition::date, deref_ptr, wl_definition::keyword, MAX_BUILT_INS, wl_definition::protected, wl_definition::rule, wl_keyword::symbol, wl_psi_term::type, wl_definition::type_def, type_it, and warningline().

238 {
239  ptr_psi_term t;
240 
241  if (n) {
242  assert_protected(n->left,prot);
243 
244  t=(ptr_psi_term)n->data;
245  deref_ptr(t);
246  if (t->type) {
247  if (t->type->type_def==(def_type)type_it) {
248  warningline("'%s' is a sort. It can be extended without a declaration.\n",
249  t->type->keyword->symbol);
250  }
251  else if ((unsigned long)t->type->rule<MAX_BUILT_INS &&
252  (unsigned long)t->type->rule>0) {
253  if (!prot)
254  warningline("'%s' is a built-in--it has not been made dynamic.\n",
255  t->type->keyword->symbol);
256  }
257  else {
258  t->type->protected=prot;
259  if (prot) t->type->date&=(~1); else t->type->date|=1;
260  }
261  }
262 
263  assert_protected(n->right,prot);
264  }
265 }
def_type type_def
Definition: def_struct.h:133
ptr_keyword keyword
Definition: def_struct.h:124
void assert_protected(ptr_node n, long prot)
Definition: types.c:235
GENERIC data
Definition: def_struct.h:185
char * symbol
Definition: def_struct.h:91
ptr_node left
Definition: def_struct.h:183
#define type_it
Definition: def_const.h:363
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_pair_list rule
Definition: def_struct.h:126
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
#define MAX_BUILT_INS
Definition: def_const.h:82
void warningline(char *format,...)
Definition: error.c:327
ptr_definition type
Definition: def_struct.h:165
ptr_node right
Definition: def_struct.h:184
void assert_type ( ptr_psi_term  t)

Definition at line 345 of file types.c.

References assert_less(), assert_ok, Errorline(), get_two_args(), and NULL.

347 {
348  ptr_psi_term arg1,arg2;
349 
350  get_two_args(t->attr_list,&arg1,&arg2);
351  if(arg1==NULL || arg2==NULL) {
352  Errorline("bad sort declaration '%P' (%E).\n",t);
353  }
354  else
355  assert_ok=assert_less(arg1,arg2);
356 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
long assert_less(ptr_psi_term t1, ptr_psi_term t2)
Definition: types.c:183
#define NULL
Definition: def_const.h:203
long assert_ok
Definition: def_glob.h:59
void Errorline(char *format,...)
Definition: error.c:414
ptr_node attr_list
Definition: def_struct.h:171
long bit_length ( ptr_int_list  c)

Definition at line 1648 of file types.c.

References INT_SIZE, and wl_int_list::value_1.

1650 {
1651  unsigned long p=0,dp=0,v=0,dv=0;
1652 
1653  while (c) {
1654  v=(unsigned long)c->value_1;
1655  if(v) {
1656  dp=p;
1657  dv=v;
1658  }
1659  c=c->next;
1660  p=p+INT_SIZE;
1661  }
1662 
1663  while (dv) {
1664  dp++;
1665  dv=dv>>1;
1666  }
1667 
1668  return dp;
1669 }
#define INT_SIZE
Definition: def_const.h:144
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
void clear_already_loaded ( ptr_node  n)

Definition at line 326 of file types.c.

References wl_definition::already_loaded, and FALSE.

328 {
329  ptr_definition d;
330 
331  if (n) {
332  d=((ptr_keyword)n->data)->definition;
336  }
337 }
char already_loaded
Definition: def_struct.h:137
void clear_already_loaded(ptr_node n)
Definition: types.c:326
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
#define FALSE
Definition: def_const.h:128
struct wl_keyword * ptr_keyword
Definition: def_struct.h:99
ptr_node right
Definition: def_struct.h:184
void clear_coding ( )

Definition at line 685 of file types.c.

References wl_definition::code, first_definition, wl_definition::next, NOT_CODED, wl_definition::type_def, and type_it.

687 {
688  ptr_definition d;
689 
690  for(d=first_definition;d;d=d->next)
691  if (d->type_def==(def_type)type_it) d->code=NOT_CODED;
692 }
#define NOT_CODED
Definition: def_const.h:134
def_type type_def
Definition: def_struct.h:133
#define type_it
Definition: def_const.h:363
ptr_definition next
Definition: def_struct.h:148
ptr_definition first_definition
Definition: def_glob.h:3
ptr_int_list code
Definition: def_struct.h:129
ptr_int_list cons ( GENERIC  v,
ptr_int_list  l 
)

Definition at line 164 of file types.c.

References HEAP_ALLOC, wl_int_list::next, and wl_int_list::value_1.

167 {
168  ptr_int_list n;
169 
170  n=HEAP_ALLOC(int_list);
171  n->value_1=v;
172  n->next=l;
173 
174  return n;
175 }
GENERIC value_1
Definition: def_struct.h:54
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_int_list next
Definition: def_struct.h:55
ptr_int_list copyTypeCode ( ptr_int_list  u)

Definition at line 760 of file types.c.

References HEAP_ALLOC, wl_int_list::next, NULL, or_codes(), and wl_int_list::value_1.

762 {
763  ptr_int_list code;
764 
765  code = HEAP_ALLOC(int_list);
766  code->value_1=0;
767  code->next=NULL;
768 
769  or_codes(code, u);
770 
771  return code;
772 }
#define NULL
Definition: def_const.h:203
GENERIC value_1
Definition: def_struct.h:54
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
void or_codes(ptr_int_list u, ptr_int_list v)
Definition: types.c:780
ptr_int_list next
Definition: def_struct.h:55
long count_sorts ( long  c0)

Definition at line 669 of file types.c.

References first_definition, wl_definition::next, wl_definition::type_def, and type_it.

671 {
672  ptr_definition d;
673 
674  for(d=first_definition;d;d=d->next)
675  if (d->type_def==(def_type)type_it) c0++;
676 
677  return c0;
678 }
def_type type_def
Definition: def_struct.h:133
#define type_it
Definition: def_const.h:363
ptr_definition next
Definition: def_struct.h:148
ptr_definition first_definition
Definition: def_glob.h:3
ptr_int_list decode ( ptr_int_list  c)

Definition at line 1678 of file types.c.

References bit_length(), wl_definition::code, cons(), wl_int_list::next, NULL, STACK_ALLOC, and wl_int_list::value_1.

1680 {
1681  ptr_int_list c2,c3,c4,result=NULL,*prev;
1682  long p;
1683 
1684  p=bit_length(c);
1685 
1686  while (p) {
1687  p--;
1688  c2=gamma_table[p]->code;
1689  result=cons((GENERIC)gamma_table[p],result);
1690  prev= &c4;
1691  *prev=NULL;
1692 
1693  while (c2) {
1694  c3=STACK_ALLOC(int_list);
1695  *prev=c3;
1696  prev= &(c3->next);
1697  *prev=NULL;
1698 
1699  c3->value_1=(GENERIC)(((unsigned long)(c->value_1)) & ~((unsigned long)(c2->value_1)));
1700 
1701  c=c->next;
1702  c2=c2->next;
1703  }
1704 
1705  c=c4;
1706  p=bit_length(c);
1707  }
1708 
1709  return result;
1710 }
ptr_definition * gamma_table
Definition: types.c:16
ptr_int_list cons(GENERIC v, ptr_int_list l)
Definition: types.c:164
#define NULL
Definition: def_const.h:203
long bit_length(ptr_int_list c)
Definition: types.c:1648
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_int_list next
Definition: def_struct.h:55
void encode_types ( )

Definition at line 1015 of file types.c.

References all_sorts(), built_in, wl_definition::children, clear_coding(), wl_definition::code, cons(), count_sorts(), equalize_codes(), Errorline(), FALSE, heap_alloc(), inherit_always_check(), integer, wl_definition::keyword, least_sorts(), lf_false, lf_true, make_sys_type_links(), make_type_link(), wl_int_list::next, NOT_CODED, nothing, NULL, or_codes(), overlap_type(), wl_definition::parents, perr(), propagate_definitions(), quoted_string, real, wl_keyword::symbol, top, traceline(), TRUE, two_to_the(), type_count, type_cyclicity(), types_done, types_modified, and wl_int_list::value_1.

1016 {
1017  long p=0,i,possible,ok=TRUE;
1018  ptr_int_list layer,l,kids,dads,code;
1019  ptr_definition xdef,kdef,ddef; //,err;
1020 
1021  if (types_modified) {
1022 
1023  nothing->parents=NULL;
1025 
1026  top->parents=NULL;
1027  top->children=NULL;
1028 
1029  /* The following definitions are vital to avoid crashes */
1031  make_type_link(lf_true,boolean);
1032  make_type_link(lf_false,boolean);
1033 
1034  /* These just might be useful */
1036  make_type_link(boolean,built_in);
1038 
1040 
1041  type_count=count_sorts(-1); /* bottom does not count */
1042  clear_coding();
1043  nothing->parents=NULL; /* Must be cleared before all_sorts */
1044  all_sorts();
1045  if (type_cyclicity(nothing,NULL)) {
1046  clear_coding();
1047  return;
1048  }
1049  clear_coding();
1050  nothing->parents=NULL; /* Must be cleared before least_sorts */
1051  least_sorts();
1052 
1053  nothing->code=NULL;
1054 
1055  /* RM: Feb 17 1993 */
1056  traceline("*** Codes:\n%C= %s\n", NULL, nothing->keyword->symbol);
1057 
1059 
1060  layer=nothing->parents;
1061 
1062  while (layer) {
1063  l=layer;
1064  do {
1065  xdef=(ptr_definition)l->value_1;
1066  if (xdef->code==NOT_CODED && xdef!=top) {
1067 
1068  kids=xdef->children;
1069  code=two_to_the(p);
1070 
1071  while (kids) {
1072  kdef=(ptr_definition)kids->value_1;
1073  or_codes(code,kdef->code);
1074  kids=kids->next;
1075  }
1076 
1077  xdef->code=code;
1078  gamma_table[p]=xdef;
1079 
1080  /* RM: Feb 17 1993 */
1081  traceline("%C = %s\n", code, xdef->keyword->symbol);
1082  p=p+1;
1083  }
1084 
1085  l=l->next;
1086 
1087  } while (l);
1088 
1089  l=layer;
1090  layer=NULL;
1091 
1092  do {
1093  xdef=(ptr_definition)l->value_1;
1094  dads=xdef->parents;
1095 
1096  while (dads) {
1097  ddef=(ptr_definition)dads->value_1;
1098  if(ddef->code==NOT_CODED) {
1099 
1100  possible=TRUE;
1101  kids=ddef->children;
1102 
1103  while(kids && possible) {
1104  kdef=(ptr_definition)kids->value_1;
1105  if(kdef->code==NOT_CODED)
1106  possible=FALSE;
1107  kids=kids->next;
1108  }
1109  if(possible)
1110  layer=cons((GENERIC)ddef,layer);
1111  }
1112  dads=dads->next;
1113  }
1114  l=l->next;
1115  } while(l);
1116  }
1117 
1118  top->code=two_to_the(p);
1119  for (i=0;i<p;i++)
1120  or_codes(top->code,two_to_the(i));
1121 
1122  gamma_table[p]=top;
1123 
1124  /* RM: Jan 13 1993 */
1125  /* Added the following line because type_count is now over generous
1126  because the same definition can be referenced several times in
1127  the symbol table because of modules
1128  */
1129  type_count=p+1;
1130  for(i=type_count;i<type_count;i++)
1131  gamma_table[i]=NULL;
1132 
1133  traceline("%C = @\n\n", top->code);
1134  equalize_codes(p/32+1);
1135 
1137 
1138  /* Inherit 'FALSE' always_check flags to all types' children */
1140 
1141  traceline("*** Encoding done, %d sorts\n",type_count);
1142 
1144  Errorline("the sorts 'real' and 'string' are not disjoint.\n");
1145  ok=FALSE;
1146  }
1147 
1148  /* RM: Dec 15 1992 I don't think this really matters any more
1149  if (overlap_type(real,alist)) {
1150  Errorline("the sorts 'real' and 'list' are not disjoint.\n");
1151  ok=FALSE;
1152  }
1153  */
1154 
1155  /* RM: Dec 15 1992 I don't think this really matters any more
1156  if (overlap_type(alist,quoted_string)) {
1157  Errorline("the sorts 'list' and 'string' are not disjoint.\n");
1158  ok=FALSE;
1159  }
1160  */
1161 
1162  if (!ok) {
1163  perr("*** Internal problem:\n");
1164  perr("*** Wild_Life may behave abnormally because some basic types\n");
1165  perr("*** have been defined incorrectly.\n\n");
1166  }
1167 
1169  types_done=TRUE;
1170  }
1171 }
long type_cyclicity(ptr_definition d, ptr_int_list anc)
Definition: types.c:907
ptr_definition * gamma_table
Definition: types.c:16
void least_sorts()
Definition: types.c:700
void perr(char *str)
Definition: error.c:659
long type_count
Definition: def_glob.h:46
#define NOT_CODED
Definition: def_const.h:134
ptr_int_list two_to_the(long p)
Definition: types.c:731
void propagate_definitions()
Definition: types.c:622
void clear_coding()
Definition: types.c:685
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
ptr_keyword keyword
Definition: def_struct.h:124
ptr_int_list cons(GENERIC v, ptr_int_list l)
Definition: types.c:164
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
void make_sys_type_links()
Definition: sys.c:1726
char * symbol
Definition: def_struct.h:91
long types_modified
Definition: def_glob.h:47
void inherit_always_check()
Definition: types.c:994
void traceline(char *format,...)
Definition: error.c:157
void make_type_link(ptr_definition t1, ptr_definition t2)
Definition: types.c:848
void Errorline(char *format,...)
Definition: error.c:414
ptr_definition real
Definition: def_glob.h:102
#define TRUE
Definition: def_const.h:127
void all_sorts()
Definition: types.c:716
ptr_definition built_in
Definition: def_glob.h:75
ptr_definition integer
Definition: def_glob.h:93
ptr_definition lf_true
Definition: def_glob.h:107
#define FALSE
Definition: def_const.h:128
ptr_definition quoted_string
Definition: def_glob.h:101
struct wl_definition * ptr_definition
Definition: def_struct.h:31
ptr_definition lf_false
Definition: def_glob.h:89
void equalize_codes(int len)
Definition: types.c:806
long types_done
Definition: def_glob.h:36
ptr_definition nothing
Definition: def_glob.h:98
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
long count_sorts(long c0)
Definition: types.c:669
ptr_int_list children
Definition: def_struct.h:131
GENERIC heap_alloc(long s)
Definition: memory.c:1518
void or_codes(ptr_int_list u, ptr_int_list v)
Definition: types.c:780
ptr_int_list next
Definition: def_struct.h:55
ptr_int_list parents
Definition: def_struct.h:130
void equalize_codes ( int  len)

Definition at line 806 of file types.c.

References assert, wl_definition::code, first_definition, HEAP_ALLOC, wl_int_list::next, wl_definition::next, NULL, wl_definition::type_def, and type_it.

808 {
809  ptr_definition d;
810  ptr_int_list c,*ci;
811  long i;
812  int w;
813 
814  for(d=first_definition;d;d=d->next)
815  if (d->type_def==(def_type)type_it) {
816  c = d->code;
817  ci = &(d->code); /* RM: Feb 15 1993 */
818  w=len;
819 
820  /* Count how many words have to be added */
821  while (c) {
822  ci= &(c->next);
823  c=c->next;
824  w--;
825  }
826  assert(w>=0);
827  /* Add the words */
828  for (i=0; i<w; i++) {
829  *ci = HEAP_ALLOC(int_list);
830  (*ci)->value_1=0;
831  ci= &((*ci)->next);
832  }
833  (*ci)=NULL;
834  }
835 }
def_type type_def
Definition: def_struct.h:133
#define NULL
Definition: def_const.h:203
#define type_it
Definition: def_const.h:363
ptr_definition next
Definition: def_struct.h:148
ptr_definition first_definition
Definition: def_glob.h:3
ptr_int_list code
Definition: def_struct.h:129
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
#define assert(N)
Definition: memory.c:104
ptr_int_list next
Definition: def_struct.h:55
void find_adults ( )

Definition at line 516 of file types.c.

References adults, first_definition, HEAP_ALLOC, wl_int_list::next, wl_definition::next, NULL, wl_definition::parents, wl_definition::type_def, type_it, and wl_int_list::value_1.

518 {
519  ptr_definition d;
520  ptr_int_list l;
521 
522  for(d=first_definition;d;d=d->next)
523  if(d->type_def==(def_type)type_it && d->parents==NULL) {
524  l=HEAP_ALLOC(int_list);
525  l->value_1=(GENERIC)d;
526  l->next=adults;
527  adults=l;
528  }
529 }
def_type type_def
Definition: def_struct.h:133
#define NULL
Definition: def_const.h:203
#define type_it
Definition: def_const.h:363
ptr_definition next
Definition: def_struct.h:148
ptr_definition first_definition
Definition: def_glob.h:3
ptr_int_list adults
Definition: def_glob.h:354
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_int_list next
Definition: def_struct.h:55
ptr_int_list parents
Definition: def_struct.h:130
long glb ( ptr_definition  t1,
ptr_definition  t2,
ptr_definition t3,
ptr_int_list c3 
)

Definition at line 1388 of file types.c.

References wl_definition::code, FALSE, wl_int_list::next, NOT_CODED, nothing, NULL, STACK_ALLOC, top, TRUE, and wl_int_list::value_1.

1393 {
1394  ptr_int_list c1,c2;
1395  long result=0;
1396  unsigned long v1,v2,v3;
1397  int e1,e2,b; /* RM: May 7 1993 */
1398 
1399 
1400 
1401  *c3=NULL;
1402 
1403  if (t1==t2) {
1404  result=1;
1405  *t3= t1;
1406  }
1407  else if (t1==top) {
1408  *t3= t2;
1409  if (t2==top)
1410  result=1;
1411  else
1412  result=3;
1413  }
1414  else if (t2==top) {
1415  result=2;
1416  *t3= t1;
1417  }
1418  else {
1419  /* printf("glb of %s and %s\n",
1420  t1->keyword->combined_name,
1421  t2->keyword->combined_name); */
1422 
1423  c1=t1->code;
1424  c2=t2->code;
1425 
1426  e1=TRUE;e2=TRUE;b=TRUE;
1427 
1428  if (c1!=NOT_CODED && c2!=NOT_CODED) {
1429  result=0;
1430  while (c1 && c2) {
1431 
1432  *c3 = STACK_ALLOC(int_list);
1433  (*c3)->next=NULL;
1434 
1435  v1=(unsigned long)(c1->value_1);
1436  v2=(unsigned long)(c2->value_1);
1437  v3=v1 & v2;
1438 
1439  /* printf("v1=%d, v2=%d, v3=%d\n",v1,v2,v3); */
1440 
1441  (*c3)->value_1=(GENERIC)v3;
1442 
1443  if(v3!=v1) /* RM: May 7 1993 */
1444  e1=FALSE;
1445  if(v3!=v2)
1446  e2=FALSE;
1447  if(v3)
1448  b=FALSE;
1449 
1450  c1=c1->next;
1451  c2=c2->next;
1452  c3= &((*c3)->next);
1453  }
1454  *t3=NULL;
1455 
1456  if(b) /* RM: May 7 1993 */
1457  result=0; /* 0 if T3 = bottom */
1458  else
1459  if(e1)
1460  if(e2)
1461  result=1; /* 1 if T1 = T2 */
1462  else
1463  result=2; /* 2 if T1 <| T2 ( T3 = T1 ) */
1464  else
1465  if(e2)
1466  result=3; /* 3 if T1 |> T2 ( T3 = T2 ) */
1467  else
1468  result=4; /* 4 otherwise */
1469  }
1470  }
1471 
1472  if (!result) *t3=nothing;
1473 
1474  /* printf("result=%d\n\n",result); */
1475 
1476  return result;
1477 }
#define NOT_CODED
Definition: def_const.h:134
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_definition nothing
Definition: def_glob.h:98
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_int_list next
Definition: def_struct.h:55
long glb_code ( long  f1,
GENERIC  c1,
long  f2,
GENERIC  c2,
long*  f3,
GENERIC c3 
)

Definition at line 1263 of file types.c.

References wl_definition::code, FALSE, wl_int_list::next, NOT_CODED, NULL, STACK_ALLOC, top, TRUE, and wl_int_list::value_1.

1266 {
1267  long result=0;
1268  unsigned long v1,v2,v3;
1269  ptr_int_list cd1,cd2,*cd3; /* sort codes */
1270 
1271  /* First, the cases where c1 & c2 are ptr_definitions: */
1272  if (f1 && f2) {
1273  if ((ptr_definition)c1==(ptr_definition)c2) {
1274  *c3=c1;
1275  result=1;
1276  }
1277  else if ((ptr_definition)c1==top) {
1278  *c3=c2;
1279  if ((ptr_definition)c2==top)
1280  result=1;
1281  else
1282  result=3;
1283  }
1284  else if ((ptr_definition)c2==top) {
1285  *c3=c1;
1286  result=2;
1287  }
1288  /* If both inputs are either top or the same ptr_definition */
1289  /* then can return quickly with a ptr_definition. */
1290  if (result) {
1291  *f3=TRUE; /* c3 is ptr_definition (an interned symbol) */
1292  return result;
1293  }
1294  }
1295  /* In the other cases, can't return with a ptr_definition: */
1296  cd1=(ptr_int_list)(f1?(GENERIC)((ptr_definition)c1)->code:c1);
1297  cd2=(ptr_int_list)(f2?(GENERIC)((ptr_definition)c2)->code:c2);
1298  cd3=(ptr_int_list*)c3;
1299  *f3=FALSE; /* cd3 is ptr_int_list (a sort code) */
1300  if (cd1==NOT_CODED) {
1301  if (cd2==NOT_CODED) {
1302  if (c1==c2) {
1303  *cd3=cd1;
1304  result=1;
1305  }
1306  else
1307  result=0;
1308  }
1309  else if (cd2==top->code) {
1310  *cd3=cd1;
1311  result=2;
1312  }
1313  else
1314  result=0;
1315  }
1316  else if (cd1==top->code) {
1317  if (cd2==top->code) {
1318  *cd3=cd1;
1319  result=1;
1320  }
1321  else {
1322  *cd3=cd2;
1323  result=3;
1324  }
1325  }
1326  else if (cd2==NOT_CODED)
1327  result=0;
1328  else if (cd2==top->code) {
1329  *cd3=cd1;
1330  result=2;
1331  }
1332  else while (cd1 && cd2) {
1333  /* Bit operations needed only if c1 & c2 coded & different from top */
1334  *cd3 = STACK_ALLOC(int_list);
1335  (*cd3)->next=NULL;
1336 
1337  v1=(unsigned long)(cd1->value_1);
1338  v2=(unsigned long)(cd2->value_1);
1339  v3=v1 & v2;
1340  (*cd3)->value_1=(GENERIC)v3;
1341 
1342  if (v3) {
1343  if (v3<v1 && v3<v2)
1344  result=4;
1345  else if (result!=4)
1346  if (v1<v2)
1347  result=2;
1348  else if (v1>v2)
1349  result=3;
1350  else
1351  result=1;
1352  }
1353  else if (result)
1354  if (v1 || v2)
1355  result=4;
1356 
1357  cd1=cd1->next;
1358  cd2=cd2->next;
1359  cd3= &((*cd3)->next);
1360  }
1361 
1362  return result;
1363 }
#define NOT_CODED
Definition: def_const.h:134
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
struct wl_definition * ptr_definition
Definition: def_struct.h:31
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
struct wl_int_list * ptr_int_list
Definition: def_struct.h:29
ptr_int_list next
Definition: def_struct.h:55
long glb_value ( long  result,
long  f,
GENERIC  c,
GENERIC  value1,
GENERIC  value2,
GENERIC value 
)

Definition at line 1206 of file types.c.

References wl_definition::code, FALSE, NULL, quoted_string, REAL, real, sub_CodeType(), and TRUE.

1211 {
1212  ptr_int_list code;
1213 
1214  if (!result) return FALSE;
1215  if (value1==NULL) {
1216  *value=value2;
1217  return TRUE;
1218  }
1219  if (value2==NULL) {
1220  *value=value1;
1221  return TRUE;
1222  }
1223  /* At this point, both value fields are non-NULL */
1224  /* and must be compared. */
1225 
1226  /* Get a pointer to the sort code */
1227  code = f ? ((ptr_definition)c)->code : (ptr_int_list)c;
1228 
1229  /* This rather time-consuming analysis is necessary if both objects */
1230  /* have non-NULL value fields. Note that only those objects with a */
1231  /* non-NULL value field needed for disentailment are looked at. */
1232  if (sub_CodeType(code,real->code)) {
1233  *value=value1;
1234  return (*(REAL *)value1 == *(REAL *)value2);
1235  }
1236  else if (sub_CodeType(code,quoted_string->code)) {
1237  *value=value1;
1238  return (!strcmp((char *)value1,(char *)value2));
1239  }
1240  else {
1241  /* All other sorts with 'value' fields always return TRUE, that is, */
1242  /* the value field plays no role in disentailment. */
1243  *value=value1;
1244  return TRUE;
1245  }
1246 }
long sub_CodeType()
#define NULL
Definition: def_const.h:203
#define REAL
Definition: def_const.h:72
ptr_definition real
Definition: def_glob.h:102
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_definition quoted_string
Definition: def_glob.h:101
struct wl_definition * ptr_definition
Definition: def_struct.h:31
ptr_int_list code
Definition: def_struct.h:129
struct wl_int_list * ptr_int_list
Definition: def_struct.h:29
void inherit_always_check ( )

Definition at line 994 of file types.c.

References FALSE, and one_pass_always_check().

995 {
996  long change;
997 
998  do {
999  change=FALSE;
1000  one_pass_always_check(&change);
1001  } while (change);
1002 }
void one_pass_always_check(long *ch)
Definition: types.c:976
#define FALSE
Definition: def_const.h:128
void insert_own_prop ( ptr_definition  d)

Definition at line 539 of file types.c.

References wl_pair_list::aaaa_2, wl_pair_list::bbbb_2, children, FALSE, HEAP_ALLOC, wl_int_list::next, wl_pair_list::next, NULL, TRUE, and wl_int_list::value_1.

541 {
542  ptr_int_list l;
543  ptr_pair_list rule;
544  ptr_triple_list *t;
545  long flag;
546 
547  l=HEAP_ALLOC(int_list);
548  l->value_1=(GENERIC)d;
549  l->next=children;
550  children=l;
551 
552  rule = d->rule;
553  while (rule) {
554  t= &(d->properties);
555  flag=TRUE;
556 
557  while (flag) {
558  if (*t)
559  if ((*t)->aaaa_4==rule->aaaa_2 && (*t)->bbbb_4==rule->bbbb_2 && (*t)->cccc_4==d)
560  flag=FALSE;
561  else
562  t= &((*t)->next);
563  else {
564  *t = HEAP_ALLOC(triple_list);
565  (*t)->aaaa_4=rule->aaaa_2;
566  (*t)->bbbb_4=rule->bbbb_2;
567  (*t)->cccc_4=d;
568  (*t)->next=NULL;
569  flag=FALSE;
570  }
571  }
572  rule=rule->next;
573  }
574 }
ptr_psi_term aaaa_2
Definition: def_struct.h:189
ptr_pair_list next
Definition: def_struct.h:191
#define NULL
Definition: def_const.h:203
ptr_definition next
Definition: def_struct.h:148
#define TRUE
Definition: def_const.h:127
ptr_pair_list rule
Definition: def_struct.h:126
#define FALSE
Definition: def_const.h:128
ptr_psi_term bbbb_2
Definition: def_struct.h:190
ptr_int_list children
Definition: def_glob.h:354
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_triple_list properties
Definition: def_struct.h:127
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_int_list next
Definition: def_struct.h:55
void insert_prop ( ptr_definition  d,
ptr_triple_list  prop 
)

Definition at line 580 of file types.c.

References wl_triple_list::aaaa_4, wl_triple_list::bbbb_4, wl_triple_list::cccc_4, children, FALSE, HEAP_ALLOC, wl_int_list::next, wl_definition::next, wl_triple_list::next, NULL, TRUE, and wl_int_list::value_1.

583 {
584  ptr_int_list l;
585  ptr_triple_list *t;
586  long flag;
587 
588  l=HEAP_ALLOC(int_list);
589  l->value_1=(GENERIC)d;
590  l->next=children;
591  children=l;
592 
593  while (prop) {
594  t= &(d->properties);
595  flag=TRUE;
596 
597  while (flag) {
598  if (*t)
599  if ((*t)->aaaa_4==prop->aaaa_4 && (*t)->bbbb_4==prop->bbbb_4 && (*t)->cccc_4==prop->cccc_4)
600  flag=FALSE;
601  else
602  t= &((*t)->next);
603  else {
604  *t = HEAP_ALLOC(triple_list);
605  (*t)->aaaa_4=prop->aaaa_4;
606  (*t)->bbbb_4=prop->bbbb_4;
607  (*t)->cccc_4=prop->cccc_4;
608  (*t)->next=NULL;
609  flag=FALSE;
610  }
611  }
612  prop=prop->next;
613  }
614 }
#define NULL
Definition: def_const.h:203
ptr_triple_list next
Definition: def_struct.h:199
ptr_definition cccc_4
Definition: def_struct.h:198
ptr_definition next
Definition: def_struct.h:148
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_psi_term bbbb_4
Definition: def_struct.h:197
ptr_int_list children
Definition: def_glob.h:354
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_triple_list properties
Definition: def_struct.h:127
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_psi_term aaaa_4
Definition: def_struct.h:196
ptr_int_list next
Definition: def_struct.h:55
void least_sorts ( )

Definition at line 700 of file types.c.

References wl_definition::children, cons(), first_definition, wl_definition::next, nothing, NULL, wl_definition::parents, wl_definition::type_def, and type_it.

702 {
703  ptr_definition d;
704 
705  for(d=first_definition;d;d=d->next)
706  if (d->type_def==(def_type)type_it && d->children==NULL && d!=nothing)
708 }
def_type type_def
Definition: def_struct.h:133
ptr_int_list cons(GENERIC v, ptr_int_list l)
Definition: types.c:164
#define NULL
Definition: def_const.h:203
#define type_it
Definition: def_const.h:363
ptr_definition next
Definition: def_struct.h:148
ptr_definition first_definition
Definition: def_glob.h:3
ptr_definition nothing
Definition: def_glob.h:98
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_int_list children
Definition: def_struct.h:131
ptr_int_list parents
Definition: def_struct.h:130
void make_type_link ( ptr_definition  t1,
ptr_definition  t2 
)

Definition at line 848 of file types.c.

References cons(), wl_definition::parents, top, and type_member().

850 {
851  if (t2!=top && !type_member(t2,t1->parents))
852  t1->parents=cons((GENERIC)t2,t1->parents);
853  if (t2!=top && !type_member(t1,t2->children))
854  t2->children=cons((GENERIC)t1,t2->children);
855 }
ptr_int_list cons(GENERIC v, ptr_int_list l)
Definition: types.c:164
ptr_definition top
Definition: def_glob.h:106
long type_member()
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_int_list children
Definition: def_struct.h:131
ptr_int_list parents
Definition: def_struct.h:130
long matches ( ptr_definition  t1,
ptr_definition  t2,
long *  smaller 
)

Definition at line 1565 of file types.c.

References wl_definition::code, FALSE, wl_int_list::next, NOT_CODED, top, TRUE, and wl_int_list::value_1.

1569 {
1570  ptr_int_list c1,c2;
1571  long result=TRUE;
1572 
1573  *smaller=TRUE;
1574 
1575  if (t1!=t2)
1576  if (t2!=top)
1577  if (t1==top)
1578  *smaller=FALSE;
1579  else {
1580  c1=t1->code;
1581  c2=t2->code;
1582  result=FALSE;
1583 
1584  if (c1!=NOT_CODED && c2!=NOT_CODED) {
1585  while (c1 && c2) {
1586  if ((unsigned long)c1->value_1 & (unsigned long)c2->value_1) result=TRUE;
1587  if ((unsigned long)c1->value_1 & ~(unsigned long)c2->value_1) *smaller=FALSE;
1588  c1=c1->next;
1589  c2=c2->next;
1590  }
1591  }
1592  else
1593  *smaller=FALSE;
1594  }
1595 
1596  return result;
1597 }
#define NOT_CODED
Definition: def_const.h:134
ptr_definition top
Definition: def_glob.h:106
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
void one_pass_always_check ( long *  ch)

Definition at line 976 of file types.c.

References wl_definition::always_check, first_definition, wl_definition::next, propagate_always_check(), wl_definition::type_def, and type_it.

978 {
979  ptr_definition d;
980 
981 
982  for(d=first_definition;d;d=d->next)
983  if (d->type_def==(def_type)type_it && !d->always_check)
985 }
def_type type_def
Definition: def_struct.h:133
char always_check
Definition: def_struct.h:134
#define type_it
Definition: def_const.h:363
ptr_definition next
Definition: def_struct.h:148
void propagate_always_check(ptr_definition d, long *ch)
Definition: types.c:950
ptr_definition first_definition
Definition: def_glob.h:3
void or_codes ( ptr_int_list  u,
ptr_int_list  v 
)

Definition at line 780 of file types.c.

References HEAP_ALLOC, NULL, and wl_int_list::value_1.

782 {
783  while (v) {
784  u->value_1= (GENERIC)(((unsigned long)(u->value_1)) | ((unsigned long)(v->value_1)));
785  v=v->next;
786  if (u->next==NULL && v) {
788  u=u->next;
789  u->value_1=0;
790  u->next=NULL;
791  }
792  else
793  u=u->next;
794  }
795 }
#define NULL
Definition: def_const.h:203
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_int_list next
Definition: def_struct.h:55
long overlap_type ( ptr_definition  t1,
ptr_definition  t2 
)

Definition at line 1486 of file types.c.

References wl_definition::code, FALSE, wl_int_list::next, NOT_CODED, top, TRUE, and wl_int_list::value_1.

1489 {
1490  ptr_int_list c1,c2;
1491  long result=TRUE;
1492 
1493  if (t1!=t2 && t1!=top && t2!=top) {
1494 
1495  c1=t1->code;
1496  c2=t2->code;
1497  result=FALSE;
1498 
1499  if (c1!=NOT_CODED && c2!=NOT_CODED) {
1500  while (!result && c1 && c2) {
1501  result=(((unsigned long)(c1->value_1)) & ((unsigned long)(c2->value_1)));
1502  c1=c1->next;
1503  c2=c2->next;
1504  }
1505  }
1506  }
1507 
1508  /*
1509  printf("overlap_type(%s,%s) => %ld\n",t1->def->keyword->symbol,t2->def->keyword->symbol,result);
1510  */
1511 
1512  return result;
1513 }
#define NOT_CODED
Definition: def_const.h:134
ptr_definition top
Definition: def_glob.h:106
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
void perr_sort ( ptr_definition  d)

Definition at line 876 of file types.c.

References perr_s().

878 {
879  perr_s("%s",d->keyword->symbol);
880 }
ptr_keyword keyword
Definition: def_struct.h:124
void perr_s(char *s1, char *s2)
Definition: error.c:665
char * symbol
Definition: def_struct.h:91
void perr_sort_cycle ( ptr_int_list  anc)

Definition at line 892 of file types.c.

References perr(), perr_sort(), and perr_sort_list().

894 {
896  perr(" <| ");
897  perr_sort_list(anc);
898 }
void perr(char *str)
Definition: error.c:659
void perr_sort_list(ptr_int_list anc)
Definition: types.c:882
void perr_sort(ptr_definition d)
Definition: types.c:876
GENERIC value_1
Definition: def_struct.h:54
void perr_sort_list ( ptr_int_list  anc)

Definition at line 882 of file types.c.

References perr(), and perr_sort().

884 {
885  if (anc) {
886  perr_sort_list(anc->next);
887  if (anc->next) perr(" <| ");
889  }
890 }
void perr(char *str)
Definition: error.c:659
void perr_sort_list(ptr_int_list anc)
Definition: types.c:882
void perr_sort(ptr_definition d)
Definition: types.c:876
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
void print_codes ( )

Definition at line 1178 of file types.c.

References outputline(), and type_count.

1179 {
1180  long i;
1181 
1182  for (i=0; i<type_count; i++) {
1183  outputline("%C = %s\n",
1184  gamma_table[i]->code,
1185  gamma_table[i]->keyword->combined_name);
1186  }
1187 }
ptr_definition * gamma_table
Definition: types.c:16
long type_count
Definition: def_glob.h:46
void outputline(char *format,...)
Definition: error.c:79
void print_def_type ( def_type  t)

Definition at line 21 of file types.c.

References function_it, global, perr(), predicate, and type_it.

23 {
24  switch ((long)t) {
25  case (long)predicate:
26  perr("predicate");
27  break;
28  case (long)function_it:
29  perr("function");
30  break;
31  case (long)type_it:
32  perr("sort");
33  break;
34  case (long)global: /* RM: Feb 8 1993 */
35  perr("global variable");
36  break;
37  default:
38  perr("undefined");
39  }
40 }
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
void perr(char *str)
Definition: error.c:659
#define global
Definition: def_const.h:364
#define type_it
Definition: def_const.h:363
void propagate_always_check ( ptr_definition  d,
long *  ch 
)

Definition at line 950 of file types.c.

References wl_definition::always_check, FALSE, wl_int_list::next, TRUE, and wl_int_list::value_1.

953 {
954  ptr_int_list child_list;
955  ptr_definition child;
956 
957  child_list = d->children;
958  while (child_list) {
959  child = (ptr_definition)child_list->value_1;
960  if (child->always_check) {
961  child->always_check = FALSE;
962  *ch = TRUE;
963  propagate_always_check(child,ch);
964  }
965  child_list = child_list->next;
966  }
967 }
char always_check
Definition: def_struct.h:134
#define TRUE
Definition: def_const.h:127
void propagate_always_check(ptr_definition d, long *ch)
Definition: types.c:950
#define FALSE
Definition: def_const.h:128
struct wl_definition * ptr_definition
Definition: def_struct.h:31
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list children
Definition: def_struct.h:131
ptr_int_list next
Definition: def_struct.h:55
void propagate_definitions ( )

Definition at line 622 of file types.c.

References adults, wl_definition::children, children, find_adults(), insert_own_prop(), insert_prop(), wl_int_list::next, NULL, wl_definition::properties, and wl_int_list::value_1.

623 {
624  ptr_int_list kids;
625  ptr_definition d;
626 
627  adults=NULL;
628  find_adults();
629 
630  while (adults) {
631 
632  children=NULL;
633 
634  while (adults) {
636 
637  insert_own_prop(d);
639 
640  kids=d->children;
641 
642  while(kids) {
644  /* if (d->always_check && kids->value_1)
645  ((ptr_definition)kids->value_1)->always_check=TRUE; */
646  kids=kids->next;
647  }
648  adults=adults->next;
649  }
651  }
652 }
void find_adults()
Definition: types.c:516
#define NULL
Definition: def_const.h:203
void insert_prop(ptr_definition d, ptr_triple_list prop)
Definition: types.c:580
struct wl_definition * ptr_definition
Definition: def_struct.h:31
void insert_own_prop(ptr_definition d)
Definition: types.c:539
ptr_int_list children
Definition: def_glob.h:354
ptr_int_list adults
Definition: def_glob.h:354
GENERIC value_1
Definition: def_struct.h:54
ptr_triple_list properties
Definition: def_struct.h:127
ptr_int_list children
Definition: def_struct.h:131
ptr_int_list next
Definition: def_struct.h:55
long redefine ( ptr_psi_term  t)

Definition at line 91 of file types.c.

References wl_definition::children, wl_keyword::combined_name, wl_definition::date, deref_ptr, Errorline(), FALSE, file_date, wl_definition::keyword, MAX_BUILT_INS, wl_definition::parents, wl_definition::protected, remove_cycles(), wl_definition::rule, wl_keyword::symbol, TRUE, wl_definition::type_def, type_it, undef, warningflag, warningline(), and yes_or_no().

93 {
94  ptr_definition d; // ,d2;
95  // ptr_int_list l,*l2;
96  long success=TRUE;
97 
98  deref_ptr(t);
99  d=t->type;
100  if (d->date<file_date) {
101  if (d->type_def==(def_type)type_it) {
102  /* Except for top, sorts are always unprotected, with a warning. */
103  if (FALSE /*d==top*/) {
104  Errorline("the top sort '@' may not be extended.\n");
105  success=FALSE;
106  }
107  /* RM: Mar 25 1993
108  else if (d!=top)
109  warningline("extending definition of sort '%s'.\n",d->keyword->symbol);
110  */
111  }
112  else if (d->protected && d->type_def!=(def_type)undef) {
113  if (d->date>0) {
114  /* The term was entered in a previous file, and therefore */
115  /* cannot be altered. */
116  Errorline("the %T '%s' may not be changed.\n", /* RM: Jan 27 1993 */
117  d->type_def, d->keyword->combined_name);
118  success=FALSE;
119  }
120  else {
121  if (d->rule && (unsigned long)d->rule<=MAX_BUILT_INS /*&& input_stream==stdin*/) {
122  /* d is a built-in, and therefore cannot be altered. */
123  Errorline("the built-in %T '%s' may not be extended.\n",
124  d->type_def, d->keyword->symbol);
125  success=FALSE;
126  }
127  else {
128  /* d is not a built-in, and therefore can be altered. */
129  warningline("extending the %T '%s'.\n",d->type_def,d->keyword->symbol);
130  if (warningflag) if (!yes_or_no()) success=FALSE;
131  }
132  }
133  }
134 
135  if (success) {
136  if (d->type_def==(def_type)type_it) { /* d is an already existing type */
137  /* Remove cycles in the type hierarchy of d */
138  /* This is done by Richard's version, and I don't know why. */
139  /* It seems to be a no-op. */
140  remove_cycles(d, &(d->children));
141  remove_cycles(d, &(d->parents));
142  /* d->rule=NULL; */ /* Types must keep their rules! */
143  /* d->properties=NULL; */ /* Types get new properties from encode */
144  }
145  if (d->date==0) d->date=file_date;
146  /* d->type=undef; */ /* Objects keep their type! */
147  /* d->always_check=TRUE; */
148  /* d->protected=TRUE; */
149  /* d->children=NULL; */
150  /* d->parents=NULL; */
151  /* d->code=NOT_CODED; */
152  }
153  }
154 
155  return success;
156 }
char * combined_name
Definition: def_struct.h:92
#define undef
Definition: def_const.h:360
def_type type_def
Definition: def_struct.h:133
long file_date
Definition: def_glob.h:60
ptr_keyword keyword
Definition: def_struct.h:124
void remove_cycles(ptr_definition d, ptr_int_list *dl)
Definition: types.c:73
long warningflag
Definition: def_glob.h:270
char * symbol
Definition: def_struct.h:91
#define type_it
Definition: def_const.h:363
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_pair_list rule
Definition: def_struct.h:126
#define FALSE
Definition: def_const.h:128
#define MAX_BUILT_INS
Definition: def_const.h:82
void warningline(char *format,...)
Definition: error.c:327
ptr_definition type
Definition: def_struct.h:165
ptr_int_list children
Definition: def_struct.h:131
long yes_or_no()
Definition: types.c:44
ptr_int_list parents
Definition: def_struct.h:130
void remove_cycles ( ptr_definition  d,
ptr_int_list dl 
)

Definition at line 73 of file types.c.

References wl_int_list::next.

76 {
77  while (*dl) {
78  if (((ptr_definition)(*dl)->value_1)==d)
79  *dl = (*dl)->next;
80  else
81  dl= &((*dl)->next);
82  }
83 }
ptr_int_list next
Definition: def_struct.h:55
long strict_matches ( ptr_psi_term  t1,
ptr_psi_term  t2,
long *  smaller 
)

Definition at line 1608 of file types.c.

References FALSE, matches(), NULL, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

1612 {
1613  long result,sm;
1614 
1615  result=matches(t1->type,t2->type,&sm);
1616 
1617  if (sm) {
1618  /* At this point, t1->type <| t2->type */
1619  if (t1->type==t2->type) {
1620  /* Same types: strict only if first has a value & second does not */
1621  if (t1->value_3!=NULL && t2->value_3==NULL)
1622  sm=TRUE;
1623  else
1624  sm=FALSE;
1625  }
1626  else {
1627  /* Different types: the first must be strictly smaller */
1628  sm=TRUE;
1629  }
1630  }
1631 
1632  *smaller=sm;
1633  return result;
1634 }
#define NULL
Definition: def_const.h:203
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
ptr_definition type
Definition: def_struct.h:165
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
long sub_CodeType ( )
long sub_CodeType ( ptr_int_list  c1,
ptr_int_list  c2 
)

Definition at line 1522 of file types.c.

References FALSE, wl_int_list::next, NOT_CODED, TRUE, and wl_int_list::value_1.

1525 {
1526  if (c1!=NOT_CODED && c2!=NOT_CODED) {
1527  while (c1 && c2) {
1528  if ((unsigned long)c1->value_1 & ~(unsigned long)c2->value_1) return FALSE;
1529  c1=c1->next;
1530  c2=c2->next;
1531  }
1532  }
1533  else
1534  return FALSE;
1535 
1536  return TRUE;
1537 }
#define NOT_CODED
Definition: def_const.h:134
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
long sub_type ( ptr_definition  t1,
ptr_definition  t2 
)

Definition at line 1544 of file types.c.

References wl_definition::code, FALSE, sub_CodeType(), top, and TRUE.

1547 {
1548  if (t1!=t2)
1549  if (t2!=top)
1550  {
1551  if (t1==top)
1552  return FALSE;
1553  else
1554  return sub_CodeType(t1->code, t2->code);
1555  }
1556  return TRUE;
1557 }
long sub_CodeType()
ptr_definition top
Definition: def_glob.h:106
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_int_list code
Definition: def_struct.h:129
ptr_int_list two_to_the ( long  p)

Definition at line 731 of file types.c.

References HEAP_ALLOC, INT_SIZE, wl_int_list::next, NULL, and wl_int_list::value_1.

733 {
734  ptr_int_list result,code;
735  long v=1;
736 
737  code=HEAP_ALLOC(int_list);
738  code->value_1=0;
739  code->next=NULL;
740  result=code;
741 
742  while (p>=INT_SIZE) {
743  code->next=HEAP_ALLOC(int_list);
744  code=code->next;
745  code->value_1=0;
746  code->next=NULL;
747  p=p-INT_SIZE;
748  }
749 
750  v= v<<p ;
751  code->value_1=(GENERIC)v;
752 
753  return result;
754 }
#define INT_SIZE
Definition: def_const.h:144
#define NULL
Definition: def_const.h:203
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_int_list next
Definition: def_struct.h:55
long type_cyclicity ( ptr_definition  d,
ptr_int_list  anc 
)

Definition at line 907 of file types.c.

References wl_definition::code, Errorline(), exit_life(), FALSE, wl_int_list::next, NOT_CODED, perr(), perr_sort_cycle(), TRUE, type_member(), and wl_int_list::value_1.

910 {
911  ptr_int_list p=d->parents;
912  ptr_definition pd;
913  long errflag;
914  int_list anc2;
915 
916  while (p) {
917  pd=(ptr_definition)p->value_1;
918  /* If unmarked, mark and recurse */
919  if (pd->code==NOT_CODED) {
920  pd->code = (ptr_int_list)TRUE;
921  anc2.value_1=(GENERIC)pd;
922  anc2.next=anc;
923  errflag=type_cyclicity(pd,&anc2);
924  if (errflag) return TRUE;
925  }
926  /* If marked, check if it's in the ancestor list */
927  else {
928  if (type_member(pd,anc)) {
929  Errorline("there is a cycle in the sort hierarchy\n");
930  perr("*** Cycle: [");
931  perr_sort_cycle(anc);
932  perr("]\n");
933  exit_life(TRUE);
934  return TRUE;
935  }
936  }
937  p=p->next;
938  }
939  return FALSE;
940 }
long type_cyclicity(ptr_definition d, ptr_int_list anc)
Definition: types.c:907
void perr(char *str)
Definition: error.c:659
void exit_life(long nl_flag)
Definition: built_ins.c:2090
#define NOT_CODED
Definition: def_const.h:134
void perr_sort_cycle(ptr_int_list anc)
Definition: types.c:892
void Errorline(char *format,...)
Definition: error.c:414
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
struct wl_definition * ptr_definition
Definition: def_struct.h:31
long type_member()
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
struct wl_int_list * ptr_int_list
Definition: def_struct.h:29
ptr_int_list next
Definition: def_struct.h:55
ptr_int_list parents
Definition: def_struct.h:130
long type_member ( )
long type_member ( ptr_definition  t,
ptr_int_list  tlst 
)

Definition at line 864 of file types.c.

References FALSE, wl_int_list::next, TRUE, and wl_int_list::value_1.

867 {
868  while (tlst) {
869  if (t==(ptr_definition)tlst->value_1) return TRUE;
870  tlst=tlst->next;
871  }
872  return FALSE;
873 }
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
long yes_or_no ( )

Definition at line 44 of file types.c.

References EOLN, input_state, open_input_file(), perr(), prompt, read_char(), and restore_state().

45 {
46  char *old_prompt;
47  long c,d;
48  ptr_psi_term old_state_loc;
49 
50  perr("*** Are you really sure you want to do that ");
51  old_prompt=prompt;
52  prompt="(y/n)?";
53  old_state_loc=input_state;
54  (void)open_input_file("stdin");
55 
56  do {
57  do {
58  c=read_char();
59  } while (c!=EOLN && c>0 && c<=32);
60  } while (c!='y' && c!='n');
61 
62  d=c;
63  while (d!=EOLN && d!=EOF) d=read_char();
64 
65  prompt=old_prompt;
66  input_state=old_state_loc;
67  restore_state(old_state_loc);
68  return (c=='y');
69 }
void perr(char *str)
Definition: error.c:659
ptr_psi_term input_state
Definition: def_glob.h:199
#define EOLN
Definition: def_const.h:140
void restore_state(ptr_psi_term t)
Definition: token.c:267
char * prompt
Definition: def_glob.h:42
long read_char()
Definition: token.c:587
long open_input_file(char *file)
Definition: token.c:504

Variable Documentation

ptr_definition* gamma_table = NULL

Definition at line 16 of file types.c.