Wild Life: modules.c Source File

Wild Life 2.30

- Main Page
- Data Structures
- Files

- File List
- Globals

All Data Structures Files Functions Variables Typedefs Macros
modules.c
Go to the documentation of this file.
1
10 /******************************** MODULES ************************************/
11
12 #include "defs.h"
13
14 ptr_node module_table=NULL; /* The table of modules */
15 ptr_module current_module=NULL; /* The current module for the tokenizer */
16 ptr_module no_module=NULL;
17 ptr_module bi_module=NULL;
18 ptr_module syntax_module=NULL;
19 ptr_module sys_module=NULL;
20
21 // set NULL next 2 DJD
22 ptr_module user_module=NULL;
23 ptr_module x_module= NULL;
24
25 long display_modules=TRUE; /* Should really default to FALSE */
26
34 void init_modules()
35 {
36 bi_module=create_module("built_ins");
37 no_module=create_module("no_module");
38 x_module=create_module("x");
39 syntax_module=create_module("syntax");
40 user_module=create_module("user"); /* RM: Jan 27 1993 */
41 sys_module=create_module("sys");
42
43 (void)set_current_module(syntax_module);
44 }
45
54 ptr_module find_module(char *module)
55 {
56 ptr_node nodule;
57
58 nodule=find(FEATCMP,(char *)module,module_table);
59 if(nodule)
60 return (ptr_module)(nodule->data);
61 else
62 return NULL;
63 }
64
72 ptr_module create_module(char *module)
73 {
74 ptr_module new;
75
76
77 new=find_module(module);
78 if(!new) {
79 new=HEAP_ALLOC(struct wl_module);
80 new->module_name=(char *)heap_copy_string(module);
81 new->source_file=(char *)heap_copy_string(input_file_name);
82 new->open_modules=NULL;
83 new->inherited_modules=NULL;
84 new->symbol_table=hash_create(16); /* RM: Feb 3 1993 */
85
86 (void)heap_insert(STRCMP,new->module_name,&module_table,(GENERIC)new);
87
88 }
89 return new;
90 }
91
100 ptr_module set_current_module(ptr_module module)
101 {
102 current_module=module;
103 /* printf("*** Current module: '%s'\n",current_module->module_name); */
104 return current_module;
105 }
106
116 ptr_module extract_module_from_name(char *str)
117 {
118 char *s;
119 ptr_module result=NULL;
120
121 s=str;
122 while(legal_in_name(*s))
123 s++;
124 if(s!=str && *s=='#' /* && *(s+1)!=0 */) {
125 *s=0;
126 result=create_module(str);
127 *s='#';
128 /*
129 printf("Extracted module name '%s' from '%s'\n",result->module_name,str);
130 */
131 }
132
133 return result;
134 }
135
144 char *strip_module_name(char *str)
145 {
146 char *s=str;
147
148 while(legal_in_name(*s))
149 s++;
150 if(s!=str && *s=='#' /* && *(s+1)!=0 */) {
151 s++;
152 /* printf("Stripped module from '%s' yielding '%s'\n",str,s); */
153 return s;
154 }
155 else
156 return str;
157 }
158
169 char *string_val(ptr_psi_term term)
170 {
171 deref_ptr(term);
172 if(term->value_3 && term->type==quoted_string)
173 return (char *)term->value_3;
174 else
175 return term->type->keyword->symbol;
176 }
177
191 char *make_module_token(ptr_module module,char *str)
192 {
193 ptr_module explicit;
194
195
196 /* Check if the string already contains a module */
197 explicit=extract_module_from_name(str);
198 if(explicit)
199 strcpy(module_buffer,str);
200 else
201 if(module!=no_module) {
202 strcpy(module_buffer,module->module_name);
203 strcat(module_buffer,"#");
204 strcat(module_buffer,str);
205 }
206 else
207 strcpy(module_buffer,str);
208
209 return module_buffer;
210 }
211
220 ptr_definition new_definition(ptr_keyword key) /* RM: Feb 22 1993 */
221 {
222 ptr_definition result;
223
224
225 /* printf("*** New definition: %s\n",key->combined_name); */
226
227 /* Create a new definition */
228 result=HEAP_ALLOC(struct wl_definition);
229
230 /* RM: Feb 3 1993 */
231 result->next=first_definition; /* Linked list of all definitions */
232 first_definition=result;
233
234 result->keyword=key;
235 result->rule=NULL;
236 result->properties=NULL;
237 result->date=0;
238 result->type_def=(def_type)undef_it;
239 result->always_check=TRUE;
240 result->protected=TRUE;
241 result->evaluate_args=TRUE;
242 result->already_loaded=FALSE;
243 result->children=NULL;
244 result->parents=NULL;
245 result->code=NOT_CODED;
246 result->op_data=NULL;
247 result->global_value=NULL; /* RM: Feb 8 1993 */
248 result->init_value=NULL; /* RM: Mar 23 1993 */
249 key->definition=result;
250
251 return result;
252 }
253
270 ptr_definition update_symbol(ptr_module module,char *symbol) /* RM: Jan 8 1993 */
271 {
272 ptr_keyword key;
273 ptr_definition result=NULL;
274 ptr_int_list opens;
275 ptr_module opened;
276 ptr_keyword openkey;
277 ptr_keyword tempkey;
278
279 /* First clean up the arguments and find out which module to use */
280
281 if(!module) {
282 module=extract_module_from_name(symbol);
283 if(!module)
284 module=current_module;
285 symbol=strip_module_name(symbol);
286 }
287
288 /* printf("looking up %s#%s\n",module->module_name,symbol); */
289
290 /* Now look up 'module#symbol' in the symbol table */
291 key=hash_lookup(module->symbol_table,symbol);
292
293 if(key)
294 if(key->public || module==current_module)
295 result=key->definition;
296 else {
297 Errorline("qualified call to private symbol '%s'\n",
298 key->combined_name);
299
300 result=error_psi_term->type;
301 }
302 else
303 if(module!=current_module) {
304 Errorline("qualified call to undefined symbol '%s#%s'\n",
305 module->module_name,symbol);
306 result=error_psi_term->type;
307 }
308 else
309 {
310 /* Add 'module#symbol' to the symbol table */
311 key=HEAP_ALLOC(struct wl_keyword);
312 key->module=module;
313 key->symbol=(char *)heap_copy_string(symbol);
314 key->combined_name=heap_copy_string(make_module_token(module,symbol));
315 key->public=FALSE;
316 key->private_feature=FALSE; /* RM: Mar 11 1993 */
317 key->definition=NULL;
318
319 hash_insert(module->symbol_table,key->symbol,key);
320
321
322 /* Search the open modules of 'module' for 'symbol' */
323 opens=module->open_modules;
324 openkey=NULL;
325 while(opens) {
326 opened=(ptr_module)(opens->value_1);
327 if(opened!=module) {
328
329 tempkey=hash_lookup(opened->symbol_table,symbol);
330
331 if(tempkey)
332 if(openkey && openkey->public && tempkey->public) {
333 if(openkey->definition==tempkey->definition) {
334 warningline("benign module name clash: %s and %s\n",
335 openkey->combined_name,
336 tempkey->combined_name);
337 }
338 else {
339 Errorline("serious module name clash: \"%s\" and \"%s\"\n",
340 openkey->combined_name,
341 tempkey->combined_name);
342
343 result=error_psi_term->type;
344 }
345 }
346 else
347 if(!openkey || !openkey->public)
348 openkey=tempkey;
349 }
350
351 opens=opens->next;
352 }
353
354 if(!result) { /* RM: Feb 1 1993 */
355
356 if(openkey && openkey->public) {
357 /* Found the symbol in an open module */
358
359 if(!openkey->public)
360 warningline("implicit reference to non-public symbol: %s\n",
361 openkey->combined_name);
362
363 result=openkey->definition;
364 key->definition=result;
365
366 /*
367 printf("*** Aliasing %s#%s to %s#%s\n",
368 key->module->module_name,
369 key->symbol,
370 openkey->module->module_name,
371 openkey->symbol);
372 */
373
374 }
375 else { /* Didn't find it */
376 result=new_definition(key);
377 }
378 }
379 }
380
381 return result;
382 }
383
384 /*
385
386 ******* GET_FUNCTION_VALUE(module,symbol)
387 Return the value of a function without arguments. This returns a psi-term on
388 the heap which may not be bound etc...
389
390 This routine allows C variables to be stored as LIFE functions.
391 */
392
435 char *print_symbol(ptr_keyword k)
436 {
437 k=k->definition->keyword;
438 if(display_modules)
439 return k->combined_name;
440 else
441 return k->symbol;
442 }
443
452 void pretty_symbol(ptr_keyword k)
453 {
454 k=k->definition->keyword;
455 if(display_modules) {
456 prettyf(k->module->module_name);
457 prettyf("#");
458 }
459 prettyf(k->symbol);
460 }
461
470 void pretty_quote_symbol(ptr_keyword k)
471 {
472 k=k->definition->keyword;
473 if(display_modules) {
474 prettyf(k->module->module_name);
475 prettyf("#");
476 }
477 prettyf_quote(k->symbol);
478 }
479
488 long c_set_module()
489 {
490 ptr_psi_term arg1,arg2;
491 ptr_psi_term call;
492
493 call=aim->aaaa_1;
494 deref_ptr(call);
495 get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
496
497 if(arg1) {
498 (void)set_current_module(create_module(string_val(arg1)));
499 return TRUE;
500 }
501 else {
502 Errorline("argument missing in '%P'\n",call);
503 return FALSE;
504 }
505 }
506
519 long c_open_module()
520 {
521 ptr_psi_term call;
522 int onefailed=FALSE;
523 call=aim->aaaa_1;
524 deref_ptr(call);
525 if (call->attr_list) {
526 open_module_tree(call->attr_list, &onefailed);
527 }
528 else {
529 Errorline("argument missing in '%P'\n",call);
530 }
531
532 return !onefailed;
533 }
534
542 void open_module_tree(ptr_node n, int *onefailed)
543 {
544 if (n) {
545 ptr_psi_term t;
546 open_module_tree(n->left,onefailed);
547
548 t=(ptr_psi_term)n->data;
549 open_module_one(t,onefailed);
550
551 open_module_tree(n->right,onefailed);
552 }
553 }
554
562 void open_module_one(ptr_psi_term t, int *onefailed)
563 {
564 ptr_module open_module;
565 ptr_int_list opens;
566 ptr_keyword key1,key2;
567 int i;
568 int found=FALSE;
569
570 open_module=find_module(string_val(t));
571 if (open_module) {
572
573 for (opens=current_module->open_modules;opens;opens=opens->next)
574 if (opens->value_1 == (GENERIC)open_module) {
575 /* warningline("module \"%s\" is already open\n",
576 open_module->module_name); */ /* RM: Jan 27 1993 */
577 found=TRUE;
578 }
579
580 if (!found) {
581 opens=HEAP_ALLOC(struct wl_int_list);
582 opens->value_1=(GENERIC)open_module;
583 opens->next=current_module->open_modules;
584 current_module->open_modules=opens;
585
586 /* Check for name conflicts */
587 /* RM: Feb 23 1993 */
588 for (i=0;i<open_module->symbol_table->size;i++)
589 if ((key1=open_module->symbol_table->data[i]) && key1->public) {
590 key2=hash_lookup(current_module->symbol_table,key1->symbol);
591 if (key2 && key1->definition!=key2->definition)
592 Errorline("symbol clash '%s' and '%s'\n",
593 key1->combined_name,
594 key2->combined_name);
595 }
596 }
597 }
598 else {
599 Errorline("module \"%s\" not found\n",string_val(t));
600 *onefailed=TRUE;
601 }
602 }
603
613 long make_public(ptr_psi_term term,long bool) /* RM: Feb 22 1993 Modified */
614 {
615 int ok=TRUE;
616 ptr_keyword key;
617 ptr_definition def;
618
619 deref_ptr(term);
620
621 key=hash_lookup(current_module->symbol_table,term->type->keyword->symbol);
622 if(key) {
623
624 if(key->definition->keyword->module!=current_module && !bool) {
625 warningline("local definition of '%s' overrides '%s'\n",
626 key->definition->keyword->symbol,
627 key->definition->keyword->combined_name);
628
629 (void)new_definition(key);
630 }
631
632 key->public=bool;
633 }
634 else {
635 def=update_symbol(current_module,term->type->keyword->symbol);
636 def->keyword->public=bool;
637 }
638
639 return ok;
640 }
641
642
643 #define MAKE_PUBLIC 1
644 #define MAKE_PRIVATE 2
645 #define MAKE_FEATURE_PRIVATE 3
646
656 void traverse_tree(ptr_node n,int flag)
657 {
658 if (n) {
659 ptr_psi_term t;
660 traverse_tree(n->left,flag);
661
662 t=(ptr_psi_term)n->data;
663 deref_ptr(t);
664 switch (flag) {
665 case MAKE_PUBLIC:
666 (void)make_public(t,TRUE);
667 break;
668 case MAKE_PRIVATE:
669 (void)make_public(t,FALSE);
670 break;
671 case MAKE_FEATURE_PRIVATE:
672 (void)make_feature_private(t);
673 break;
674 }
675 traverse_tree(n->right,flag);
676 }
677 }
678
687 long c_public()
688 {
689 // ptr_psi_term arg1,arg2;
690 ptr_psi_term call;
691 int success;
692
693 call=aim->aaaa_1;
694 deref_ptr(call);
695 if (call->attr_list) {
696 traverse_tree(call->attr_list,MAKE_PUBLIC);
697 success=TRUE;
698 } else {
699 Errorline("argument missing in '%P'\n",call);
700 success=FALSE;
701 }
702
703 return success;
704 }
705
714 long c_private()
715 {
716 ptr_psi_term call;
717 int success;
718
719 call=aim->aaaa_1;
720 deref_ptr(call);
721 if (call->attr_list) {
722 traverse_tree(call->attr_list,MAKE_PRIVATE);
723 success=TRUE;
724 } else {
725 Errorline("argument missing in '%P'\n",call);
726 success=FALSE;
727 }
728
729 return success;
730 }
731
739 long c_display_modules()
740 {
741 ptr_psi_term arg1,arg2;
742 ptr_psi_term call;
743 int success=TRUE;
744
745
746 call=aim->aaaa_1;
747 deref_ptr(call);
748 get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
749
750 if(arg1) {
751 deref_ptr(arg1);
752 if(arg1->type==lf_true)
753 display_modules=TRUE;
754 else
755 if(arg1->type==lf_false)
756 display_modules=FALSE;
757 else {
758 Errorline("argument should be boolean in '%P'\n",call);
759 success=FALSE;
760 }
761 }
762 else /* No argument: toggle */
763 display_modules= !display_modules;
764
765 return success;
766 }
767
775 long c_display_persistent() /* RM: Feb 12 1993 */
776 {
777 ptr_psi_term arg1,arg2;
778 ptr_psi_term call;
779 int success=TRUE;
780
781 call=aim->aaaa_1;
782 deref_ptr(call);
783 get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
784
785 if(arg1) {
786 deref_ptr(arg1);
787 if(arg1->type==lf_true)
788 display_persistent=TRUE;
789 else
790 if(arg1->type==lf_false)
791 display_persistent=FALSE;
792 else {
793 Errorline("argument should be boolean in '%P'\n",call);
794 success=FALSE;
795 }
796 }
797 else /* No argument: toggle */
798 display_persistent= !display_persistent;
799
800 return success;
801 }
802
810 long c_trace_input()
811 {
812 ptr_psi_term arg1,arg2;
813 ptr_psi_term call;
814 int success=TRUE;
815
816 call=aim->aaaa_1;
817 deref_ptr(call);
818 get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
819
820 if(arg1) {
821 deref_ptr(arg1);
822 if(arg1->type==lf_true)
823 trace_input=TRUE;
824 else
825 if(arg1->type==lf_false)
826 trace_input=FALSE;
827 else {
828 Errorline("argument should be boolean in '%P'\n",call);
829 success=FALSE;
830 }
831 }
832 else /* No argument: toggle */
833 trace_input= !trace_input;
834
835 return success;
836 }
837
838 void rec_replace(ptr_definition,ptr_definition,ptr_psi_term);
839 void replace_attr(ptr_node,ptr_psi_term,ptr_definition,ptr_definition );
840
851 void replace(ptr_definition old,ptr_definition new,ptr_psi_term term)
852 {
853 clear_copy();
854 rec_replace(old,new,term);
855 }
856
865 void rec_replace(ptr_definition old,ptr_definition new,ptr_psi_term term)
866 {
867 ptr_psi_term done;
868 long *info; // some trouble w this - don't see
869 ptr_node old_attr;
870
871 deref_ptr(term);
872 done=translate(term,&info);
873 if(!done) {
874 insert_translation(term,term,0);
875
876 if(term->type==old && !term->value_3) {
877 push_ptr_value(def_ptr,(GENERIC *)&(term->type));
878 term->type=new;
879 }
880 old_attr=term->attr_list;
881 if(old_attr) {
882 push_ptr_value(int_ptr,(GENERIC *)&(term->attr_list));
883 term->attr_list=NULL;
884 replace_attr(old_attr,term,old,new);
885 }
886 }
887 }
888
898 void replace_attr(ptr_node old_attr,ptr_psi_term term,ptr_definition old,ptr_definition new)
899 {
900 ptr_psi_term value;
901 char *oldlabel; /* RM: Mar 12 1993 */
902 char *newlabel;
903
904 if(old_attr->left)
905 replace_attr(old_attr->left,term,old,new);
906
907 value=(ptr_psi_term)old_attr->data;
908 rec_replace(old,new,value);
909
910 if(old->keyword->private_feature) /* RM: Mar 12 1993 */
911 oldlabel=old->keyword->combined_name;
912 else
913 oldlabel=old->keyword->symbol;
914
915 if(new->keyword->private_feature) /* RM: Mar 12 1993 */
916 newlabel=new->keyword->combined_name;
917 else
918 newlabel=new->keyword->symbol;
919
920 if(!strcmp(old_attr->key,oldlabel))
921 (void)stack_insert(FEATCMP,newlabel,&(term->attr_list),(GENERIC)value);
922 else
923 (void)stack_insert(FEATCMP,old_attr->key,&(term->attr_list),(GENERIC)value);
924
925 if(old_attr->right)
926 replace_attr(old_attr->right,term,old,new);
927 }
928
936 long c_replace()
937 {
938 ptr_psi_term arg1=NULL;
939 ptr_psi_term arg2=NULL;
940 ptr_psi_term arg3=NULL;
941 ptr_psi_term call;
942 int success=FALSE;
943 ptr_node n;
944
945 call=aim->aaaa_1;
946 deref_ptr(call);
947
948 get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
949 n=find(FEATCMP,three,call->attr_list);
950 if (n)
951 arg3=(ptr_psi_term)n->data;
952
953 if(arg1 && arg2 && arg3) {
954 deref_ptr(arg1);
955 deref_ptr(arg2);
956 deref_ptr(arg3);
957 replace(arg1->type,arg2->type,arg3);
958 success=TRUE;
959 }
960 else {
961 Errorline("argument missing in '%P'\n",call);
962 }
963
964 return success;
965 }
966
974 long c_current_module()
975 {
976 long success=TRUE;
977 ptr_psi_term result,g,other;
978
979 g=aim->aaaa_1;
980 deref_ptr(g);
981 result=aim->bbbb_1;
982 deref_ptr(result);
983
984 other=stack_psi_term(4);
985 /* PVR 24.1.94 */
986 other->type=quoted_string;
987 other->value_3=(GENERIC)heap_copy_string(current_module->module_name);
988 /*
989 update_symbol(current_module,
990 current_module->module_name)
991 ->keyword->symbol
992 );
993 */ /* RM: 2/15/1994 */
994 /* other->type=update_symbol(current_module,current_module->module_name); */
995 resid_aim=NULL;
996 push_goal(unify,result,other,NULL);
997
998 return success;
999 }
1000
1008 long c_module_access()
1009 {
1010 long success=FALSE;
1011 // ptr_psi_term result,module,symbol,call,other;
1012 ptr_psi_term call;
1013
1014
1015 call=aim->aaaa_1;
1016 deref_ptr(call);
1017
1018 /*
1019 result=aim->bbbb_1;
1020 deref_ptr(result);
1021 get_two_args(call,(ptr_psi_term *)&module,(ptr_psi_term *)&symbol);
1022
1023 if(module && symbol) {
1024 other=stack_psi_term(4);
1025 other->type=update_symbol(module_access,module_access->module_name);
1026 resid_aim=NULL;
1027 push_goal(unify,result,other,NULL);
1028
1029 }
1030 */
1031
1032 warningline("%P not implemented yet...\n",call);
1033
1034 return success;
1035 }
1036
1037 int global_unify_attr(ptr_node,ptr_node); /* RM: Feb 9 1993 */
1038
1039
1053 int global_unify(ptr_psi_term u,ptr_psi_term v) /* RM: Feb 11 1993 */
1054 {
1055 int success=TRUE;
1056 int compare;
1057 ptr_definition new_type;
1058 ptr_int_list new_code;
1059
1060 deref_ptr(u);
1061 deref_ptr(v);
1062
1063 traceline("match persistent %P with %P\n",u,v);
1064
1065 /* printf("u=%ld, v=%ld, heap_pointer=%ld\n",u,v,heap_pointer);*/
1066
1067 /* printf("u=%s, v=%s\n",
1068 u->type->keyword->symbol,
1069 v->type->keyword->symbol); */
1070
1071 if((GENERIC)u>=heap_pointer) {
1072 Errorline("cannot unify persistent values\n");
1073 return c_abort();
1074 }
1075
1076 /**** U is on the stack, V is on the heap ****/
1077
1078 /**** Calculate their Greatest Lower Bound and compare them ****/
1079 compare=glb(u->type,v->type,&new_type,&new_code);
1080
1081 /* printf("compare=%d\n",compare); */
1082
1083 if (compare==1 || compare==3) { /* Match only */
1084
1085 /**** Check for values ****/
1086 if(v->value_3) {
1087 if(u->value_3) {
1088 if(u->value_3!=v->value_3) { /* One never knows */
1089 if (overlap_type(v->type,real))
1090 success=(*((REAL *)u->value_3)==(*((REAL *)v->value_3)));
1091 else if (overlap_type(v->type,quoted_string))
1092 success=(strcmp((char *)u->value_3,(char *)v->value_3)==0);
1093 else
1094 return FALSE; /* Don't unify CUTs and STREAMs and things */
1095 }
1096 }
1097 }
1098 else
1099 if(u->value_3)
1100 return FALSE;
1101
1102 if(success) {
1103 /**** Bind the two psi-terms ****/
1104 push_psi_ptr_value(u,(GENERIC *)&(u->coref));
1105 u->coref=v;
1106
1107 /**** Match the attributes ****/
1108 success=global_unify_attr(u->attr_list,v->attr_list);
1109
1110 /*
1111 if(!success)
1112 warningline("attributes don't unify in %P and %P\n",u,v);
1113 */
1114
1115 if(success && u->resid)
1116 release_resid(u);
1117 }
1118 }
1119 else
1120 success=FALSE;
1121
1122 return success;
1123 }
1124
1135 int global_unify_attr(ptr_node u,ptr_node v) /* RM: Feb 9 1993 */
1136 {
1137 int success=TRUE;
1138 ptr_node temp;
1139 long cmp;
1140
1141 if(u)
1142 if(v) {
1143 /* RM: Feb 16 1993 Avoid C optimiser bug */
1144 (void)dummy_printf("%s %s\n",u->key,v->key);
1145
1146 cmp=featcmp(u->key,v->key);
1147 if(cmp<0) {
1148 temp=u->right;
1149 u->right=NULL;
1150 success=global_unify_attr(u,v->left) && global_unify_attr(temp,v);
1151 u->right=temp;
1152 }
1153 else
1154 if(cmp>0) {
1155 temp=u->left;
1156 u->left=NULL;
1157 success=global_unify_attr(u,v->right) && global_unify_attr(temp,v);
1158 u->left=temp;
1159 }
1160 else {
1161 success=
1162 global_unify_attr(u->left,v->left) &&
1163 global_unify_attr(u->right,v->right) &&
1164 global_unify((ptr_psi_term)u->data,(ptr_psi_term)v->data);
1165 }
1166 }
1167 else
1168 success=FALSE;
1169
1170 return success;
1171 }
1172
1180 long c_alias()
1181 {
1182 long success=TRUE;
1183 ptr_psi_term arg1,arg2,g;
1184 ptr_keyword key;
1185
1186 g=aim->aaaa_1;
1187
1188 deref_ptr(g);
1189 get_two_args(g->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
1190 if (arg1 && arg2) {
1191 deref_ptr(arg1);
1192 deref_ptr(arg2);
1193
1194 key=hash_lookup(current_module->symbol_table,arg1->type->keyword->symbol);
1195 if(key) {
1196 if(key->definition!=arg2->type) {
1197 warningline("alias: '%s' has now been overwritten by '%s'\n",
1198 key->combined_name,
1199 arg2->type->keyword->combined_name);
1200
1201 key->definition=arg2->type;
1202 }
1203 }
1204 else
1205 Errorline("module violation: cannot alias '%s' from module \"%s\"\n",
1206 key->combined_name,
1207 current_module->module_name);
1208 }
1209 else {
1210 success=FALSE;
1211 Errorline("argument(s) missing in '%P'\n",g);
1212 }
1213
1214 return success;
1215 }
1216
1226 int get_module(ptr_psi_term psi,ptr_module *module)
1227 {
1228 int success=TRUE;
1229 char *s;
1230
1231 *module=NULL;
1232
1233 deref_ptr(psi);
1234 if(overlap_type(psi->type,quoted_string) && psi->value_3)
1235 s=(char *)psi->value_3;
1236 else
1237 s=psi->type->keyword->symbol;
1238
1239 *module=find_module(s);
1240 if(!(*module)) {
1241 Errorline("undefined module \"%s\"\n",s);
1242 success=FALSE;
1243 }
1244
1245 return success;
1246 }
1247
1256 int make_feature_private(ptr_psi_term term) /* RM: Mar 11 1993 */
1257 {
1258 int ok=TRUE;
1259 ptr_keyword key;
1260 ptr_definition def;
1261
1262 deref_ptr(term);
1263
1264 key=hash_lookup(current_module->symbol_table,term->type->keyword->symbol);
1265
1266 if(key) {
1267 /*
1268 if(key->definition->keyword->module!=current_module) {
1269 warningline("local definition of '%s' overrides '%s'\n",
1270 key->definition->keyword->symbol,
1271 key->definition->keyword->combined_name);
1272
1273 new_definition(key);
1274 }
1275 */
1276
1277 key->private_feature=TRUE;
1278 def=key->definition;
1279 }
1280 else {
1281 def=update_symbol(current_module,term->type->keyword->symbol);
1282 def->keyword->private_feature=TRUE;
1283 }
1284
1285
1286 if(ok && def->keyword->public) {
1287 warningline("feature '%s' is now private, but was also declared public\n",
1288 def->keyword->combined_name);
1289 }
1290
1291 return ok;
1292 }
1293
1302 long c_private_feature() /* RM: Mar 11 1993 */
1303 {
1304 // ptr_psi_term arg1,arg2;
1305 ptr_psi_term call;
1306 int success;
1307
1308 call=aim->aaaa_1;
1309 deref_ptr(call);
1310 if (call->attr_list) {
1311 traverse_tree(call->attr_list,MAKE_FEATURE_PRIVATE);
1312 success=TRUE;
1313 } else {
1314 Errorline("argument missing in '%P'\n",call);
1315 success=FALSE;
1316 }
1317
1318 return success;
1319 }
1320
1331 ptr_definition update_feature(ptr_module module,char *feature)
1332 {
1333 ptr_keyword key;
1334 ptr_module explicit;
1335
1336 /* Check if the feature already contains a module name */
1337
1338 if(!module)
1339 module=current_module;
1340
1341 explicit=extract_module_from_name(feature);
1342 if(explicit)
1343 if(explicit!=module)
1344 return NULL; /* Feature isn't visible */
1345 else
1346 return update_symbol(NULL,feature);
1347
1348 /* Now we have a simple feature to look up */
1349 key=hash_lookup(module->symbol_table,feature);
1350 if(key && key->private_feature)
1351 return key->definition;
1352 else
1353 return update_symbol(module,feature);
1354 }
1355
1363 long all_public_symbols()
1364 {
1365 ptr_psi_term arg1,arg2,funct,result;
1366 ptr_psi_term list;
1367 ptr_psi_term car;
1368 ptr_module module=NULL;
1369 ptr_definition d;
1370
1371 funct=aim->aaaa_1;
1372 deref_ptr(funct);
1373 result=aim->bbbb_1;
1374 get_two_args(funct->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
1375
1376 if(arg1) {
1377 deref_ptr(arg1);
1378 (void)get_module(arg1,&module);
1379 }
1380 else
1381 module=NULL;
1382
1383 list=stack_nil();
1384
1385 for(d=first_definition;d;d=d->next)
1386 if(d->keyword->public && (!module || d->keyword->module==module)) {
1387 car=stack_psi_term(4);
1388 car->type=d;
1389 list=stack_cons(car,list);
1390 }
1391
1392 push_goal(unify,result,list,NULL);
1393
1394 return TRUE;
1395 }
init_modules
void init_modules()
init_modules
Definition: modules.c:34
module_table
ptr_node module_table
Definition: modules.c:14
wl_goal::aaaa_1
ptr_psi_term aaaa_1
Definition: def_struct.h:239
hash_lookup
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
HASH_LOOKUP.
Definition: hash_table.c:131
wl_psi_term::resid
ptr_residuation resid
Definition: def_struct.h:189
wl_definition::already_loaded
char already_loaded
Definition: def_struct.h:157
undef_it
#define undef_it
was enum (def_type) in extern.h now there is typedef ptr_definition
Definition: def_const.h:1394
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
user_module
ptr_module user_module
Definition: modules.c:22
push_ptr_value
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
translate
ptr_psi_term translate(ptr_psi_term a, long **infoptr)
translate
Definition: copy.c:108
wl_definition::init_value
ptr_psi_term init_value
Definition: def_struct.h:160
c_public
long c_public()
c_public
Definition: modules.c:687
FEATCMP
#define FEATCMP
indicates to use featcmp for comparison (in trees.c)
Definition: def_const.h:979
display_modules
long display_modules
Definition: modules.c:25
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
stack_cons
ptr_psi_term stack_cons(ptr_psi_term head, ptr_psi_term tail)
stack_cons
Definition: built_ins.c:46
wl_definition::evaluate_args
char evaluate_args
Definition: def_struct.h:156
lf_false
ptr_definition lf_false
symbol in bi module
Definition: def_glob.h:284
wl_keyword::combined_name
char * combined_name
Definition: def_struct.h:119
traverse_tree
void traverse_tree(ptr_node n, int flag)
traverse_tree
Definition: modules.c:656
glb
long glb(ptr_definition t1, ptr_definition t2, ptr_definition *t3, ptr_int_list *c3)
glb
Definition: types.c:1481
c_open_module
long c_open_module()
c_open_module
Definition: modules.c:519
push_goal
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
def_ptr
#define def_ptr
values of type_ptr
Definition: def_const.h:404
new_definition
ptr_definition new_definition(ptr_keyword key)
new_definition
Definition: modules.c:220
global_unify_attr
int global_unify_attr(ptr_node, ptr_node)
global_unify_attr
Definition: modules.c:1135
first_definition
ptr_definition first_definition
All definition are stores in a linked list starting at first_definition.
Definition: def_glob.h:13
legal_in_name
long legal_in_name(long c)
legal_in_name
Definition: token.c:980
input_file_name
string input_file_name
Definition: def_glob.h:1016
NOT_CODED
#define NOT_CODED
For LIFE boolean calculation built-in.
Definition: def_const.h:294
replace_attr
void replace_attr(ptr_node, ptr_psi_term, ptr_definition, ptr_definition)
replace_attr
Definition: modules.c:898
wl_module
Definition: def_struct.h:105
push_psi_ptr_value
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
push_psi_ptr_value
Definition: login.c:474
wl_keyword::definition
ptr_definition definition
Definition: def_struct.h:122
c_private_feature
long c_private_feature()
c_private_feature
Definition: modules.c:1302
wl_definition::type_def
def_type type_def
Definition: def_struct.h:153
defs.h
includes
trace_input
long trace_input
whether to echo characters read
Definition: def_glob.h:756
wl_psi_term
Definition: def_struct.h:177
open_module_tree
void open_module_tree(ptr_node n, int *onefailed)
open_module_tree
Definition: modules.c:542
global_unify
int global_unify(ptr_psi_term u, ptr_psi_term v)
global_unify
Definition: modules.c:1053
sys_module
ptr_module sys_module
Definition: modules.c:19
c_abort
long c_abort()
c_abort
Definition: built_ins.c:2247
wl_module::symbol_table
ptr_hash_table symbol_table
Definition: def_struct.h:110
hash_create
ptr_hash_table hash_create(int size)
HASH_CREATE.
Definition: hash_table.c:25
wl_definition::keyword
ptr_keyword keyword
Definition: def_struct.h:147
ptr_psi_term
struct wl_psi_term * ptr_psi_term
quotedStackCopy
Definition: def_struct.h:62
insert_translation
void insert_translation(ptr_psi_term a, ptr_psi_term b, long info)
insert_translation
Definition: copy.c:67
wl_node::data
GENERIC data
Definition: def_struct.h:201
NULL
#define NULL
Definition: def_const.h:533
current_module
ptr_module current_module
Definition: modules.c:15
REAL
#define REAL
Which C type to use to represent reals and integers in Wild_Life.
Definition: def_const.h:132
three
char * three
Definition: def_glob.h:893
wl_keyword::symbol
char * symbol
Definition: def_struct.h:118
module_buffer
string module_buffer
Definition: def_glob.h:953
resid_aim
ptr_goal resid_aim
Definition: def_glob.h:865
overlap_type
long overlap_type(ptr_definition t1, ptr_definition t2)
overlap_type
Definition: types.c:1579
c_trace_input
long c_trace_input()
c_trace_input
Definition: modules.c:810
heap_insert
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
heap_insert
Definition: trees.c:320
wl_definition::always_check
char always_check
Definition: def_struct.h:154
bi_module
ptr_module bi_module
Definition: modules.c:17
open_module_one
void open_module_one(ptr_psi_term t, int *onefailed)
open_module_one
Definition: modules.c:562
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
traceline
void traceline(char *format,...)
traceline
Definition: error.c:186
wl_int_list
Definition: def_struct.h:84
real
ptr_definition real
symbol in bi module
Definition: def_glob.h:375
strip_module_name
char * strip_module_name(char *str)
strip_module_name
Definition: modules.c:144
ptr_module
struct wl_module * ptr_module
Definition: def_struct.h:114
print_symbol
char * print_symbol(ptr_keyword k)
print_symbol
Definition: modules.c:435
wl_definition::next
ptr_definition next
Definition: def_struct.h:164
Errorline
void Errorline(char *format,...)
Errorline.
Definition: error.c:465
GENERIC
unsigned long * GENERIC
unsigned long *GENERIC
Definition: def_struct.h:35
MAKE_PRIVATE
#define MAKE_PRIVATE
Definition: modules.c:644
stack_insert
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
stack_insert
Definition: trees.c:337
update_symbol
ptr_definition update_symbol(ptr_module module, char *symbol)
update_symbol
Definition: modules.c:270
deref_ptr
#define deref_ptr(P)
Definition: def_macro.h:100
heap_copy_string
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
all_public_symbols
long all_public_symbols()
all_public_symbols
Definition: modules.c:1363
hash_insert
void hash_insert(ptr_hash_table table, char *symbol, ptr_keyword keyword)
HASH_INSERT.
Definition: hash_table.c:151
wl_node::key
char * key
Definition: def_struct.h:198
TRUE
#define TRUE
Standard boolean.
Definition: def_const.h:268
STRCMP
#define STRCMP
indicates to use strcmp for comparison (c function)
Definition: def_const.h:963
replace
void replace(ptr_definition old, ptr_definition new, ptr_psi_term term)
replace
Definition: modules.c:851
wl_definition::date
long date
Definition: def_struct.h:146
wl_definition::rule
ptr_pair_list rule
Definition: def_struct.h:148
wl_definition::global_value
ptr_psi_term global_value
Definition: def_struct.h:159
FALSE
#define FALSE
Standard boolean.
Definition: def_const.h:275
make_feature_private
int make_feature_private(ptr_psi_term term)
make_feature_private
Definition: modules.c:1256
rec_replace
void rec_replace(ptr_definition, ptr_definition, ptr_psi_term)
rec_replace
Definition: modules.c:865
wl_keyword
Definition: def_struct.h:116
stack_psi_term
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
pretty_quote_symbol
void pretty_quote_symbol(ptr_keyword k)
pretty_quote_symbol
Definition: modules.c:470
wl_psi_term::value_3
GENERIC value_3
Definition: def_struct.h:186
stack_nil
ptr_psi_term stack_nil()
stack_nil
Definition: built_ins.c:26
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
create_module
ptr_module create_module(char *module)
ptr_module create_module(char *module)
Definition: modules.c:72
x_module
ptr_module x_module
Definition: modules.c:23
unify
#define unify
was enum (goal) – but must be long for error.c - now typedef
Definition: def_const.h:1058
find
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
wl_module::open_modules
ptr_int_list open_modules
Definition: def_struct.h:108
dummy_printf
int dummy_printf(char *f, char *s, char *t)
dummy_printf
Definition: login.c:2617
featcmp
long featcmp(char *str1, char *str2)
featcmp
Definition: trees.c:106
pretty_symbol
void pretty_symbol(ptr_keyword k)
pretty_symbol
Definition: modules.c:452
string_val
char * string_val(ptr_psi_term term)
string_val
Definition: modules.c:169
wl_definition
Definition: def_struct.h:145
wl_keyword::module
ptr_module module
Definition: def_struct.h:117
error_psi_term
ptr_psi_term error_psi_term
symbol in bi module
Definition: def_glob.h:118
prettyf
void prettyf(char *s)
prettyf
Definition: print.c:496
make_public
long make_public(ptr_psi_term term, long bool)
make_public
Definition: modules.c:613
c_display_persistent
long c_display_persistent()
c_display_persistent
Definition: modules.c:775
display_persistent
long display_persistent
if true print persistent values preceded by "$"
Definition: def_glob.h:748
update_feature
ptr_definition update_feature(ptr_module module, char *feature)
update_feature
Definition: modules.c:1331
wl_definition::protected
char protected
Definition: def_struct.h:155
c_alias
long c_alias()
c_alias
Definition: modules.c:1180
c_module_access
long c_module_access()
c_module_access
Definition: modules.c:1008
MAKE_FEATURE_PRIVATE
#define MAKE_FEATURE_PRIVATE
Definition: modules.c:645
find_module
ptr_module find_module(char *module)
find_module
Definition: modules.c:54
MAKE_PUBLIC
#define MAKE_PUBLIC
Definition: modules.c:643
wl_keyword::private_feature
int private_feature
Definition: def_struct.h:121
no_module
ptr_module no_module
Definition: modules.c:16
c_current_module
long c_current_module()
c_current_module
Definition: modules.c:974
wl_definition::code
ptr_int_list code
Definition: def_struct.h:150
extract_module_from_name
ptr_module extract_module_from_name(char *str)
extract_module_from_name
Definition: modules.c:116
warningline
void warningline(char *format,...)
warningline
Definition: error.c:371
lf_true
ptr_definition lf_true
symbol in bi module
Definition: def_glob.h:410
wl_keyword::public
int public
Definition: def_struct.h:120
wl_node
Definition: def_struct.h:197
wl_psi_term::type
ptr_definition type
Definition: def_struct.h:181
get_module
int get_module(ptr_psi_term psi, ptr_module *module)
get_module
Definition: modules.c:1226
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
prettyf_quote
void prettyf_quote(char *s)
prettyf_quote
Definition: print.c:529
wl_definition::properties
ptr_triple_list properties
Definition: def_struct.h:149
c_replace
long c_replace()
c_replace
Definition: modules.c:936
wl_definition::children
ptr_int_list children
Definition: def_struct.h:152
HEAP_ALLOC
#define HEAP_ALLOC(A)
Definition: def_macro.h:20
make_module_token
char * make_module_token(ptr_module module, char *str)
make_module_token
Definition: modules.c:191
set_current_module
ptr_module set_current_module(ptr_module module)
set_current_module
Definition: modules.c:100
wl_psi_term::attr_list
ptr_node attr_list
Definition: def_struct.h:187
c_private
long c_private()
c_private
Definition: modules.c:714
c_set_module
long c_set_module()
c_set_module
Definition: modules.c:488
quoted_string
ptr_definition quoted_string
symbol in bi module
Definition: def_glob.h:368
wl_definition::op_data
ptr_operator_data op_data
Definition: def_struct.h:158
syntax_module
ptr_module syntax_module
Definition: modules.c:18
wl_node::right
ptr_node right
Definition: def_struct.h:200
wl_int_list::next
ptr_int_list next
Definition: def_struct.h:86
c_display_modules
long c_display_modules()
c_display_modules
Definition: modules.c:739
wl_definition::parents
ptr_int_list parents
Definition: def_struct.h:151
int_ptr
#define int_ptr
values of type_ptr
Definition: def_const.h:397