Wild Life: login.c Source File

Wild Life 2.30

- Main Page
- Data Structures
- Files

- File List
- Globals

All Data Structures Files Functions Variables Typedefs Macros
login.c
Go to the documentation of this file.
1
10 /* Copyright 1991 Digital Equipment Corporation.
11 ** All Rights Reserved.
12 *****************************************************************/
13 /* $Id: login.c,v 1.4 1995/01/14 00:25:33 duchier Exp $ */
14
15 #include "defs.h"
16
17 /* Clean trail toggle */
18 /* Removed temporarily because of comb bug 1.6 */
19 #define CLEAN_TRAIL
20
21 /* Statistics on trail cleaning */
22 long clean_iter = 0;
23 long clean_succ = 0;
24
25 #ifdef TS
26 /* Should never wrap (32 bit is enough) 9.6 */
27 /* Rate of incrementing: One per choice point */
28 unsigned long global_time_stamp=INIT_TIME_STAMP; /* 9.6 */
29 #endif
30
31
32
33
34
47 void get_two_args(ptr_node t,ptr_psi_term *a,ptr_psi_term *b)
48 {
49 ptr_node n;
50
51 *a=NULL;
52 *b=NULL;
53 if (t) {
54 if (t->key==one) {
55 *a=(ptr_psi_term )t->data;
56 n=t->right;
57 if (n)
58 if (n->key==two)
59 *b=(ptr_psi_term )n->data;
60 else {
61 n=find(FEATCMP,two,t);
62 if(n==NULL)
63 *b=NULL;
64 else
65 *b=(ptr_psi_term )n->data;
66 }
67 else
68 *b=NULL;
69 }
70 else {
71 n=find(FEATCMP,one,t);
72 if (n==NULL)
73 *a=NULL;
74 else
75 *a=(ptr_psi_term )n->data;
76 n=find(FEATCMP,two,t);
77 if (n==NULL)
78 *b=NULL;
79 else
80 *b=(ptr_psi_term )n->data;
81 }
82 }
83 }
84
85
86
87
99 void get_one_arg(ptr_node t,ptr_psi_term *a)
100 {
101 ptr_node n;
102
103 *a=NULL;
104 if (t) {
105 if (t->key==one) {
106 *a=(ptr_psi_term)t->data;
107 }
108 else {
109 n=find(FEATCMP,one,t);
110 if (n==NULL)
111 *a=NULL;
112 else
113 *a=(ptr_psi_term)n->data;
114 }
115 }
116 }
117
118
119
120
132 void get_one_arg_addr(ptr_node t,ptr_psi_term **a)
133 {
134 ptr_node n;
135 // ptr_psi_term *b;
136
137 *a=NULL;
138 if (t) {
139 if (t->key==one)
140 *a= (ptr_psi_term *)(&t->data);
141 else {
142 n=find(FEATCMP,one,t);
143 if (n==NULL)
144 *a=NULL;
145 else
146 *a= (ptr_psi_term *)(&n->data);
147 }
148 }
149 }
150
167 void add_rule(ptr_psi_term head,ptr_psi_term body,def_type typ)
168 {
169 psi_term succ;
170 ptr_psi_term head2;
171 ptr_definition def;
172 ptr_pair_list p, *p2;
173
174 if (!body && typ==(def_type)predicate_it) {
175 succ.type=succeed;
176 succ.value_3=NULL;
177 succ.coref=NULL;
178 succ.resid=NULL;
179 succ.attr_list=NULL;
180 body= &succ;
181 }
182
183 deref_ptr(head);
184 head2=head;
185
186 /* assert(head->resid==NULL); 10.8 */
187 /* assert(body->resid==NULL); 10.8 */
188
189 if (redefine(head)) {
190
191 def=head->type;
192
193 if (def->type_def==(def_type)undef_it || def->type_def==typ)
194
195 /* RM: Jan 27 1993 */
196 if(TRUE
197 /* def->type==undef_it ||
198 def->keyword->module==current_module */
199 /* RM: Feb 2 1993 Commented out */
200 ) {
201 if (def->rule && (unsigned long)def->rule<=MAX_BUILT_INS) {
202 Errorline("the built-in %T '%s' may not be redefined.\n",
203 def->type_def, def->keyword->symbol);
204 }
205 else {
206 def->type_def=typ;
207
208 /* PVR single allocation in source */
209 p=HEAP_ALLOC(pair_list);
210 clear_copy();
211 /* p->aaaa_3=exact_copy(head2,HEAP); 24.8 25.8 */
212 /* p->bbbb_3=exact_copy(body,HEAP); 24.8 25.8 */
213
214 p->aaaa_2=quote_copy(head2,HEAP); /* 24.8 25.8 */
215 p->bbbb_2=quote_copy(body,HEAP); /* 24.8 25.8 */
216
217 if (assert_first) {
218 p->next=def->rule;
219 def->rule=p;
220 }
221 else {
222 p->next=NULL;
223 p2= &(def->rule);
224 while (*p2) {
225 p2= &((*p2)->next);
226 }
227 *p2=p;
228 }
229 assert_ok=TRUE;
230 }
231 }
232 else { /* RM: Jan 27 1993 */
233 Errorline("the %T '%s' may not be redefined from within module %s.\n",
234 def->type_def,
235 def->keyword->combined_name,
236 current_module->module_name);
237 }
238 else {
239 Errorline("the %T '%s' may not be redefined as a %T.\n",
240 def->type_def, def->keyword->symbol, typ);
241 }
242 }
243 }
244
257 void assert_rule(psi_term t,def_type typ)
258 {
259 ptr_psi_term head;
260 ptr_psi_term body;
261
262 get_two_args(t.attr_list,&head,&body);
263 if (head)
264 if (body)
265 add_rule(head,body,typ);
266 else {
267 Syntaxerrorline("body missing in definition of %T '%P'.\n", typ, head);
268 }
269 else {
270 Syntaxerrorline("head missing in definition of %T.\n",typ);
271 }
272 }
273
287 void assert_clause(ptr_psi_term t)
288 {
289 assert_ok=FALSE;
290 deref_ptr(t);
291
292 /* RM: Feb 22 1993 defined c_alias in modules.c
293 if (equ_tok((*t),"alias")) {
294 get_two_args(t->attr_list,&arg1,&arg2);
295 if (arg1 && arg2) {
296 warningline("'%s' has taken the meaning of '%s'.\n",
297 arg2->type->keyword->symbol, arg1->type->keyword->symbol);
298 str=arg2->type->keyword->symbol;
299 assert_ok=TRUE;
300 deref_ptr(arg1);
301 deref_ptr(arg2);
302 *(arg2->type)= *(arg1->type);
303 arg2->type->keyword->symbol=str;
304 }
305 else
306 Errorline("arguments missing in %P.\n",t);
307 }
308 else
309 */
310
311 if (equ_tok((*t),":-"))
312 assert_rule((*t),(def_type)predicate_it);
313 else
314 if (equ_tok((*t),"->"))
315 assert_rule((*t),(def_type)function_it);
316 else
317 if (equ_tok((*t),"::"))
318 assert_attributes(t);
319 else
320
321 #ifdef CLIFE
322 if (equ_tok((*t),"block_struct"))
323 define_block(t);
324 else
325 #endif /* CLIFE */
326 /* if (equ_tok((*t),"<<<-")) { RM: Feb 10 1993
327 declare T as global. To do... maybe.
328 }
329 else
330 */
331
332 if (equ_tok((*t),"<|") || equ_tok((*t),":="))
333 assert_complicated_type(t);
334 else
335 add_rule(t,NULL,(def_type)predicate_it);
336
337 /* if (!assert_ok && warning()) perr("the declaration is ignored.\n"); */
338 }
339
340
341
349 void start_chrono()
350 {
351 (void)times(&start_time);
352 }
353
354 /******************************************************************************
355
356 PROOF and UNIFICATION routines.
357
358 These two different functions are written without using explicit recursion
359 so that backtracking can easily take place between the two. PROVE can call
360 UNIFY and vice-versa.
361
362 The argument to PROVE is the adress of a PSI_TERM (psi-term) which represents
363 a goal to prove.
364
365 Prove then passes that on the goal stack to MAIN_PROVE() which does
366 the real work, involving calls to UNIFY_AIM, PROVE_AIM and backtracking.
367
368 ****************************************************************************/
369
370
371
383 void push_ptr_value(type_ptr t,GENERIC *p)
384 {
385 ptr_stack n;
386
387 assert(p<(GENERIC *)heap_pointer); /* RM: Feb 15 1993 */
388
389 assert(VALID_ADDRESS(p));
390 if (p < (GENERIC *)choice_stack || p > (GENERIC *)stack_pointer)
391 {
392 n=STACK_ALLOC(stack);
393 n->type=t;
394 n->aaaa_3= (GENERIC *) p;
395 n->bbbb_3= (GENERIC *) *p;
396 n->next=undo_stack;
397 undo_stack=n;
398 }
399 }
400
401
416 void push_def_ptr_value(ptr_psi_term q,GENERIC *p)
417 {
418 ptr_stack m,n;
419
420 assert(VALID_ADDRESS(q));
421 assert(VALID_ADDRESS(p));
422 #ifdef TS
423 if (trail_condition(q) &&
424 /* (q->time_stamp != global_time_stamp) && */
425 (p < (GENERIC *)choice_stack || p > (GENERIC *)stack_pointer))
426 {
427 #define TRAIL_TS
428 #ifdef TRAIL_TS
429
430 assert((GENERIC)q<heap_pointer); /* RM: Feb 15 1993 */
431
432 m=STACK_ALLOC(stack); /* Trail time_stamp */
433 m->type=int_ptr;
434 m->aaaa_3= (GENERIC *) &(q->time_stamp);
435 m->bbbb_3= (GENERIC *) (q->time_stamp);
436 m->next=undo_stack;
437 n=STACK_ALLOC(stack); /* Trail definition field (top of undo_stack) */
438 n->type=def_ptr;
439 n->aaaa_3= p;
440 n->bbbb_3= (GENERIC *)*p;
441 n->next=m;
442 undo_stack=n;
443 #else
444 n=STACK_ALLOC(stack); /* Trail definition field (top of undo_stack) */
445 n->type=def_ptr;
446 n->aaaa_3= p;
447 n->bbbb_3= (GENERIC *) *p;
448 n->next=undo_stack;
449 undo_stack=n;
450 #endif
451 q->time_stamp=global_time_stamp;
452 }
453 #else
454 push_ptr_value(def_ptr,p);
455 #endif
456 }
457
458
459
474 void push_psi_ptr_value(ptr_psi_term q,GENERIC *p)
475 {
476 ptr_stack m,n;
477
478 assert(VALID_ADDRESS(q));
479 assert(VALID_ADDRESS(p));
480 #ifdef TS
481 if (trail_condition(q) &&
482 /* (q->time_stamp != global_time_stamp) && */
483 (p < (GENERIC *)choice_stack || p > (GENERIC *)stack_pointer))
484 {
485 #define TRAIL_TS
486 #ifdef TRAIL_TS
487 m=STACK_ALLOC(stack); /* Trail time_stamp */
488 m->type=int_ptr;
489 m->aaaa_3= (GENERIC *) &(q->time_stamp);
490 m->bbbb_3= (GENERIC *) (q->time_stamp);
491 m->next=undo_stack;
492 n=STACK_ALLOC(stack); /* Trail coref field (top of undo_stack) */
493 n->type=psi_term_ptr;
494 n->aaaa_3= (GENERIC *) p;
495 n->bbbb_3= (GENERIC *) *p;
496 n->next=m;
497 undo_stack=n;
498 #else
499 n=STACK_ALLOC(stack); /* Trail coref field (top of undo_stack) */
500 n->type=psi_term_ptr;
501 n->aaaa_3= (ptr_psi_term)p;
502 n->bbbb_3= *p;
503 n->next=undo_stack;
504 undo_stack=n;
505 #endif
506 q->time_stamp=global_time_stamp;
507 }
508 #else
509 push_ptr_value(psi_term_ptr,(ptr_psi_term *)p);
510 #endif
511 }
512
523 void push_ptr_value_global(type_ptr t,GENERIC *p)
524 {
525 ptr_stack n;
526
527 assert(VALID_ADDRESS(p)); /* 17.8 */
528 n=STACK_ALLOC(stack);
529 n->type=t;
530 n->aaaa_3= (GENERIC *) p;
531 n->bbbb_3= (GENERIC *) *p;
532 n->next=undo_stack;
533 undo_stack=n;
534 }
535
548 void push_window(long type,long disp,long wind)
549 {
550 ptr_stack n;
551
552 assert(type & undo_action);
553 n=STACK_ALLOC(stack);
554 n->type=type;
555 n->aaaa_3=(GENERIC *)disp;
556 n->bbbb_3=(GENERIC *)wind;
557 n->next=undo_stack;
558 undo_stack=n;
559 }
560
573 void push2_ptr_value(type_ptr t,GENERIC *p,GENERIC v)
574 {
575 ptr_stack n;
576
577 if (p<(GENERIC *)choice_stack || p>(GENERIC *)stack_pointer) {
578 n=STACK_ALLOC(stack);
579 n->type=t;
580 n->aaaa_3= (GENERIC *)p;
581 n->bbbb_3= (GENERIC *)v;
582 n->next=undo_stack;
583 undo_stack=n;
584 }
585 }
586
600 void push_goal(goals t,ptr_psi_term aaaa_5,ptr_psi_term bbbb_5,GENERIC cccc_5)
601 {
602 ptr_goal thegoal;
603
604 thegoal=STACK_ALLOC(goal);
605
606 thegoal->type=t;
607 thegoal->aaaa_1=aaaa_5;
608 thegoal->bbbb_1=bbbb_5;
609 thegoal->cccc_1=cccc_5;
610 thegoal->next=goal_stack;
611 thegoal->pending=FALSE;
612
613 goal_stack=thegoal;
614 }
615
638 void push_choice_point(goals t,ptr_psi_term aaaa_6,ptr_psi_term bbbb_6,GENERIC cccc_6)
639 {
640 ptr_goal alternative;
641 ptr_choice_point choice;
642 GENERIC top_loc;
643
644 alternative=STACK_ALLOC(goal);
645
646 alternative->type=t;
647 alternative->aaaa_1=aaaa_6;
648 alternative->bbbb_1=bbbb_6;
649 alternative->cccc_1=cccc_6;
650 alternative->next=goal_stack;
651 alternative->pending=FALSE;
652
653 top_loc=stack_pointer;
654
655 choice=STACK_ALLOC(choice_point);
656
657 choice->undo_point=undo_stack;
658 choice->goal_stack=alternative;
659 choice->next=choice_stack;
660 choice->stack_top=top_loc;
661
662 #ifdef TS
663 choice->time_stamp=global_time_stamp; /* 9.6 */
664 global_time_stamp++; /* 9.6 */
665 #endif
666
667 choice_stack=choice;
668 }
669
670 #define RESTORE_TIME_STAMP global_time_stamp=\
671 choice_stack?choice_stack->time_stamp:INIT_TIME_STAMP;
672
691 void undo(ptr_stack limit)
692 {
693 /*
694 while((unsigned long)undo_stack>(unsigned long)goal_stack)
695 */
696
697 while ((unsigned long)undo_stack>(unsigned long)limit) {
698 #ifdef X11
699 if (undo_stack->type & undo_action) {
700 /* Window operation on backtracking */
701 switch(undo_stack->type) { /*** RM 8/12/92 ***/
702 case destroy_window:
703 x_destroy_window((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
704 break;
705 case show_window:
706 x_show_window((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
707 break;
708 case hide_window:
709 x_hide_window((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
710 break;
711 case show_subwindow:
712 x_show_subwindow((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
713 break;
714 case hide_subwindow:
715 x_hide_subwindow((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
716 break;
717 }
718 }
719 else
720 #endif
721 /* Restoring variable value on backtracking */
722 *((GENERIC *)(undo_stack->aaaa_3))=(GENERIC)undo_stack->bbbb_3;
723 undo_stack=undo_stack->next;
724 }
725 }
726
736 void undo_actions()
737 {
738 // ptr_stack u=undo_stack;
739
740 Errorline("undo_actions should not be called.\n");
741 undo(NULL); /* 8.10 */
742 return;
743 /*
744 #ifdef X11
745 while ((unsigned long)u) {
746 if (u->type & undo_action) {
747 if (u->type==destroy_window) {
748 x_destroy_window((unsigned long)u->aaaa_3,(unsigned long)u->bbbb_3);
749 }
750 else if (u->type==show_window) {
751 x_show_window((unsigned long)u->aaaa_3,(unsigned long)u->bbbb_3);
752 }
753 else if (u->type==hide_window) {
754 x_hide_window((unsigned long)u->aaaa_3,(unsigned long)u->bbbb_3);
755 }
756 }
757 u=u->next;
758 }
759 #endif
760 */
761 }
762
772 void backtrack()
773 {
774 // long gts;
775
776 goal_stack=choice_stack->goal_stack;
777 undo(choice_stack->undo_point);
778 #ifdef TS
779 /* global_time_stamp=choice_stack->time_stamp; */ /* 9.6 */
780 #endif
781 stack_pointer=choice_stack->stack_top;
782 choice_stack=choice_stack->next;
783 resid_aim=NULL;
784
785
786 /* assert((unsigned long)stack_pointer>=(unsigned long)cut_point); 13.6 */
787 /* This situation occurs frequently in some benchmarks (e.g comb) */
788 /* printf("*** Possible GC error: cut_point is dangling\n"); */
789 /* fflush(stdout); */
790
791 /* assert((unsigned long)stack_pointer>=(unsigned long)match_date); 13.6 */
792 }
793
794
795
810 static void clean_trail(ptr_choice_point cutpt)
811 {
812 ptr_stack *prev,u,cut_limit;
813 GENERIC cut_sp;
814
815 u = undo_stack;
816 prev = &undo_stack;
817 if (cutpt) {
818 cut_sp = cutpt->stack_top;
819 cut_limit = cutpt->undo_point;
820 }
821 else {
822 cut_sp = mem_base; /* Empty stack */
823 cut_limit = NULL; /* Empty undo_stack */
824 }
825
826 while ((unsigned long)u > (unsigned long)cut_limit) {
827 clean_iter++;
828 if (!(u->type & undo_action) && VALID_RANGE(u->aaaa_3) &&
829 (unsigned long)u->aaaa_3>(unsigned long)cut_sp && (unsigned long)u->aaaa_3<=(unsigned long)stack_pointer) {
830 *prev = u->next;
831 clean_succ++;
832 }
833 prev = &(u->next);
834 u = u->next;
835 }
836 }
837
848 void clean_undo_window(long disp,long wind)
849 {
850 ptr_stack *prev,u;
851 ptr_choice_point c;
852
853 #ifdef X11
854 /* Remove entries on the trail */
855 u = undo_stack;
856 prev = &undo_stack;
857 while (u) {
858 if ((u->type & undo_action) &&
859 ((unsigned long)u->aaaa_3==disp) && ((unsigned long)u->bbbb_3==wind)) {
860 *prev = u->next;
861 }
862 prev = &(u->next);
863 u = u->next;
864 }
865
866 /* Remove entries at the *tops* of trail entry points from the */
867 /* choice point stack. It's only necessary to look at the tops, */
868 /* since those are the only ones that haven't been touched by */
869 /* the previous while loop. */
870 c = choice_stack;
871 while (c) {
872 u = c->undo_point;
873 prev = &(c->undo_point);
874 while (u && (u->type & undo_action) &&
875 ((unsigned long)u->aaaa_3==disp) && ((unsigned long)u->bbbb_3==wind)) {
876 *prev = u->next;
877 prev = &(u->next);
878 u = u->next;
879 }
880 c = c->next;
881 }
882 #endif
883 }
884
893 void merge1(ptr_node *u,ptr_node v)
894 {
895 long cmp;
896 ptr_node temp;
897
898 if (v) {
899 if (*u==NULL) {
900 /* push_ptr_value(int_ptr,u); */
901 /* (*u)=STACK_ALLOC(node); */
902 /* **u= *v; */
903 /* more_v_attr=TRUE; */
904 }
905 else {
906 cmp=featcmp((*u)->key,v->key);
907 if (cmp==0) {
908 if (v->right)
909 merge1(&((*u)->right),v->right);
910
911 push_goal(unify,(ptr_psi_term)(*u)->data,(ptr_psi_term)v->data,NULL);
912
913 if (v->left)
914 merge1(&((*u)->left),v->left);
915 }
916 else if (cmp>0) {
917 temp=v->right;
918 v->right=NULL;
919 merge1(&((*u)->left),v);
920 merge1(u,temp);
921 v->right=temp;
922 }
923 else {
924 temp=v->left;
925 v->left=NULL;
926 merge1(&((*u)->right),v);
927 merge1(u,temp);
928 v->left=temp;
929 }
930 }
931 }
932 else if (*u!=NULL) {
933 /* more_u_attr=TRUE; */
934 }
935 }
936
949 void merge2(ptr_node *u,ptr_node v)
950 {
951 long cmp;
952 ptr_node temp;
953
954 if (v) {
955 if (*u==NULL) {
956 ptr_psi_term t;
957 merge2(u,v->right);
958 t = (ptr_psi_term) v->data;
959 deref2_rec_eval(t); /* Assumes goal_stack is already restored. */
960 merge2(u,v->left);
961 }
962 else {
963 cmp=featcmp((*u)->key,v->key);
964 if (cmp==0) {
965 /* if (v->right) */
966 merge2(&((*u)->right),v->right);
967
968 /* if (v->left) */
969 merge2(&((*u)->left),v->left);
970 }
971 else if (cmp>0) {
972 temp=v->right;
973 v->right=NULL;
974 merge2(&((*u)->left),v);
975 merge2(u,temp);
976 v->right=temp;
977 }
978 else {
979 temp=v->left;
980 v->left=NULL;
981 merge2(&((*u)->right),v);
982 merge2(u,temp);
983 v->left=temp;
984 }
985 }
986 }
987 else if (*u!=NULL) {
988 ptr_psi_term t;
989 merge2(&((*u)->right),v);
990 t = (ptr_psi_term) (*u)->data;
991 deref2_rec_eval(t); /* Assumes goal_stack is already restored. */
992 merge2(&((*u)->left),v);
993 }
994 }
995
1004 void merge3(ptr_node *u,ptr_node v)
1005 {
1006 long cmp;
1007 ptr_node temp;
1008
1009 if (v) {
1010 if (*u==NULL) {
1011 push_ptr_value(int_ptr,(GENERIC *)u);
1012 (*u)=STACK_ALLOC(node);
1013 **u= *v;
1014 more_v_attr=TRUE;
1015 }
1016 else {
1017 ptr_psi_term t1; // ,t2;
1018
1019 cmp=featcmp((*u)->key,v->key);
1020 if (cmp==0) {
1021 if (v->right)
1022 merge3(&((*u)->right),v->right);
1023
1024 t1 = (ptr_psi_term) (*u)->data;
1025 /* t2 = (ptr_psi_term) v->data; */
1026 deref2_eval(t1);
1027 /* deref2_eval(t2); */
1028 /* push_goal(unify,(ptr_psi_term)(*u)->data,(ptr_psi_term)v->data,NULL); */
1029
1030 if (v->left)
1031 merge3(&((*u)->left),v->left);
1032 }
1033 else if (cmp>0) {
1034 temp=v->right;
1035 v->right=NULL;
1036 merge3(&((*u)->left),v);
1037 merge3(u,temp);
1038 v->right=temp;
1039 }
1040 else {
1041 temp=v->left;
1042 v->left=NULL;
1043 merge3(&((*u)->right),v);
1044 merge3(u,temp);
1045 v->left=temp;
1046 }
1047 }
1048 }
1049 else if (*u!=NULL) {
1050 more_u_attr=TRUE;
1051 }
1052 }
1053
1071 #if FALSE
1072 /* This version is not quite right */
1073 void merge(ptr_node *u,ptr_node v)
1074 {
1075 long cmp;
1076 ptr_node temp;
1077
1078 if (v) {
1079 if (*u==NULL) {
1080 ptr_psi_term t;
1081 merge(u,v->right);
1082
1083 push_ptr_value(int_ptr,(ptr_psi_term *)u);
1084 (*u)=STACK_ALLOC(node);
1085 **u= *v;
1086 more_v_attr=TRUE;
1087
1088 t = (ptr_psi_term) v->data;
1089 deref2_rec_eval(t); /* Assumes goal_stack is already restored. */
1090 merge(u,v->left);
1091 }
1092 else {
1093 cmp=featcmp((*u)->key,v->key);
1094 if (cmp==0) {
1095 /* if (v->right) */
1096 merge(&((*u)->right),v->right);
1097
1098 push_goal(unify,(ptr_psi_term)(*u)->data,(ptr_psi_term)v->data,NULL);
1099
1100 /* if (v->left) */
1101 merge(&((*u)->left),v->left);
1102 }
1103 else if (cmp>0) {
1104 temp=v->right;
1105 v->right=NULL;
1106 merge(&((*u)->left),v);
1107 merge(u,temp);
1108 v->right=temp;
1109 }
1110 else {
1111 temp=v->left;
1112 v->left=NULL;
1113 merge(&((*u)->right),v);
1114 merge(u,temp);
1115 v->left=temp;
1116 }
1117 }
1118 }
1119 else if (*u!=NULL) {
1120 ptr_psi_term t;
1121 merge(&((*u)->right),v);
1122 t = (ptr_psi_term) (*u)->data;
1123 deref2_rec_eval(t); /* Assumes goal_stack is already restored. */
1124 merge(&((*u)->left),v);
1125
1126 more_u_attr=TRUE;
1127 }
1128 }
1129 #endif
1130
1131 void merge(ptr_node *u,ptr_node v)
1132 {
1133 merge1(u,v); /* Unify corresponding arguments */
1134 merge2(u,v); /* Evaluate lone arguments (lazy failure + eager success) */
1135 merge3(u,v); /* Merge v's loners into u & evaluate corresponding arguments */
1136 }
1137
1146 void merge_unify(ptr_node *u,ptr_node v)
1147 {
1148 merge1(u,v); /* Unify corresponding arguments */
1149 merge3(u,v); /* Merge v's loners into u & evaluate corresponding arguments */
1150 }
1151
1161 void show_count()
1162 {
1163 float t;
1164
1165 if (verbose) {
1166 printf(" [");
1167
1168 (void)times(&end_time);
1169 t = (end_time.tms_utime - start_time.tms_utime)/60.0;
1170
1171 printf("%1.3fs cpu, %ld goal%s",t,goal_count,(goal_count!=1?"s":""));
1172
1173 if (t!=0.0) printf(" (%0.0f/s)",goal_count/t);
1174
1175 printf(", %ld stack",sizeof(mem_base)*(stack_pointer-mem_base));
1176 printf(", %ld heap",sizeof(mem_base)*(mem_limit-heap_pointer));
1177
1178 printf("]");
1179 }
1180
1181 if(NOTQUIET) {
1182 printf("\n");
1183 stack_info(stdout);
1184 }
1185
1186 goal_count=0;
1187 }
1188
1208 void fetch_def(ptr_psi_term u,long allflag)
1209 {
1210 ptr_triple_list prop;
1211 ptr_psi_term v,w;
1212 ptr_definition utype;
1213
1214 /* Uses SMASK because called from check_out */
1215 push2_ptr_value(int_ptr,(GENERIC *)&(u->status),(GENERIC)(u->status & SMASK));
1216 u->status=(4 & SMASK) | (u->status & RMASK);
1217
1218 utype=u->type;
1219 prop=u->type->properties;
1220 if (prop) {
1221
1222 traceline("fetching definition of %P\n",u);
1223
1224 while (prop) {
1225 if (allflag || prop->cccc_4==utype) {
1226 clear_copy();
1227 v=eval_copy(prop->aaaa_4,STACK);
1228 w=eval_copy(prop->bbbb_4,STACK);
1229
1230 if (w) push_goal(prove,(ptr_psi_term)w,(ptr_psi_term)DEFRULES,NULL);
1231
1232 deref_ptr(v);
1233 v->status=4;
1234 push_goal(unify,(ptr_psi_term)u,(ptr_psi_term)v,NULL);
1235 (void)i_eval_args(v->attr_list);
1236 }
1237 prop=prop->next;
1238 }
1239 }
1240 }
1241
1276 void fetch_def_lazy(ptr_psi_term u, ptr_definition old1, ptr_definition old2, ptr_node old1attr, ptr_node old2attr, long old1stat, long old2stat)
1277 {
1278 ptr_triple_list prop;
1279 ptr_psi_term v,w;
1280 long checked1, checked2;
1281 long m1, m2;
1282
1283 if (!u->type->always_check) if (u->attr_list==NULL) return;
1284
1285 push_ptr_value(int_ptr,(GENERIC *)&(u->status));
1286 u->status=4;
1287
1288 prop=u->type->properties;
1289 if (prop) {
1290 traceline("fetching partial definition of %P\n",u);
1291
1292 checked1 = old1attr || old1->always_check;
1293 checked2 = old2attr || old2->always_check;
1294
1295 /* checked1 = (old1stat==4); */ /* 18.2.94 */
1296 /* checked2 = (old2stat==4); */
1297
1298 while (prop) {
1299 /* Only do those constraints that have not yet been done: */
1300 /* In matches, mi is TRUE iff oldi <| prop->cccc_1. */
1301 if (!checked1) m1=FALSE; else (void)matches(old1,prop->cccc_4,&m1);
1302 if (!checked2) m2=FALSE; else (void)matches(old2,prop->cccc_4,&m2);
1303 if (!m1 && !m2) {
1304 /* At this point, prop->cccc_1 is an attribute that has not yet */
1305 /* been checked. */
1306 clear_copy();
1307 v=eval_copy(prop->aaaa_4,STACK);
1308 w=eval_copy(prop->bbbb_4,STACK);
1309
1310 if (w) push_goal(prove,(ptr_psi_term)w,(ptr_psi_term)DEFRULES,NULL);
1311
1312 deref_ptr(v);
1313 v->status=4;
1314 push_goal(unify,(ptr_psi_term)u,(ptr_psi_term)v,NULL);
1315 (void)i_eval_args(v->attr_list);
1316 }
1317 prop=prop->next;
1318 }
1319 }
1320 }
1321
1344 long unify_aim()
1345 {
1346 return unify_body(TRUE);
1347 }
1348
1354 long unify_aim_noeval()
1355 {
1356 return unify_body(FALSE);
1357 }
1358
1365 long unify_body(long eval_flag)
1366 {
1367 long success=TRUE,compare;
1368 ptr_psi_term u,v,tmp;
1369 REAL r;
1370 ptr_definition new_type,old1,old2;
1371 ptr_node old1attr, old2attr;
1372 ptr_int_list new_code;
1373 ptr_int_list d=NULL;
1374 long old1stat,old2stat; /* 18.2.94 */
1375
1376 u=(ptr_psi_term )aim->aaaa_1;
1377 v=(ptr_psi_term )aim->bbbb_1;
1378
1379 deref_ptr(u);
1380 deref_ptr(v);
1381
1382 traceline("unify %P with %P\n",u,v);
1383
1384 if (eval_flag) {
1385 deref(u);
1386 deref(v);
1387 }
1388
1389 if (u!=v) {
1390
1391 /**** Swap the two psi-terms to get them into chronological order ****/
1392 if (u>v) { tmp=v; v=u; u=tmp; }
1393
1394 /**** Check for curried functions ****/
1395 u_func=(u->type->type_def==(def_type)function_it);
1396 v_func=(v->type->type_def==(def_type)function_it);
1397 old1stat=u->status; /* 18.2.94 */
1398 old2stat=v->status; /* 18.2.94 */
1399
1400 /* PVR 18.2.94 */
1401 /* if (u_func && !(u->flags&QUOTED_TRUE) && v->attr_list) { */
1402 if (u_func && u->status==4 && !(u->flags&QUOTED_TRUE) && v->attr_list) {
1403 Errorline("attempt to unify with curried function %P\n", u);
1404 return FALSE;
1405 }
1406 /* if (v_func && !(v->flags&QUOTED_TRUE) && u->attr_list) { */
1407 if (v_func && v->status==4 && !(v->flags&QUOTED_TRUE) && u->attr_list) {
1408 Errorline("attempt to unify with curried function %P\n", v);
1409 return FALSE;
1410 }
1411
1412
1413 #ifdef ARITY /* RM: Mar 29 1993 */
1414 arity_unify(u,v);
1415 #endif
1416
1417 /***** Deal with global vars **** RM: Feb 8 1993 */
1418 if((GENERIC) v>=heap_pointer)
1419 return global_unify(u,v);
1420
1421
1422 /**** Calculate their Greatest Lower Bound and compare them ****/
1423 success=(compare=glb(u->type,v->type,&new_type,&new_code));
1424
1425 if (success) {
1426
1427 /**** Keep the old types for later use in incr. constraint checking ****/
1428 old1 = u->type;
1429 old2 = v->type;
1430 old1attr = u->attr_list;
1431 old2attr = v->attr_list;
1432
1433 /**** DECODE THE RESULTING TYPE ****/
1434 if (!new_type) {
1435 d=decode(new_code);
1436 if (d) {
1437 new_type=(ptr_definition)d->value_1;
1438 d=d->next;
1439 }
1440 else
1441 Errorline("undecipherable sort code.\n");
1442 }
1443
1444 /**** Make COMPARE a little more precise ****/
1445 if (compare==1)
1446 if (u->value_3 && !v->value_3)
1447 compare=2;
1448 else
1449 if (v->value_3 && !u->value_3)
1450 compare=3;
1451
1452 /**** Determine the status of the resulting psi-term ****/
1453 new_stat=4;
1454 switch (compare) {
1455 case 1:
1456 if (u->status <4 && v->status <4)
1457 new_stat=2;
1458 break;
1459 case 2:
1460 if (u->status<4)
1461 new_stat=2;
1462 break;
1463 case 3:
1464 if (v->status<4)
1465 new_stat=2;
1466 break;
1467 case 4:
1468 new_stat=2;
1469 break;
1470 }
1471
1472 /*
1473 printf("u=%s, v=%s, compare=%ld, u.s=%ld, v.s=%ld, ns=%ld\n",
1474 u->type->keyword->symbol,
1475 v->type->keyword->symbol,
1476 compare,
1477 u->status,
1478 v->status,
1479 new_stat);
1480 */
1481
1482 /**** Check that integers have no decimals ****/
1483 if (u->value_3 && sub_type(new_type,integer)) {
1484 r= *(REAL *)u->value_3;
1485 success=(r==floor(r));
1486 }
1487 if (success && v->value_3 && sub_type(new_type,integer)) {
1488 r= *(REAL *)v->value_3;
1489 success=(r==floor(r));
1490 }
1491
1492 /**** Unify the values of INTs REALs STRINGs LISTs etc... ****/
1493 if (success) {
1494 /* LAZY-EAGER */
1495 if (u->value_3!=v->value_3)
1496 if (!u->value_3) {
1497 compare=4;
1498 push_ptr_value(int_ptr,(GENERIC *)&(u->value_3));
1499 u->value_3=v->value_3;
1500 }
1501 else if (v->value_3) {
1502 if (overlap_type(new_type,real))
1503 success=(*((REAL *)u->value_3)==(*((REAL *)v->value_3)));
1504 else if (overlap_type(new_type,quoted_string))
1505 success=(strcmp((char *)u->value_3,(char *)v->value_3)==0);
1506 else if (overlap_type(new_type,sys_bytedata)) {
1507 unsigned long ulen = *((unsigned long *)u->value_3);
1508 unsigned long vlen = *((unsigned long *)v->value_3);
1509 success=(ulen==vlen &&
1510 (bcmp((char *)u->value_3,(char *)v->value_3,ulen)==0));
1511 }
1512 else if (u->type==cut && v->type==cut) { /* 22.9 */
1513 ptr_psi_term mincut;
1514 mincut = (ptr_psi_term) (u->value_3 < (GENERIC) v->value_3? u->value_3 : v->value_3);
1515 if (mincut!=(ptr_psi_term)u->value_3) {
1516 push_ptr_value(cut_ptr,(GENERIC *)&(u->value_3));
1517 u->value_3=(GENERIC)mincut;
1518 }
1519 }
1520 else {
1521 warningline("'%s' may not be unified.\n",new_type->keyword->symbol);
1522 success=FALSE;
1523 }
1524 }
1525 else
1526 compare=4;
1527 }
1528
1529 /**** Bind the two psi-terms ****/
1530 if (success) {
1531 /* push_ptr_value(psi_term_ptr,(ptr_psi_term *)&(v->coref)); 9.6 */
1532 push_psi_ptr_value(v,(GENERIC *)&(v->coref));
1533 v->coref=u;
1534
1535 if (!equal_types(u->type,new_type)) {
1536 push_ptr_value(def_ptr,(GENERIC *)&(u->type));
1537 /* This does not seem to work right with cut.lf: */
1538 /* push_def_ptr_value(u,&(u->type_3)); */ /* 14.8 */
1539 u->type=new_type;
1540 }
1541
1542 if (u->status!=new_stat) {
1543 push_ptr_value(int_ptr,(GENERIC *)&(u->status));
1544 u->status=new_stat;
1545 }
1546
1547 /**** Unify the attributes ****/
1548 more_u_attr=FALSE;
1549 more_v_attr=FALSE;
1550
1551
1552 #ifdef ARITY /* RM: Mar 29 1993 */
1553 arity_merge(u->attr_list,v->attr_list);
1554 #endif
1555
1556
1557 if (u->attr_list || v->attr_list)
1558 merge(&(u->attr_list),v->attr_list);
1559
1560 /**** Look after curried functions ****/
1561 /*
1562 if ((u_func && more_v_attr) || (v_func && more_u_attr)) {
1563 if (!(u->flags&QUOTED_TRUE | v->flags&QUOTED_TRUE)) {
1564 traceline("re-evaluating curried expression %P\n", u);
1565 if (u->status!=0) {
1566 push_ptr_value(int_ptr,(ptr_psi_term *)&(u->status));
1567 u->status=0;
1568 }
1569 check_func(u);
1570 }
1571 }
1572 */
1573
1574 if (v->flags&QUOTED_TRUE && !(u->flags&QUOTED_TRUE)) { /* 16.9 */
1575 push_ptr_value(int_ptr,(GENERIC *)&(u->flags));
1576 u->flags|=QUOTED_TRUE;
1577 }
1578
1579 /**** RELEASE RESIDUATIONS ****/
1580 /* This version implements the correct semantics. */
1581 if (u->resid)
1582 release_resid(u);
1583 if (v->resid)
1584 release_resid(v);
1585
1586 /**** Alternatives in a type disjunction ****/
1587 if (d) {
1588 traceline("pushing type disjunction choice point for %P\n",u);
1589 push_choice_point(type_disj,u,(ptr_psi_term)d,NULL);
1590 }
1591
1592 /**** VERIFY CONSTRAINTS ****/
1593 /* if ((old1stat<4 || old2stat<4) &&
1594 (u->type->type==type || v->type->type==type)) { 18.2.94 */
1595 if (new_stat<4 && u->type->type_def==(def_type)type_it) {
1596 /* This does not check the already-checked properties */
1597 /* (i.e. those in types t with t>=old1 or t>=old2), */
1598 /* and it does not check anything if u has no attributes. */
1599 /* It will, however, check the unchecked properties if a */
1600 /* type gains attributes. */
1601 fetch_def_lazy(u, old1, old2,
1602 old1attr, old2attr,
1603 old1stat, old2stat);
1604 }
1605 }
1606 }
1607 }
1608 return success;
1609 }
1610
1621 long disjunct_aim()
1622 {
1623 // ptr_psi_term u,v;
1624 // ptr_list l;
1625 long success=TRUE;
1626
1627 printf("Call to disjunct_aim\nThis routine inhibited by RM: Dec 9 1992\n");
1628
1629 return success;
1630 }
1631
1632
1633
1645 long prove_aim()
1646 {
1647 long success=TRUE;
1648 ptr_psi_term thegoal,head,body,arg1,arg2;
1649 ptr_pair_list rule;
1650
1651 thegoal=(ptr_psi_term )aim->aaaa_1;
1652 rule=(ptr_pair_list )aim->bbbb_1;
1653
1654 if (thegoal && rule) {
1655
1656 deref_ptr(thegoal); /* Evaluation is explicitly handled later. */
1657
1658 if (thegoal->type!=and) {
1659 if (thegoal->type!=cut)
1660 if(thegoal->type!=life_or) {
1661 /* User-defined predicates with unevaluated arguments */
1662 /* Built-ins do this themselves (see built_ins.c). */
1663 /* if (!thegoal->type->evaluate_args) mark_quote(thegoal); 24.8 25.8 */
1664
1665 if(i_check_out(thegoal)) { /* RM: Apr 6 1993 */
1666
1667 goal_stack=aim->next;
1668 goal_count++;
1669
1670 if ((unsigned long)rule==DEFRULES) {
1671 rule=(ptr_pair_list)thegoal->type->rule;
1672 if (thegoal->type->type_def==(def_type)predicate_it) {
1673 if (!rule) /* This can happen when RETRACT is used */
1674 success=FALSE;
1675 }
1676 else if ( thegoal->type->type_def==(def_type)function_it
1677 || ( thegoal->type->type_def==(def_type)type_it
1678 && sub_type(boolean,thegoal->type)
1679 )
1680 ) {
1681 if (thegoal->type->type_def==(def_type)function_it && !rule)
1682 /* This can happen when RETRACT is used */
1683 success=FALSE;
1684 else {
1685 ptr_psi_term bool_pred;
1686 ptr_node a;
1687 /* A function F in pred. position is called as */
1688 /* '*bool_pred*'(F), which succeeds if F returns true */
1689 /* and fails if it returns false. It can residuate too. */
1690 bool_pred=stack_psi_term(0);
1691 bool_pred->type=boolpredsym;
1692 bool_pred->attr_list=(a=STACK_ALLOC(node));
1693 a->key=one;
1694 a->left=a->right=NULL;
1695 a->data=(GENERIC) thegoal;
1696 push_goal(prove,(ptr_psi_term)bool_pred,(ptr_psi_term)DEFRULES,NULL);
1697 return success; /* We're done! */
1698 }
1699 }
1700 else if (!thegoal->type->protected && thegoal->type->type_def==(def_type)undef_it) {
1701 /* Don't give an error message for undefined dynamic objects */
1702 /* that do not yet have a definition */
1703 success=FALSE;
1704 }
1705 else if (thegoal->type==lf_true || thegoal->type==lf_false) {
1706 /* What if the 'lf_true' or 'lf_false' have arguments? */
1707 success=(thegoal->type==lf_true);
1708 return success; /* We're done! */
1709 }
1710 else {
1711 /* Error: undefined predicate. */
1712 /* Call the call_handler (which may do an auto-load). */
1713 ptr_psi_term call_handler;
1714 /* mark_quote(thegoal); */
1715
1716 /* RM: Jan 27 1993 */
1717 /* warningline("call handler invoked for %P\n",thegoal); */
1718
1719 call_handler=stack_psi_term(0);
1720 call_handler->type=call_handlersym;
1721 stack_add_psi_attr(call_handler,"1",thegoal);
1722 push_goal(prove,(ptr_psi_term)call_handler,(ptr_psi_term)DEFRULES,NULL);
1723 return success; /* We're done! */
1724 }
1725 }
1726
1727 if (success) {
1728
1729 if ((unsigned long)rule<=MAX_BUILT_INS) {
1730
1731 /* For residuation (RESPRED) */
1732 curried=FALSE;
1733 can_curry=TRUE;
1734 resid_vars=NULL;
1735 /* resid_limit=(ptr_goal )stack_pointer; 12.6 */
1736
1737 if (thegoal->type!=tracesym) /* 26.1 */
1738 traceline("prove built-in %P\n", thegoal);
1739
1740 /* RESPRED */ resid_aim=aim;
1741 /* Residuated predicate must return success=TRUE */
1742 success=c_rule[(unsigned long)rule]();
1743
1744 /* RESPRED */ if (curried)
1745 /* RESPRED */ do_currying();
1746 /* RESPRED */ else if (resid_vars)
1747 /* RESPRED */ success=do_residuation_user(); /* 21.9 */ /* PVR 9.2.94 */
1748 }
1749 else {
1750
1751 /* Evaluate arguments of a predicate call before the call. */
1752 deref_args(thegoal,set_empty);
1753
1754 traceline("prove %P\n", thegoal);
1755
1756 /* For residuation (RESPRED) */
1757 curried=FALSE;
1758 can_curry=TRUE;
1759 resid_vars=NULL;
1760 /* resid_limit=(ptr_goal )stack_pointer; 12.6 */
1761
1762 while (rule && (rule->aaaa_2==NULL || rule->bbbb_2==NULL)) {
1763 rule=rule->next;
1764 traceline("alternative clause has been retracted\n");
1765 }
1766 if (rule) {
1767
1768 clear_copy();
1769 if (TRUE) /* 8.9 */
1770 /* if (thegoal->type->evaluate_args) 8.9 */
1771 head=eval_copy(rule->aaaa_2,STACK);
1772 else
1773 head=quote_copy(rule->aaaa_2,STACK);
1774
1775 body=eval_copy(rule->bbbb_2,STACK);
1776
1777 /* What does this do?? */
1778 /* if (body->type==built_in) */
1779 /* body->coref=head; */
1780
1781 if (rule->next)
1782 push_choice_point(prove,thegoal,(ptr_psi_term)rule->next,NULL);
1783
1784 if (body->type!=succeed)
1785 push_goal(prove,(ptr_psi_term)body,(ptr_psi_term)DEFRULES,NULL);
1786
1787 /* push_ptr_value(psi_term_ptr,&(head->coref)); 9.6 */
1788 push_psi_ptr_value(head,(GENERIC *)&(head->coref));
1789 head->coref=thegoal;
1790 merge(&(thegoal->attr_list),head->attr_list);
1791 if (!head->status) {
1792 (void)i_eval_args(head->attr_list);
1793 }
1794 }
1795 else {
1796 success=FALSE;
1797 }
1798 }
1799 }
1800 }
1801 }
1802 else { /* ';' built-in */
1803 /* RM: Apr 6 1993 */
1804 goal_stack=aim->next;
1805 goal_count++;
1806 get_two_args(thegoal->attr_list,&arg1,&arg2);
1807 push_choice_point(prove,arg2,(ptr_psi_term)DEFRULES,NULL);
1808 push_goal(prove,(ptr_psi_term)arg1,(ptr_psi_term)DEFRULES,NULL);
1809 }
1810 else { /* 'Cut' built-in*/
1811 goal_stack=aim->next;
1812 goal_count++;
1813 /* assert((ptr_choice_point)(thegoal->value)<=choice_stack); 12.7 */
1814 cut_to(thegoal->value_3); /* 12.7 */
1815 #ifdef CLEAN_TRAIL
1816 clean_trail(choice_stack);
1817 #endif
1818 traceline("cut all choice points back to %x\n",choice_stack);
1819 }
1820 }
1821 else { /* 'And' built-in */
1822 goal_stack=aim->next;
1823 goal_count++;
1824 get_two_args(thegoal->attr_list,&arg1,&arg2);
1825 push_goal(prove,(ptr_psi_term)arg2,(ptr_psi_term)DEFRULES,NULL);
1826 push_goal(prove,(ptr_psi_term)arg1,(ptr_psi_term)DEFRULES,NULL);
1827 }
1828 }
1829 else
1830 success=FALSE;
1831
1832 /* RESPRED */ resid_aim=NULL;
1833 return success;
1834 }
1835
1845 void type_disj_aim()
1846 {
1847 ptr_psi_term t;
1848 ptr_int_list d;
1849
1850 t=(ptr_psi_term)aim->aaaa_1;
1851 d=(ptr_int_list)aim->bbbb_1;
1852
1853 if (d->next) {
1854 traceline("pushing type disjunction choice point for %P\n", t);
1855 push_choice_point(type_disj,t,(ptr_psi_term)d->next,NULL);
1856 }
1857
1858 push_ptr_value(def_ptr,(GENERIC *)&(t->type));
1859 /* Below makes cut.lf behave incorrectly: */
1860 /* push_def_ptr_value(t,&(t->type)); */ /* 14.8 */
1861 t->type=(ptr_definition)d->value_1;
1862
1863 traceline("setting type disjunction to %s.\n", t->type->keyword->symbol);
1864
1865 if ((t->attr_list || t->type->always_check) && t->status<4)
1866 fetch_def(t, FALSE);
1867 }
1868
1879 long clause_aim(long r)
1880 {
1881 long success=FALSE;
1882 ptr_pair_list *p;
1883 ptr_psi_term head,body,rule_head,rule_body;
1884
1885 head=(ptr_psi_term)aim->aaaa_1;
1886 body=(ptr_psi_term)aim->bbbb_1;
1887 p=(ptr_pair_list *)aim->cccc_1;
1888
1889 if ((unsigned long)(*p)>MAX_BUILT_INS) {
1890 success=TRUE;
1891 /* deref(head); 17.9 */
1892
1893 if ((*p)->next) {
1894 if (r) {
1895 traceline("pushing 'retract' choice point for %P\n", head);
1896 push_choice_point(del_clause,head,(ptr_psi_term)body,(GENERIC)&((*p)->next));
1897 /* push_choice_point(del_clause,head,body,p); */
1898 }
1899 else {
1900 traceline("pushing 'clause' choice point for %P\n", head);
1901 push_choice_point(clause,head,(ptr_psi_term)body,(GENERIC)&((*p)->next));
1902 }
1903 }
1904
1905 if (r)
1906 push_goal(retract,(ptr_psi_term)p,(ptr_psi_term)NULL,NULL);
1907 if ((*p)->aaaa_2) {
1908 clear_copy();
1909 rule_head=quote_copy((*p)->aaaa_2,STACK);
1910 rule_body=quote_copy((*p)->bbbb_2,STACK);
1911
1912 push_goal(unify,(ptr_psi_term)body,(ptr_psi_term)rule_body,NULL);
1913 push_goal(unify,(ptr_psi_term)head,(ptr_psi_term)rule_head,NULL);
1914
1915 rule_head->status=4;
1916 rule_body->status=4;
1917
1918 (void)i_eval_args(rule_body->attr_list);
1919 (void)i_eval_args(rule_head->attr_list);
1920
1921 traceline("fetching next clause for %s\n", head->type->keyword->symbol);
1922 }
1923 else {
1924 success=FALSE;
1925 traceline("following clause had been retracted\n");
1926 }
1927 }
1928 else if ((unsigned long)(*p)>0) {
1929 if (r)
1930 Errorline("the built-in %P cannot be retracted.\n",head);
1931 else
1932 Errorline("the definition of built-in %P is not accessible.\n",head);
1933 }
1934
1935 return success;
1936 }
1937
1945 long no_choices()
1946 {
1947 return (choice_stack==NULL) || (choice_stack->goal_stack->type==what_next);
1948 }
1949
1956 long num_choices()
1957 {
1958 long num;
1959 ptr_choice_point cp;
1960
1961 num=0;
1962 cp=choice_stack;
1963 while (cp) {
1964 num++;
1965 cp=cp->next;
1966 }
1967 return num;
1968 }
1976 long num_vars(ptr_node vt)
1977 {
1978 return (vt?(num_vars(vt->left)+1+num_vars(vt->right)):0);
1979 }
1980
1987 long what_next_cut()
1988 {
1989 long flag=TRUE;
1990 long result=FALSE;
1991
1992 do {
1993 if (choice_stack) {
1994 backtrack();
1995 if (goal_stack->type==what_next) {
1996 flag=FALSE;
1997 result=TRUE;
1998 }
1999 }
2000 else {
2001 /* This undo does the last undo actions before returning to top level. */
2002 /* It is not needed for variable undoing, but for actions (like */
2003 /* closing windows). */
2004 undo(NULL);
2005 /* undo(mem_base); 7.8 */
2006 #ifdef TS
2007 /* global_time_stamp=INIT_TIME_STAMP; */ /* 9.6 */
2008 #endif
2009 flag=FALSE;
2010 }
2011 } while (flag);
2012
2013 return result;
2014 }
2015
2026 ptr_choice_point topmost_what_next()
2027 {
2028 ptr_choice_point cp=choice_stack;
2029
2030 while (cp && cp->goal_stack && cp->goal_stack->type!=what_next)
2031 cp=cp->next;
2032
2033 if (cp && cp->goal_stack && cp->goal_stack->type==what_next)
2034 return cp;
2035 else
2036 return (ptr_choice_point) NULL;
2037 }
2038
2047 void reset_stacks()
2048 {
2049 undo(NULL); /* 8.10 */
2050 goal_stack=NULL;
2051 choice_stack=NULL;
2052 #ifdef TS
2053 /* global_time_stamp=INIT_TIME_STAMP; */ /* 9.6 */
2054 #endif
2055 }
2056
2068 long what_next_aim()
2069 {
2070 long result=FALSE;
2071 ptr_psi_term s;
2072 long c, c2; /* 21.12 (prev. char) */
2073 char *pr;
2074 long sort,cut_loc=FALSE;
2075 long level,i;
2076 long eventflag;
2077 ptr_stack save_undo_stack;
2078 long lev1,lev2;
2079 begin_terminal_io();
2080
2081 level=((unsigned long)aim->cccc_1);
2082
2083 if (aim->aaaa_1) {
2084 /* Must remember var_occurred from the what_next goal and from */
2085 /* execution of previous query (it may have contained a parse) */
2086 var_occurred=var_occurred || ((unsigned long)aim->bbbb_1)&TRUEMASK; /* 18.8 */
2087 eventflag=(((unsigned long)aim->bbbb_1)&(TRUEMASK*2))!=0;
2088 if (
2089 !var_occurred && no_choices() && level>0
2090 #ifdef X11
2091 /* Keep level same if no window & no X event */
2092 && !x_window_creation && !eventflag
2093 #endif
2094 ) {
2095 /* Keep level the same if in a query, the number of choice points */
2096 /* has not increased and there are no variables. */
2097 /* This has to have the same behavior as if an EOLN was typed */
2098 /* and no 'No' message should be given on the lowest level, */
2099 level--;
2100 (void)what_next_cut();
2101 if (level==0) { result=TRUE; }
2102 }
2103 }
2104
2105 #ifdef X11
2106 x_window_creation=FALSE;
2107 #endif
2108
2109 infoline(aim->aaaa_1?"\n*** Yes":"\n*** No");
2110 show_count();
2111 if (aim->aaaa_1 || level>0 ) (void)print_variables(NOTQUIET); // had commente || ... DJD
2112
2113 {
2114 if (level > 0 && aborthooksym->type_def != (def_type)function_it )
2115 {
2116 lev1=MAX_LEVEL<level?MAX_LEVEL:(level);
2117 lev2=level;
2118 }
2119 else
2120 {
2121 lev1 = 0;
2122 lev2 = 0;
2123 }
2124
2125 pr=prompt_buffer;
2126 /* RM: Oct 13 1993 */
2127 if(current_module==user_module)
2128 *pr='\0';
2129 else
2130 strcpy(pr,current_module->module_name);
2131 pr += strlen(pr);
2132 for(i=1;i<=lev1;i++) { *pr='-'; pr++; *pr='-'; pr++; }
2133 if (lev2>0)
2134 sprintf(pr,"%ld",lev2);
2135 strcat(pr,PROMPT);
2136
2137 prompt=prompt_buffer;
2138 }
2139
2140 stdin_cleareof();
2141 /* The system waits for either an input command or an X event. */
2142 /* An X event is treated *exactly* like an input command that */
2143 /* has the same effect. */
2144 #ifdef X11
2145 c=x_read_stdin_or_event(&eventflag);
2146 if (eventflag) {
2147 /* Include eventflag info in var_occurred field. */
2148 push_goal(what_next,(ptr_psi_term)TRUE,(ptr_psi_term)(FALSE+2*TRUE),(GENERIC)level /* +1 RM: Jun 22 1993 */);
2149 release_resid(xevent_existing);
2150 result=TRUE;
2151 }
2152 else
2153 #else
2154 c=read_char();
2155 #endif
2156 {
2157 while (c!=EOLN && c>0 && c<=32 && c!=EOF) {
2158 c=read_char();
2159 }
2160 if (c==EOF) {
2161 reset_stacks();
2162 }
2163 else if (c==EOLN) {
2164 cut_loc=TRUE;
2165 }
2166 else if (c==';' || c=='.') {
2167 do {
2168 c2=read_char();
2169 } while (c2!=EOLN && c2!=EOF && c2>0 && c2<=32);
2170 if (c=='.') { /* 6.10 */
2171 reset_stacks();
2172 result=TRUE;
2173 }
2174 }
2175 else {
2176 if (level>0) push_choice_point(what_next,FALSE,(ptr_psi_term)FALSE,(GENERIC)level);
2177
2178 put_back_char(c);
2179 var_occurred=FALSE;
2180 save_undo_stack=undo_stack;
2181 s=stack_copy_psi_term(parse(&sort));
2182
2183 if (s->type==eof) {
2184 reset_stacks();
2185 put_back_char(EOF);
2186 } else if (sort==QUERY) {
2187 push_goal(what_next,(ptr_psi_term)TRUE,(ptr_psi_term)var_occurred,(GENERIC)(level+1));
2188 push_goal(prove,(ptr_psi_term)s,(ptr_psi_term)DEFRULES,NULL);
2189 reset_step();
2190 result=TRUE;
2191 }
2192 else if (sort==FACT) { /* A declaration */
2193 push_goal(what_next,(ptr_psi_term)TRUE,(ptr_psi_term)FALSE,(GENERIC)(level + 1)); /* 18.5 */ // HERE
2194 assert_first=FALSE;
2195 assert_clause(s);
2196 /* Variables in the query may be used in a declaration, */
2197 /* but the declaration may not add any variables. */
2198 undo(save_undo_stack); /* 17.8 */
2199 encode_types();
2200 result=TRUE;
2201 }
2202 else {
2203 /* Stay at same level on syntax error */
2204 push_goal(what_next,(ptr_psi_term)TRUE,(ptr_psi_term)FALSE,(GENERIC)(level+1)); /* 20.8 */
2205 result=TRUE; /* 20.8 */
2206 }
2207 }
2208 }
2209
2210 if (cut_loc) result = what_next_cut() || result;
2211
2212 end_terminal_io();
2213
2214 var_occurred=FALSE;
2215 start_chrono();
2216
2217 return result;
2218 }
2219
2232 long load_aim()
2233 {
2234 long success=TRUE,exitloop;
2235 ptr_psi_term s;
2236 long sort;
2237 char *fn;
2238 long old_noisy,old_file_date;
2239 ptr_node old_var_tree;
2240 ptr_choice_point cutpt;
2241 long old_var_occurred; /* 18.8 */
2242 int end_of_file=FALSE; /* RM: Jan 27 1993 */
2243
2244
2245 save_state(input_state);
2246 input_state=(ptr_psi_term)aim->aaaa_1;
2247 restore_state(input_state);
2248 old_file_date=file_date;
2249 file_date=(unsigned long)aim->bbbb_1;
2250 old_noisy=noisy;
2251 noisy=FALSE;
2252 fn=(char*)aim->cccc_1;
2253 exitloop=FALSE;
2254
2255 do {
2256 /* Variables in queries in files are *completely independent* of top- */
2257 /* level variables. I.e.: top-level variables are *not* recognized */
2258 /* while loading files and variables in file queries are *not* added. */
2259 old_var_occurred=var_occurred; /* 18.8 */
2260 old_var_tree=var_tree;
2261 var_tree=NULL;
2262 s=stack_copy_psi_term(parse(&sort));
2263 var_tree=old_var_tree;
2264 var_occurred=old_var_occurred; /* 18.8 */
2265
2266 if (s->type==eof) {
2267 encode_types();
2268 if (input_stream!=stdin) (void)fclose(input_stream);
2269 exitloop=TRUE;
2270 end_of_file=TRUE; /* RM: Jan 27 1993 */
2271 }
2272 else if (sort==FACT) {
2273 assert_first=FALSE;
2274 assert_clause(s);
2275 }
2276 else if (sort==QUERY) {
2277 encode_types();
2278 save_state(input_state);
2279 /* Handle both successful and failing queries correctly. */
2280 cutpt=choice_stack;
2281 push_choice_point(load,input_state,(ptr_psi_term)file_date,(GENERIC) fn);
2282 push_goal(load,(ptr_psi_term)input_state,(ptr_psi_term)file_date,(GENERIC)fn);
2283 push_goal(general_cut,(ptr_psi_term)cutpt,(ptr_psi_term)NULL,(GENERIC)NULL);
2284 push_goal(prove,(ptr_psi_term)s,(ptr_psi_term)DEFRULES,(GENERIC)NULL);
2285 exitloop=TRUE;
2286 }
2287 else {
2288 /* fprintf(stderr,"*** Error: in input file %c%s%c.\n",34,fn,34); */
2289 /* success=FALSE; */
2290 /* fail_all(); */
2291 if (input_stream!=stdin) (void)fclose(input_stream);
2292 (void)abort_life(TRUE);
2293 /* printf("\n*** Abort\n"); */
2294 /* main_loop_ok=FALSE; */
2295 }
2296 } while (success && !exitloop);
2297
2298
2299 /* RM: Jan 27 1993 */
2300 if(end_of_file || !success) {
2301 /*
2302 printf("END OF FILE %s, setting module to %s\n",
2303 ((ptr_psi_term)get_attr(input_state,
2304 INPUT_FILE_NAME))->value,
2305 ((ptr_psi_term)get_attr(input_state,
2306 CURRENT_MODULE))->value);
2307 */
2308
2309 (void)set_current_module(
2310 find_module((char *)((ptr_psi_term)get_attr(input_state,
2311 CURRENT_MODULE))->value_3));
2312 }
2313
2314
2315 noisy=old_noisy;
2316 file_date=old_file_date;
2317 (void)open_input_file("stdin");
2318
2319
2320 return success;
2321 }
2322
2333 void main_prove()
2334 {
2335 long success=TRUE;
2336 ptr_pair_list *p;
2337 ptr_psi_term unused_match_date; /* 13.6 */
2338
2339 xcount=0;
2340 xeventdelay=XEVENTDELAY;
2341 interrupted=FALSE;
2342 main_loop_ok=TRUE;
2343
2344 while (main_loop_ok && goal_stack) {
2345
2346 /* RM: Oct 28 1993 For debugging a horrible mess.
2347 {
2348 ptr_choice_point c=choice_stack;
2349 while(c) {
2350 if((ptr_psi_term)stack_pointer<(ptr_psi_term)c) {
2351 printf("########### Choice stack corrupted! %x\n",c);
2352 trace=TRUE;
2353 c=NULL;
2354 }
2355 else
2356 c=c->next;
2357 }
2358 }
2359 */
2360
2361
2362 aim=goal_stack;
2363 switch(aim->type) {
2364
2365 case unify:
2366 goal_stack=aim->next;
2367 goal_count++;
2368 success=unify_aim();
2369 break;
2370
2371 /* Same as above, but do not evaluate top level */
2372 /* Used to bind with unbound variables */
2373 case unify_noeval:
2374 goal_stack=aim->next;
2375 goal_count++;
2376 success=unify_aim_noeval();
2377 break;
2378
2379 case prove:
2380 success=prove_aim();
2381 break;
2382
2383 case eval:
2384 goal_stack=aim->next;
2385 goal_count++;
2386 success=eval_aim();
2387 break;
2388
2389 case load:
2390 goal_stack=aim->next;
2391 goal_count++;
2392 success=load_aim();
2393 break;
2394
2395 case match:
2396 goal_stack=aim->next;
2397 goal_count++;
2398 success=match_aim();
2399 break;
2400
2401 case disj:
2402 goal_stack=aim->next;
2403 goal_count++;
2404 success=disjunct_aim();
2405 break;
2406
2407 case general_cut:
2408 goal_stack=aim->next;
2409 goal_count++;
2410 /* assert((ptr_choice_point)aim->aaaa_1 <= choice_stack); 12.7 */
2411 /* choice_stack=(ptr_choice_point)aim->aaaa_1; */
2412 cut_to(aim->aaaa_1); /* 12.7 */
2413 #ifdef CLEAN_TRAIL
2414 clean_trail(choice_stack);
2415 #endif
2416 #ifdef TS
2417 /* RESTORE_TIME_STAMP; */ /* 9.6 */
2418 #endif
2419 break;
2420
2421 case eval_cut:
2422 /* RESID */ restore_resid((ptr_resid_block)aim->cccc_1, &unused_match_date);
2423 if (curried)
2424 do_currying();
2425 else if (resid_vars) {
2426 success=do_residuation_user(); /* 21.9 */ /* PVR 9.2.94 */
2427 } else {
2428 if (resid_aim)
2429 traceline("result of %P is %P\n", resid_aim->aaaa_1, aim->aaaa_1);
2430 goal_stack=aim->next;
2431 goal_count++;
2432 /* resid_aim=NULL; 21.9 */
2433 /* PVR 5.11 choice_stack=(ptr_choice_point)aim->bbbb_1; */
2434 (void)i_check_out(aim->aaaa_1);
2435 }
2436 resid_aim=NULL; /* 21.9 */
2437 resid_vars=NULL; /* 22.9 */
2438 /* assert((ptr_choice_point)aim->bbbb_1<=choice_stack); 12.7 */
2439 /* PVR 5.11 */ /* choice_stack=(ptr_choice_point)aim->bbbb_1; */
2440 if (success) { /* 21.9 */
2441 cut_to(aim->bbbb_1); /* 12.7 */
2442 #ifdef CLEAN_TRAIL
2443 clean_trail(choice_stack);
2444 #endif
2445 /* match_date=NULL; */ /* 13.6 */
2446 #ifdef TS
2447 /* RESTORE_TIME_STAMP; */ /* 9.6 */
2448 #endif
2449 }
2450 break;
2451
2452 case freeze_cut:
2453 /* RESID */ restore_resid((ptr_resid_block)aim->cccc_1, &unused_match_date);
2454 if (curried) {
2455 warningline("frozen goal has a missing parameter '%P' and fails.\n",aim->aaaa_1);
2456 success=FALSE;
2457 }
2458 else if (resid_vars) {
2459 success=do_residuation_user(); /* 21.9 */ /* PVR 9.2.94 */
2460 } else {
2461 if (resid_aim) traceline("releasing frozen goal: %P\n", aim->aaaa_1);
2462 /* resid_aim=NULL; 21.9 */
2463 /* PVR 5.12 choice_stack=(ptr_choice_point)aim->bbbb_1; */
2464 goal_stack=aim->next;
2465 goal_count++;
2466 }
2467 resid_aim=NULL; /* 21.9 */
2468 resid_vars=NULL; /* 22.9 */
2469 if (success) { /* 21.9 */
2470 /* assert((ptr_choice_point)aim->bbbb_1<=choice_stack); 12.7 */
2471 /* PVR 5.12 */ /* choice_stack=(ptr_choice_point)aim->bbbb_1; */
2472 cut_to(aim->bbbb_1); /* 12.7 */
2473 #ifdef CLEAN_TRAIL
2474 clean_trail(choice_stack);
2475 #endif
2476 /* match_date=NULL; */ /* 13.6 */
2477 #ifdef TS
2478 /* RESTORE_TIME_STAMP; */ /* 9.6 */
2479 #endif
2480 }
2481 break;
2482
2483 case implies_cut: /* 12.10 */
2484 /* This 'cut' is actually more like a no-op! */
2485 restore_resid((ptr_resid_block)aim->cccc_1, &unused_match_date);
2486 if (curried) {
2487 warningline("implied goal has a missing parameter '%P' and fails.\n",aim->aaaa_1);
2488 success=FALSE;
2489 }
2490 else if (resid_vars)
2491 success=FALSE;
2492 else {
2493 if (resid_aim) traceline("executing implied goal: %P\n", aim->aaaa_1);
2494 goal_stack=aim->next;
2495 goal_count++;
2496 }
2497 resid_aim=NULL; /* 21.9 */
2498 resid_vars=NULL; /* 22.9 */
2499 break;
2500
2501 case fail:
2502 goal_stack=aim->next;
2503 success=FALSE;
2504 break;
2505
2506 case what_next:
2507 goal_stack=aim->next;
2508 success=what_next_aim();
2509 break;
2510
2511 case type_disj:
2512 goal_stack=aim->next;
2513 goal_count++;
2514 type_disj_aim();
2515 break;
2516
2517 case clause:
2518 goal_stack=aim->next;
2519 goal_count++;
2520 success=clause_aim(0);
2521 break;
2522
2523 case del_clause:
2524 goal_stack=aim->next;
2525 goal_count++;
2526 success=clause_aim(1);
2527 break;
2528
2529 case retract:
2530 goal_stack=aim->next;
2531 goal_count++;
2532 p=(ptr_pair_list*)aim->aaaa_1;
2533 traceline("deleting clause (%P%s%P)\n",
2534 (*p)->aaaa_2,((*p)->aaaa_2->type->type_def==(def_type)function_it?"->":":-"),(*p)->bbbb_2);
2535 (*p)->aaaa_2=NULL;
2536 (*p)->bbbb_2=NULL;
2537 (*p)=(*p)->next; /* Remove retracted element from pairlist */
2538 break;
2539
2540 case c_what_next: /* RM: Mar 31 1993 */
2541 main_loop_ok=FALSE; /* Exit the main loop */
2542 break;
2543
2544 default:
2545 Errorline("bad goal on stack %d.\n",goal_stack->type);
2546 goal_stack=aim->next;
2547 }
2548
2549 if (main_loop_ok) {
2550
2551 if (success) {
2552
2553 #ifdef X11
2554 /* Polling on external events */
2555 if (xcount<=0 && aim->type==prove) {
2556 if (x_exist_event()) {
2557 /* printf("At event, xeventdelay = %ld.\n",xeventdelay); */
2558 xeventdelay=0;
2559 release_resid(xevent_existing);
2560 } else {
2561 if (xeventdelay<XEVENTDELAY)
2562 /* If XEVENTDELAY=1000 it takes 90000 goals to get back */
2563 /* from 100 at the pace of 1%. */
2564 xeventdelay=(xeventdelay*101)/100+2;
2565 else
2566 xeventdelay=XEVENTDELAY;
2567 }
2568 xcount=xeventdelay;
2569 }
2570 else
2571 xcount--;
2572 #endif
2573
2574 }
2575 else {
2576 if (choice_stack) {
2577 backtrack();
2578 traceline("backtracking\n");
2579 success=TRUE;
2580 }
2581 else /* if (goal_stack) */ {
2582 undo(NULL); /* 8.10 */
2583 infoline("\n*** No");
2584 /* printf("\n*** No (in main_prove)."); */
2585 show_count();
2586 #ifdef TS
2587 /* global_time_stamp=INIT_TIME_STAMP; */ /* 9.6 */
2588 #endif
2589 main_loop_ok=FALSE;
2590 }
2591 }
2592
2593 if (heap_pointer-stack_pointer < GC_THRESHOLD)
2594 (void)memory_check();
2595
2596 if (interrupted || (stepflag && steptrace))
2597 handle_interrupt();
2598 else if (stepcount>0) {
2599 stepcount--;
2600 if (stepcount==0 && !stepflag) {
2601 stepflag=TRUE;
2602 handle_interrupt();
2603 }
2604 }
2605 }
2606 }
2607 }
2608
2617 int dummy_printf(char *f,char *s,char *t)
2618 {
2619 return strlen(f);
2620 }
2621 // from login.h
2622 #ifdef TS
2623
2630 long trail_condition(psi_term *Q)
2631 {
2632 return (choice_stack && choice_stack->time_stamp>=Q->time_stamp);
2633 }
2634 #endif
stack_pointer
GENERIC stack_pointer
used to allocate from stack - size allocated added - adj for alignment
Definition: def_glob.h:69
VALID_ADDRESS
#define VALID_ADDRESS(A)
Definition: def_macro.h:137
show_subwindow
#define show_subwindow
To backtrack on show sub windows RM 8/12/92.
Definition: def_const.h:470
assert_clause
void assert_clause(ptr_psi_term t)
assert_clause
Definition: login.c:287
prove
#define prove
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1051
get_one_arg_addr
void get_one_arg_addr(ptr_node t, ptr_psi_term **a)
get_one_arg_addr
Definition: login.c:132
x_exist_event
long x_exist_event()
x_exist_event
Definition: xpred.c:3787
what_next_cut
long what_next_cut()
what_next_cut
Definition: login.c:1987
reset_stacks
void reset_stacks()
reset_stacks
Definition: login.c:2047
wl_goal::aaaa_1
ptr_psi_term aaaa_1
Definition: def_struct.h:239
wl_pair_list::aaaa_2
ptr_psi_term aaaa_2
Definition: def_struct.h:205
wl_psi_term::resid
ptr_residuation resid
Definition: def_struct.h:189
load_aim
long load_aim()
load_aim
Definition: login.c:2232
hide_subwindow
#define hide_subwindow
To backtrack on hide sub windows RM 8/12/92.
Definition: def_const.h:477
push_window
void push_window(long type, long disp, long wind)
push_window
Definition: login.c:548
function_it
#define function_it
was enum (def_type) in extern.h now there is typedef ptr_definition
Definition: def_const.h:1408
undef_it
#define undef_it
was enum (def_type) in extern.h now there is typedef ptr_definition
Definition: def_const.h:1394
topmost_what_next
ptr_choice_point topmost_what_next()
topmost_what_next
Definition: login.c:2026
succeed
ptr_definition succeed
symbol in bi module
Definition: def_glob.h:389
HEAP
#define HEAP
Flag to indicate heap allocation.
Definition: def_const.h:324
assert_first
long assert_first
Definition: def_glob.h:1032
global_unify
int global_unify(ptr_psi_term u, ptr_psi_term v)
global_unify
Definition: modules.c:1053
push2_ptr_value
void push2_ptr_value(type_ptr t, GENERIC *p, GENERIC v)
push2_ptr_value
Definition: login.c:573
FEATCMP
#define FEATCMP
indicates to use featcmp for comparison (in trees.c)
Definition: def_const.h:979
clear_copy
void clear_copy()
clear_copy
Definition: copy.c:53
heap_pointer
GENERIC heap_pointer
used to allocate from heap - size allocated subtracted - adj for alignment
Definition: def_glob.h:55
def_type
struct wl_definition * def_type
Definition: def_struct.h:60
put_back_char
void put_back_char(long c)
put_back_char
Definition: token.c:729
lf_false
ptr_definition lf_false
symbol in bi module
Definition: def_glob.h:284
integer
ptr_definition integer
symbol in bi module
Definition: def_glob.h:312
main_loop_ok
long main_loop_ok
Definition: def_glob.h:1023
do_residuation_user
long do_residuation_user()
do_residuation_user()
Definition: lefun.c:324
restore_resid
void restore_resid(ptr_resid_block rb, ptr_psi_term *match_date)
restore_resid
Definition: lefun.c:1417
wl_choice_point
Definition: def_struct.h:246
user_module
ptr_module user_module
Default module for user input.
Definition: def_glob.h:694
wl_keyword::combined_name
char * combined_name
Definition: def_struct.h:119
glb
long glb(ptr_definition t1, ptr_definition t2, ptr_definition *t3, ptr_int_list *c3)
glb
Definition: types.c:1481
show_count
void show_count()
show_count
Definition: login.c:1161
goal_stack
ptr_goal goal_stack
Definition: def_glob.h:1025
show_window
#define show_window
To backtrack on show window.
Definition: def_const.h:456
mem_limit
GENERIC mem_limit
starting point of heap - mem_base aligned
Definition: def_glob.h:62
NOTQUIET
#define NOTQUIET
Definition: def_macro.h:15
x_show_subwindow
void x_show_subwindow(Display *display, long window)
x_show_subwindow
Definition: xpred.c:3901
VALID_RANGE
#define VALID_RANGE(A)
Definition: def_macro.h:127
def_ptr
#define def_ptr
values of type_ptr
Definition: def_const.h:404
parse
psi_term parse(long *q)
parse
Definition: parser.c:907
wl_goal
Definition: def_struct.h:237
prompt_buffer
char prompt_buffer[PROMPT_BUFFER]
Definition: def_glob.h:878
new_stat
long new_stat
Definition: def_glob.h:948
TRUEMASK
#define TRUEMASK
Standard boolean.
Definition: def_const.h:282
undo
void undo(ptr_stack limit)
undo
Definition: login.c:691
x_hide_subwindow
void x_hide_subwindow(Display *display, long window)
x_hide_subwindow
Definition: xpred.c:3915
reset_step
void reset_step()
reset_step
Definition: error.c:665
unify_aim
long unify_aim()
unify_aim
Definition: login.c:1344
current_module
ptr_module current_module
The current module for the tokenizer.
Definition: def_glob.h:729
cut
ptr_definition cut
symbol in syntax module
Definition: def_glob.h:242
verbose
long verbose
Definition: def_glob.h:914
wl_pair_list::next
ptr_pair_list next
Definition: def_struct.h:207
push_goal
void push_goal(goals t, ptr_psi_term aaaa_5, ptr_psi_term bbbb_5, GENERIC cccc_5)
push_goal
Definition: login.c:600
two
char * two
Definition: def_glob.h:892
wl_stack::bbbb_3
GENERIC * bbbb_3
Definition: def_struct.h:233
wl_goal::cccc_1
GENERIC cccc_1
Definition: def_struct.h:241
c_rule
long(* c_rule[MAX_BUILT_INS])()
Definition: def_glob.h:888
decode
ptr_int_list decode(ptr_int_list c)
decode
Definition: types.c:1784
redefine
long redefine(ptr_psi_term t)
redefine
Definition: types.c:104
general_cut
#define general_cut
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1114
deref2_rec_eval
void deref2_rec_eval(ptr_psi_term t)
deref2_rec_eval
Definition: lefun.c:1382
fetch_def_lazy
void fetch_def_lazy(ptr_psi_term u, ptr_definition old1, ptr_definition old2, ptr_node old1attr, ptr_node old2attr, long old1stat, long old2stat)
fetch_def_lazy
Definition: login.c:1276
implies_cut
#define implies_cut
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1107
wl_choice_point::undo_point
ptr_stack undo_point
Definition: def_struct.h:248
x_show_window
void x_show_window(Display *display, long window)
x_show_window
Definition: xpred.c:3871
wl_definition::type_def
def_type type_def
Definition: def_struct.h:153
more_u_attr
long more_u_attr
Definition: def_glob.h:944
defs.h
includes
merge_unify
void merge_unify(ptr_node *u, ptr_node v)
merge_unify
Definition: login.c:1146
clean_succ
long clean_succ
Definition: login.c:23
XEVENTDELAY
#define XEVENTDELAY
Maximum number of goals executed between event polling.
Definition: def_const.h:240
predicate_it
#define predicate_it
was enum (def_type) in extern.h now there is typedef ptr_definition
Definition: def_const.h:1401
wl_psi_term
Definition: def_struct.h:177
assert_rule
void assert_rule(psi_term t, def_type typ)
assert_rule
Definition: login.c:257
matches
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
matches
Definition: types.c:1666
wl_stack
Definition: def_struct.h:230
set_empty
#define set_empty
Set constants for deref_args in lefun.c.
Definition: def_const.h:493
file_date
long file_date
Definition: def_glob.h:1034
DEFRULES
#define DEFRULES
Must be different from NULL, a built-in index, and a pointer Used to indicate that the rules of the d...
Definition: def_const.h:302
destroy_window
#define destroy_window
To backtrack on window creation.
Definition: def_const.h:449
CURRENT_MODULE
#define CURRENT_MODULE
feature name
Definition: def_const.h:939
wl_triple_list
Definition: def_struct.h:211
deref2_eval
void deref2_eval(ptr_psi_term t)
deref2_eval
Definition: lefun.c:1356
FACT
#define FACT
Fact Kind of user input.
Definition: def_const.h:338
push_def_ptr_value
void push_def_ptr_value(ptr_psi_term q, GENERIC *p)
push_def_ptr_value
Definition: login.c:416
wl_choice_point::stack_top
GENERIC stack_top
Definition: def_struct.h:251
num_vars
long num_vars(ptr_node vt)
num_vars
Definition: login.c:1976
call_handlersym
ptr_definition call_handlersym
symbol in bi module
Definition: def_glob.h:508
assert_complicated_type
void assert_complicated_type(ptr_psi_term t)
assert_complicated_type
Definition: types.c:405
wl_definition::keyword
ptr_keyword keyword
Definition: def_struct.h:147
wl_pair_list
Definition: def_struct.h:204
main_prove
void main_prove()
main_prove
Definition: login.c:2333
ptr_psi_term
struct wl_psi_term * ptr_psi_term
quotedStackCopy
Definition: def_struct.h:62
wl_node::data
GENERIC data
Definition: def_struct.h:201
cut_ptr
#define cut_ptr
values of type_ptr 22.9
Definition: def_const.h:425
NULL
#define NULL
Definition: def_const.h:533
var_tree
ptr_node var_tree
Definition: def_glob.h:1005
input_state
ptr_psi_term input_state
Definition: def_glob.h:856
steptrace
long steptrace
Definition: def_glob.h:915
REAL
#define REAL
Which C type to use to represent reals and integers in Wild_Life.
Definition: def_const.h:132
type_disj_aim
void type_disj_aim()
type_disj_aim
Definition: login.c:1845
PROMPT
#define PROMPT
Head of prompt.
Definition: def_const.h:218
wl_keyword::symbol
char * symbol
Definition: def_struct.h:118
QUERY
#define QUERY
Query Kind of user input.
Definition: def_const.h:345
wl_choice_point::time_stamp
unsigned long time_stamp
Definition: def_struct.h:247
resid_aim
ptr_goal resid_aim
Definition: def_glob.h:865
wl_choice_point::next
ptr_choice_point next
Definition: def_struct.h:250
merge
void merge(ptr_node *u, ptr_node v)
merge
Definition: login.c:1131
overlap_type
long overlap_type(ptr_definition t1, ptr_definition t2)
overlap_type
Definition: types.c:1579
c_what_next
#define c_what_next
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1163
wl_triple_list::next
ptr_triple_list next
Definition: def_struct.h:215
x_window_creation
long x_window_creation
Definition: def_glob.h:1046
noisy
long noisy
Definition: def_glob.h:1011
wl_triple_list::cccc_4
ptr_definition cccc_4
Definition: def_struct.h:214
and
ptr_definition and
symbol in syntax module
Definition: def_glob.h:171
resid_vars
ptr_resid_list resid_vars
Definition: def_glob.h:866
assert_ok
long assert_ok
Definition: def_glob.h:1033
wl_definition::always_check
char always_check
Definition: def_struct.h:154
abort_life
long abort_life(int nlflag)
abort_life
Definition: built_ins.c:2259
eval
#define eval
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1086
stack_add_psi_attr
void stack_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
stack_add_psi_attr
Definition: token.c:239
sys_bytedata
ptr_definition sys_bytedata
symbol in sys module
Definition: def_glob.h:983
release_resid
void release_resid(ptr_psi_term t)
release_resid
Definition: lefun.c:445
wl_node::left
ptr_node left
Definition: def_struct.h:199
sub_type
long sub_type(ptr_definition t1, ptr_definition t2)
sub_type
Definition: types.c:1642
traceline
void traceline(char *format,...)
traceline
Definition: error.c:186
wl_int_list
Definition: def_struct.h:84
stepcount
long stepcount
Definition: def_glob.h:916
real
ptr_definition real
symbol in bi module
Definition: def_glob.h:375
num_choices
long num_choices()
num_choices
Definition: login.c:1956
type_it
#define type_it
was enum (def_type) in extern.h now there is typedef ptr_definition
Definition: def_const.h:1415
hide_window
#define hide_window
To backtrack on hide window.
Definition: def_const.h:463
undo_stack
ptr_stack undo_stack
Definition: def_glob.h:1027
quote_copy
ptr_psi_term quote_copy(ptr_psi_term t, long heap_flag)
quote_copy
Definition: copy.c:186
Errorline
void Errorline(char *format,...)
Errorline.
Definition: error.c:465
GENERIC
unsigned long * GENERIC
unsigned long *GENERIC
Definition: def_struct.h:35
EOLN
#define EOLN
End of line.
Definition: def_const.h:309
MAX_LEVEL
#define MAX_LEVEL
Maximum indent level.
Definition: def_const.h:232
clause_aim
long clause_aim(long r)
clause_aim
Definition: login.c:1879
end_terminal_io
void end_terminal_io()
end_terminal_io
Definition: token.c:516
goal_count
long goal_count
Definition: def_glob.h:678
x_read_stdin_or_event
long x_read_stdin_or_event(long *ptreventflag)
x_read_stdin_or_event
Definition: xpred.c:3578
push_psi_ptr_value
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
push_psi_ptr_value
Definition: login.c:474
deref_ptr
#define deref_ptr(P)
Definition: def_macro.h:100
infoline
void infoline(char *format,...)
infoline
Definition: error.c:281
wl_goal::type
goals type
Definition: def_struct.h:238
unify_body
long unify_body(long eval_flag)
unify_body
Definition: login.c:1365
trail_condition
long trail_condition(psi_term *Q)
trail_condition
Definition: login.c:2630
wl_stack::type
type_ptr type
Definition: def_struct.h:231
do_currying
void do_currying()
do_currying
Definition: lefun.c:383
goals
long goals
int - formerly enum
Definition: def_struct.h:49
assert_attributes
void assert_attributes(ptr_psi_term t)
assert_attributes
Definition: types.c:500
wl_node::key
char * key
Definition: def_struct.h:198
freeze_cut
#define freeze_cut
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1100
begin_terminal_io
void begin_terminal_io()
begin_terminal_io
Definition: token.c:493
Syntaxerrorline
void Syntaxerrorline(char *format,...)
Syntaxerrorline.
Definition: error.c:557
TRUE
#define TRUE
Standard boolean.
Definition: def_const.h:268
add_rule
void add_rule(ptr_psi_term head, ptr_psi_term body, def_type typ)
add_rule
Definition: login.c:167
v_func
long v_func
Definition: def_glob.h:947
RMASK
#define RMASK
Bit mask for status field of psi-terms: RMASK is used as a flag to avoid infinite loops when tracing ...
Definition: def_const.h:359
clean_trail
static void clean_trail(ptr_choice_point cutpt)
clean_trail
Definition: login.c:810
eof
ptr_definition eof
symbol in syntax module
Definition: def_glob.h:263
merge2
void merge2(ptr_node *u, ptr_node v)
merge2
Definition: login.c:949
what_next
#define what_next
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1079
match
#define match
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1121
wl_definition::rule
ptr_pair_list rule
Definition: def_struct.h:148
u_func
long u_func
Definition: def_glob.h:947
FALSE
#define FALSE
Standard boolean.
Definition: def_const.h:275
deref
#define deref(P)
Definition: def_macro.h:147
unify_aim_noeval
long unify_aim_noeval()
unify_aim_noeval
Definition: login.c:1354
clause
#define clause
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1135
ptr_definition
struct wl_definition * ptr_definition
Definition: def_struct.h:59
stack_psi_term
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
x_hide_window
void x_hide_window(Display *display, long window)
x_hide_window
Definition: xpred.c:3885
input_stream
FILE * input_stream
Definition: def_glob.h:1014
merge3
void merge3(ptr_node *u, ptr_node v)
merge3
Definition: login.c:1004
wl_psi_term::value_3
GENERIC value_3
Definition: def_struct.h:186
ptr_pair_list
struct wl_pair_list * ptr_pair_list
Definition: def_struct.h:64
stepflag
long stepflag
Definition: def_glob.h:676
cut_to
#define cut_to(C)
Definition: def_macro.h:85
wl_pair_list::bbbb_2
ptr_psi_term bbbb_2
Definition: def_struct.h:206
dummy_printf
int dummy_printf(char *f, char *s, char *t)
dummy_printf
Definition: login.c:2617
wl_triple_list::bbbb_4
ptr_psi_term bbbb_4
Definition: def_struct.h:213
fail
#define fail
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1044
aim
ptr_goal aim
Definition: def_glob.h:1024
wl_module::module_name
char * module_name
Definition: def_struct.h:106
wl_psi_term::coref
ptr_psi_term coref
Definition: def_struct.h:188
get_two_args
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
get_two_args
Definition: login.c:47
wl_resid_block
Definition: def_struct.h:261
one
char * one
Definition: def_glob.h:891
retract
#define retract
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1149
equal_types
#define equal_types(A, B)
Definition: def_macro.h:111
STACK_ALLOC
#define STACK_ALLOC(A)
Definition: def_macro.h:21
get_one_arg
void get_one_arg(ptr_node t, ptr_psi_term *a)
get_one_arg
Definition: login.c:99
unify
#define unify
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1058
wl_stack::aaaa_3
GENERIC * aaaa_3
Definition: def_struct.h:232
find
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
xeventdelay
long xeventdelay
Definition: def_glob.h:941
eval_aim
long eval_aim()
eval_aim
Definition: lefun.c:497
stack_copy_psi_term
ptr_psi_term stack_copy_psi_term(psi_term t)
stack_copy_psi_term
Definition: parser.c:205
featcmp
long featcmp(char *str1, char *str2)
featcmp
Definition: trees.c:106
wl_psi_term::status
long status
Definition: def_struct.h:182
restore_state
void restore_state(ptr_psi_term t)
restore_state
Definition: token.c:334
undo_actions
void undo_actions()
undo_actions
Definition: login.c:736
load
#define load
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1156
wl_psi_term::flags
long flags
Definition: def_struct.h:185
wl_definition
Definition: def_struct.h:145
prove_aim
long prove_aim()
prove_aim
Definition: login.c:1645
can_curry
long can_curry
Definition: def_glob.h:869
push_ptr_value_global
void push_ptr_value_global(type_ptr t, GENERIC *p)
push_ptr_value_global
Definition: login.c:523
unify_noeval
#define unify_noeval
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1065
encode_types
void encode_types()
encode_types
Definition: types.c:1091
wl_choice_point::goal_stack
ptr_goal goal_stack
Definition: def_struct.h:249
i_eval_args
long i_eval_args(ptr_node n)
i_eval_args
Definition: lefun.c:874
curried
long curried
Definition: def_glob.h:868
del_clause
#define del_clause
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1142
eval_cut
#define eval_cut
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1093
deref_args
#define deref_args(P, S)
Definition: def_macro.h:150
wl_definition::protected
char protected
Definition: def_struct.h:155
disjunct_aim
long disjunct_aim()
disjunct_aim
Definition: login.c:1621
start_chrono
void start_chrono()
start_chrono
Definition: login.c:349
handle_interrupt
void handle_interrupt()
HANDLE_INTERRUPT.
Definition: interrupt.c:52
save_state
void save_state(ptr_psi_term t)
save_state
Definition: token.c:293
prompt
char * prompt
Definition: def_glob.h:1018
stack_info
void stack_info(FILE *outfile)
stack_info
Definition: error.c:77
undo_action
#define undo_action
Fast checking for an undo action.
Definition: def_const.h:484
backtrack
void backtrack()
backtrack
Definition: login.c:772
print_variables
long print_variables(long printflag)
print_variables
Definition: print.c:1368
GC_THRESHOLD
#define GC_THRESHOLD
Garbage collection threshold (1/8 of MEM_SIZE is reasonable).
Definition: def_const.h:117
read_char
long read_char()
read_char
Definition: token.c:680
end_time
struct tms start_time end_time
Definition: def_glob.h:939
global_time_stamp
unsigned long global_time_stamp
Definition: login.c:28
INIT_TIME_STAMP
#define INIT_TIME_STAMP
Definition: def_const.h:375
clean_iter
long clean_iter
Definition: login.c:22
disj
#define disj
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1072
mem_base
GENERIC mem_base
mem_size memory allocated in init_memory by malloc
Definition: def_glob.h:48
MAX_BUILT_INS
#define MAX_BUILT_INS
Maximum number of built_ins.
Definition: def_const.h:154
equ_tok
#define equ_tok(A, B)
Definition: def_macro.h:67
get_attr
GENERIC get_attr(ptr_psi_term t, char *attrname)
get_attr
Definition: token.c:265
eval_copy
ptr_psi_term eval_copy(ptr_psi_term t, long heap_flag)
eval_copy
Definition: copy.c:196
type_ptr
long type_ptr
Used to identify the object on the undo_stack.
Definition: def_struct.h:12
type_disj
#define type_disj
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1128
interrupted
long interrupted
used in handling user using ctrl-c
Definition: def_glob.h:672
warningline
void warningline(char *format,...)
warningline
Definition: error.c:371
clean_undo_window
void clean_undo_window(long disp, long wind)
clean_undo_window
Definition: login.c:848
find_module
ptr_module find_module(char *module)
find_module
Definition: modules.c:54
lf_true
ptr_definition lf_true
symbol in bi module
Definition: def_glob.h:410
wl_node
Definition: def_struct.h:197
no_choices
long no_choices()
no_choices
Definition: login.c:1945
wl_psi_term::type
ptr_definition type
Definition: def_struct.h:181
memory_check
long memory_check()
memory_check
Definition: memory.c:1723
aborthooksym
ptr_definition aborthooksym
symbol in bi module
Definition: def_glob.h:133
wl_int_list::value_1
GENERIC value_1
Definition: def_struct.h:85
wl_goal::bbbb_1
ptr_psi_term bbbb_1
Definition: def_struct.h:240
stdin_cleareof
void stdin_cleareof()
stdin_cleareof
Definition: token.c:51
xevent_existing
ptr_psi_term xevent_existing
Definition: def_glob.h:1037
xcount
long xcount
Definition: def_glob.h:942
boolpredsym
ptr_definition boolpredsym
symbol in bi module
Definition: def_glob.h:192
match_aim
long match_aim()
match_aim
Definition: lefun.c:770
wl_definition::properties
ptr_triple_list properties
Definition: def_struct.h:149
fetch_def
void fetch_def(ptr_psi_term u, long allflag)
fetch_def
Definition: login.c:1208
QUOTED_TRUE
#define QUOTED_TRUE
True flags for the flags field of psi-terms.
Definition: def_const.h:254
HEAP_ALLOC
#define HEAP_ALLOC(A)
Definition: def_macro.h:20
var_occurred
long var_occurred
???
Definition: def_glob.h:839
SMASK
#define SMASK
Bit mask for status field of psi-terms: SMASK masks off the status bits. These are used in the 'mark'...
Definition: def_const.h:367
wl_stack::next
ptr_stack next
Definition: def_struct.h:234
wl_psi_term::attr_list
ptr_node attr_list
Definition: def_struct.h:187
open_input_file
long open_input_file(char *file)
open_input_file
Definition: token.c:594
push_ptr_value
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
wl_goal::pending
ptr_definition pending
Definition: def_struct.h:243
set_current_module
ptr_module set_current_module(ptr_module module)
set_current_module
Definition: modules.c:100
wl_triple_list::aaaa_4
ptr_psi_term aaaa_4
Definition: def_struct.h:212
quoted_string
ptr_definition quoted_string
symbol in bi module
Definition: def_glob.h:368
i_check_out
long i_check_out(ptr_psi_term t)
i_check_out
Definition: lefun.c:1033
push_choice_point
void push_choice_point(goals t, ptr_psi_term aaaa_6, ptr_psi_term bbbb_6, GENERIC cccc_6)
push_choice_point
Definition: login.c:638
choice_stack
ptr_choice_point choice_stack
Definition: def_glob.h:1026
STACK
#define STACK
Flag to indicate stack allocation.
Definition: def_const.h:331
assert
#define assert(N)
Definition: memory.c:114
x_destroy_window
void x_destroy_window(Display *display, Window window)
x_destroy_window
Definition: xpred.c:3852
more_v_attr
long more_v_attr
Definition: def_glob.h:945
wl_node::right
ptr_node right
Definition: def_struct.h:200
tracesym
ptr_definition tracesym
symbol in bi module
Definition: def_glob.h:424
merge1
void merge1(ptr_node *u, ptr_node v)
merge1
Definition: login.c:893
what_next_aim
long what_next_aim()
what_next_aim
Definition: login.c:2068
life_or
ptr_definition life_or
symbol in syntax module
Definition: def_glob.h:326
wl_goal::next
ptr_goal next
Definition: def_struct.h:242
psi_term_ptr
#define psi_term_ptr
values of type_ptr
Definition: def_const.h:383
wl_int_list::next
ptr_int_list next
Definition: def_struct.h:86
int_ptr
#define int_ptr
values of type_ptr
Definition: def_const.h:397