1/* 2% =================================================================== 3% File 'mpred_type_constraints.pl' 4% Purpose: For Emulation of OpenCyc for SWI-Prolog 5% Maintainer: Douglas Miles 6% Contact: $Author: dmiles $@users.sourceforge.net ; 7% Version: 'interface' 1.0.0 8% Revision: $Revision: 1.9 $ 9% Revised At: $Date: 2002/06/27 14:13:20 $ 10% =================================================================== 11% File used as storage place for all predicates which change as 12% the world is run. 13% 14% 15% Dec 13, 2035 16% Douglas Miles 17*/ 18 19% File: /opt/PrologMUD/pack/logicmmtc_base/prolog/logicmoo/mpred/mpred_type_constraints.pl 20%:- if(( ( \+ ((current_prolog_flag(logicmmtc_include,Call),Call))) )). 21:- module(mpred_type_constraints, 22 [ add_cond/2, 23 arg_to_var/3, 24 attempt_attribute_args/3, 25 attempt_attribute_args/5, 26 attempt_attribute_one_arg/4, 27 attribs_to_atoms/2, 28 attribs_to_atoms0/2, 29 cmp_memberchk_0/2, 30 cmp_memberchk_00/2, 31 comp_type/3, 32 iz/2, 33 extend_iz/2, 34 extend_iz_member/2, 35 init_iz/2, 36 inst_cond/2, 37 isa_pred_l/3, 38 isa_pred_l/4, 39 chk_cond/2, 40 call_cond/2, 41 condz_to_isa/2, 42 map_subterms/3, 43 max_cond/3, 44 max_cond_l/2, 45 dif_objs/2, 46 min_cond/3, 47 min_cond_l/2, 48 promp_yn/2, 49 same/2, 50 same_arg/3, 51 samef/2, 52 to_functor/2, 53 type_size/2, 54 extract_conditions/2, 55 56 unrelax/1, iz_member/1, 57 58 lazy/1,lazy/2, 59 60 constrain/1,enforce/1, 61 62 63 relax/1,relax_goal/2,thaw/1, 64 mpred_type_constraints_file/0 65 ]). 66 67:- set_prolog_flag(generate_debug_info, true). 68 69:- meta_predicate my_when(,). 70:- meta_predicate nrlc(). 71:- meta_predicate prolog_current_choice(,). 72:- meta_predicate prolog_current_choice(,,). 73:- meta_predicate xnr(). 74:- meta_predicate xnr(,). 75%:- include('mpred_header.pi'). 76 77% :- endif. 78 79:- use_module(library(logicmoo/common_logic/common_logic_snark)). 80 81:- user:use_module(library(gvar_globals_api)). 82 83:- module_transparent(( 84 add_cond/2, 85 arg_to_var/3, 86 attempt_attribute_args/3, 87 attempt_attribute_args/5, 88 attempt_attribute_one_arg/4, 89 attribs_to_atoms/2, 90 attribs_to_atoms0/2, 91 cmp_memberchk_0/2, 92 cmp_memberchk_00/2, 93 comp_type/3, 94 iz/2, 95 extend_iz/2, 96 extend_iz_member/2, 97 init_iz/2, 98 inst_cond/2, 99 isa_pred_l/3, 100 isa_pred_l/4, 101 chk_cond/2, 102 call_cond/2, 103 condz_to_isa/2, 104 map_subterms/3, 105 max_cond/3, 106 max_cond_l/2, 107 dif_objs/2, 108 min_cond/3, 109 min_cond_l/2, 110 promp_yn/2, 111 same/2, 112 same_arg/3, 113 samef/2, 114 to_functor/2, 115 type_size/2, 116 extract_conditions/2, 117 118 unrelax/1, iz_member/1, 119 120 lazy/1,lazy/2, 121 122 constrain/1,enforce/1, 123 124 relax/1,relax_goal/2,thaw/1, 125 mpred_type_constraints_file/0)). 126 127:- if(exists_source(library(multivar))). 128:- use_module(library(multivar)). 129:- endif. 130 131:- if(exists_source(library(vhar))). 132:- use_module(library(vhar)). 133:- endif. 134 135:- if(exists_source(library(vprox))). 136:- use_module(library(vprox)). 137:- endif. 138 139 140:- meta_predicate 141 isa_pred_l(,,), 142 isa_pred_l(,,,), 143 map_subterms(,,), 144 iz_member(), 145 constrain(), 146 map_lits(,), 147 boxlog_goal_expansion(,), 148 map_each_argnum(,,,,), 149 map_argnums(,,), 150 thaw(), 151 lazy(), 152 unrelax(), 153 relax_goal(,), 154 lazy(,). 155 156:- meta_predicate relax(),relaxing(). 157 158:- kb_local(baseKB:admittedArgument/3). 159 160:- thread_local(t_l:no_kif_var_coroutines/1). 161 162:- meta_predicate relaxed_call(). 163 164% ?- G=(loves(X,Y),~knows(Y,tHuman(X))),relax_goal(G,Out),writeq(Out). 165 166:- meta_predicate map_plits(,). 167map_lits(P1,Lit):- 168 locally($('$outer_stack')=[],once(map_plits(P1,Lit))),!. 169 170map_plits(P1,Lit):- \+ compound(Lit),!,call(P1,Lit). 171map_plits(P1,[Lit1 | Lit2]):- !,map_plits(P1,Lit1),map_plits(P1,Lit2). 172map_plits(P1,(Lit1 , Lit2)):- !,map_plits(P1,Lit1),map_plits(P1,Lit2). 173map_plits(P1,(Lit1 ; Lit2)):- !,map_plits(P1,Lit1),map_plits(P1,Lit2). 174map_plits(P1,(Lit1 :- Lit2)):- !,map_lits(P1,Lit1),with_outer(Lit1,0,map_plits(P1,Lit2)). 175map_plits(P1, Expr) :- demodalfy_outermost(+,Expr,MExpr,_Outer),!, 176 with_outer(Expr,1,map_plits(P1, MExpr)). 177map_plits(P1, Expr) :- Expr=..[C,I], tCol(C),!,map_plits(P1, isa(I,C)). 178map_plits(P1, Expr) :- functor(Expr,F,A),mappable_sentence_functor(F,A), !, Expr =.. [F|Args], 179 map_meta_lit(F,1,P1,Args). 180map_plits(P1,Lit):- call(P1,Lit). 181 182map_meta_lit(F,N,P1,[Arg|Args]):- !, 183 with_outer(F,N,map_plits(P1, Arg)), 184 N2 is N + 1, 185 map_meta_lit(F,N2,P1,Args). 186map_meta_lit(_,_,_,[]):-!. 187 188:- nb_setval('$outer_stack',[]). 189 190with_outer(ExprF,N,Goal):- nb_current('$outer_stack',Was), 191 locally($('$outer_stack')=[ExprF-N|Was],Goal). 192 193closure_push(Closure,Data):- var(Closure),!,add_cond(Closure,Data). 194closure_push(Closure,Data):- Closure=[true|_Rest],!,setarg(1,Closure,Data). 195closure_push(Closure,Data):- Closure=[_First|Rest],!,setarg(2,Closure,[Data|Rest]). 196 197constrain_arg_var(Closure,Arg,FA):- closure_push(Closure,add_cond(Arg,FA)). 198 199%push_modal(neg(_)):- nb_current('$modal_stack',[neg(_)|Was]),!, b_setval('$modal_stack',Was). 200%push_modal(Modal):- nb_current('$modal_stack',Was)->b_setval('$modal_stack',[Modal|Was]);b_setval('$modal_stack',[Modal,call]). 201%last_modal(Modal):- nb_current('$modal_stack',[Modal|_])-> true; Modal=call. 202 203map_argnums(_,_,Lit):- \+ compound(Lit), !. 204map_argnums(Modal,P4,[Lit1 | Lit2]):- !,map_argnums(Modal,P4,Lit1),map_argnums(Modal,P4,Lit2). 205map_argnums(Modal,P4,isa(I,C)):- !,call(P4,Modal,C,0,I). 206map_argnums(Modal,P4,Expr) :- demodalfy_outermost(Modal,Expr,MExpr,ModalValue),!,map_argnums(ModalValue,P4, MExpr). 207map_argnums(Modal,P4,Expr) :- Expr=..[C,I], \+ (clause_b(argIsa(C,1,CC)),CC==C), clause_b(tCol(C)), !,map_argnums(Modal,P4,isa(I,C)). 208map_argnums(Modal,P4,Expr) :- compound_name_arguments(Expr,F,Args),functor(Expr,F,A), 209 (mappable_sentence_functor(F,A) -> map_argnums(Modal,P4,Args); map_each_argnum(Modal,P4,F,1,Args)). 210 211 212map_each_argnum(Modal,P4,F,N,[Arg|Args]):- !, 213 call(P4,Modal,F,N,Arg), 214 N2 is N + 1, 215 map_each_argnum(Modal,P4,F,N2,Args). 216map_each_argnum(_Modal,_,_,_,_). 217 218 219% non-backtracking attribute updates 220 221 222demodalfy_outermost(ModalIn,MExpr, Expr, ModalValue):- MExpr=..[Modal,Expr], modal_value(ModalIn,Modal,ModalValue). 223modal_value(neg(_), Neg , true):- arg(_,v( ( \+ ),'~','-','not'),Neg). 224modal_value(_, Neg , neg(Neg)):- arg(_,v( ( \+ ),'~','-','not'),Neg). 225 226mappable_sentence_functor(call,1). 227mappable_sentence_functor(=,2):-!,fail. 228mappable_sentence_functor(call_u,1). 229mappable_sentence_functor(F,_):- downcase_atom(F,DC),upcase_atom(F,DC). 230%mappable_sentence_functor(F,1):- \+ tCol(F). 231%mappable_sentence_functor(F,A):- \+ argIsa(F,A,_). 232 233%mtc_put_iza(X,Z):- Z=[id(ID)|_],nonvar(ID),!,put_attr(X,iza,Z). 234%mtc_put_iza(X,Z):- get_attr(X,iza,[id(ID)|_]),put_attr(X,iza,[id(ID)|Z]). 235%mtc_put_iza(X,Z):- gensym(id_,ID),!,put_attr(X,iza,[id(ID)|Z]). 236 237 238mtc_put_iza(X,Z):- put_attr(X,iza,Z). 239 240mtc_put_attr(X,iza,Z):- mtc_get_attr(X,iza,_Prev),!, mtc_put_iza(X,Z). 241mtc_put_attr(X,iza,Z):- !, mtc_put_iza(X,[iza_id(X)|Z]). 242mtc_put_attr(X,Y,Z):- var(X),!,oo_put_attr(X,Y,Z). 243mtc_put_attr(X,Y,Z):- oo_put_attr(X,Y,Z),nop(dmsg(warn(need_to_error(oo_put_attr(X,Y,Z))))). 244 245mtc_get_attr(X,Y,Z):- var(X),!,oo_get_attr(X,Y,Z). 246mtc_get_attr(X,Y,Z):- oo_get_attr(X,Y,Z),nop(dmsg(warn(need_to_fail(oo_get_attr(X,Y,Z))))),!,fail. 247 248 249mtc_get_attvar(Dom1,X):-memberchk(iza_id(X),Dom1). 250 251compound_lit(Arg):- compound(Arg). 252 253% ======================================================================== 254% enforce_bound(G) = check constraints 255% ======================================================================== 256:- export(enforce_bound/1). 257enforce_bound(G):-args_enforce_bound(G,Closure),maplist(call,Closure). 258 259:- during_boot(add_history(( 260 G=(loves(X,Y),~knows(Y,tHuman(X))),must(args_enforce_bound(G,Out)),writeq(Out) 261 ))). 262 263:- export(args_enforce_bound/2). 264args_enforce_bound(G,Closure):- ignore(Closure=[true]),map_argnums(pos(_),args_enforce_bound3(Closure),G). 265 266args_enforce_bound3(Closure,Modal,C,0,I):- !, ignore(( nonvar(I), 267 (Modal\=pos(_) -> closure_push(Closure,modal_isa(I,C)) ; closure_push(Closure,isa(I,C))))). 268args_enforce_bound3(Closure,Modal,_F,_A,Arg):- compound_lit(Arg),!,map_argnums(Modal,args_enforce_bound3(Closure),Arg). 269args_enforce_bound3(_Closure,_Modal,_F,_A,Arg):- var(Arg),!. 270args_enforce_bound3(Closure,Modal,F,A,Arg):-args_enforce_nonvar(Closure,Modal,F,A,Arg). 271 272 273% ======================================================================== 274% constrain(G) = add constraints to free args 275% ======================================================================== 276:- export(constrain/1). 277constrain(G):-ground(G),!. 278constrain(G):-args_constrain(G,Closure),maplist(call,Closure). 279 280:- export(args_constrain/2). 281:- during_boot(add_history(( 282 G=(loves(X,Y),~knows(Y,tHuman(X))),must(args_constrain(G,Out)),writeq(Out) 283 ))). 284 285args_constrain(G,Closure):- ignore(Closure=[true]),map_argnums(pos(_),args_constrains3(Closure),G). 286 287 288args_constrains3(Closure,Modal,C,0,I):- !, 289 (Modal\=pos(_) -> constrain_arg_var(Closure,I,does_exist(I)) ; constrain_arg_var(Closure,I,isa(I,C))). 290args_constrains3(Closure,Modal,_F,_A,Arg):- compound_lit(Arg),!,map_argnums(Modal,args_constrains3(Closure),Arg). 291args_constrains3(_Closure,_Modal,_F,_A,Arg):- nonvar(Arg),!. 292args_constrains3(Closure,Modal,F,A,Arg):-args_constrain_var(Closure,Modal,F,A,Arg). 293 294:- export(does_exist/1). 295does_exist(_). 296modal_admittedArgument(F,1,V):-!,admittedArgument(F,1,V). 297modal_admittedArgument(_,_,_). 298% ======================================================================== 299% enforce(G) = enforce_bound/1 + constrain/1 300% ======================================================================== 301:- export(enforce/1). 302enforce(G):-args_enforce(G,Closure),maplist(call,Closure). 303 304 305:- during_boot(add_history(( 306 G=(loves(X,Y),~knows(Y,tHuman(X))),must(args_enforce(G,Out)),writeq(Out) 307 ))). 308 309:- export(args_enforce/2). 310args_enforce(G,Closure):- ignore(Closure=[true]),map_argnums(pos(_),args_enforces3(Closure),G). 311 312args_enforces3(Closure,Modal,C,0,I):- !, 313 (Modal\=pos(_) -> constrain_arg_var(Closure,I,does_exist(I)) ; constrain_arg_var(Closure,I,isa(I,C))). 314args_enforces3(Closure,Modal,_F,_A,Arg):- compound_lit(Arg),!,map_argnums(Modal,args_enforces3(Closure),Arg). 315args_enforces3(Closure,Modal,F,A,Arg):- var(Arg),!, args_constrain_var(Closure,Modal,F,A,Arg). 316args_enforces3(Closure,Modal,F,A,Arg):- args_enforce_nonvar(Closure,Modal,F,A,Arg). 317 318 319 320% ======================================================================== 321% remove_constraints(G) = remove constraints 322% ======================================================================== 323remove_constraints(G):-args_remove_constraints(G,Closures),maplist(ignore,Closures). 324 325:- export(args_remove_constraints/2). 326:- during_boot(add_history(( 327 G=(loves(X,Y),~knows(Y,tHuman(X))),args_enforce(G,Out),writeq(Out), 328 args_remove_constraints(G,Out2),writeq(Out2) 329 330 ))). 331 332args_remove_constraints(G,Closure):- ignore(Closure=[true]),map_argnums(pos(_),args_remove_constraints3(Closure),G). 333 334args_remove_constraints3(Closure,_Modal,C,0,I):- !, transfer_constraints(Closure,I),transfer_constraints(Closure,C). 335args_remove_constraints3(Closure,Modal,_F,_A,Arg):- compound_lit(Arg),!,map_argnums(Modal,args_remove_constraints3(Closure),Arg). 336args_remove_constraints3(Closure,_Modal,_F,_A,Arg):- transfer_constraints(Arg,Closure). 337 338transfer_constraints(Arg,Closure):- ignore((var(Arg),mtc_get_attr(Arg,iza,ToDo),del_attr(Arg,iza), 339 maplist(constrain_arg_var(Closure,Arg),ToDo))). 340 341%:- module_transparent(apply:maplist/2). 342%:- module_transparent(apply:maplist/3).
349args_constrain_var(Closure,Modal,F,A,Arg):- (A==1 ; Modal=pos(_)), 350 argIsa(F,A,Type),!,constrain_arg_var(Closure,Arg,isa(Arg,Type)). 351 352args_constrain_var(Closure,Modal,F,A,Arg):- 353 (Modal\=pos(_) -> 354 constrain_arg_var(Closure,Arg,modal_admittedArgument(F,A,Arg)) ; 355 constrain_arg_var(Closure,Arg, admittedArgument(F,A,Arg))).
361args_enforce_nonvar(Closure,Modal,F,A,Arg):-
362 (Modal\=pos(_) ->
363 closure_push(Closure,modal_admittedArgument(F,A,Arg)) ;
364 closure_push(Closure, admittedArgument(F,A,Arg))).
371extract_conditions(Sentence,Conds):-
372 copy_term(Sentence,Sentence,Goals),
373 list_to_set(Goals,GoalSet),
374 (Goals\==GoalSet-> dmsg(cons_odd) ; true),
375 list_to_conjuncts(GoalSet,Conds),!.381boxlog_goal_expansion(relax(G),GG):-!,relax_goal(G,GG). 382%boxlog_goal_expansion(G,GG):-!,relax_goal(G,GG). 383/* 384boxlog_goal_expansion(G,_):- % \+ source_location(_,_), 385 wdmsg(g_s(G)),fail. 386*/ 387 388 389is_iz_or_iza(Var):- zotrace((mtc_get_attr(Var,iz,_);mtc_get_attr(Var,iza,_))).
395relax(G):- map_lits(relax_lit,G). 396 397relaxing(G):- term_attvars(G,Gs),quietly(relax(G)),term_attvars(G,Gs0),!,Gs0\==Gs. 398 399relax_lit(G):- var(G),!. 400relax_lit(_:G):-!,relax_lit(G). 401relax_lit(G):- G=..[_|ARGS],relax_args(G,1,ARGS).
407relaxed_call(G):- relax(G), ( *-> unrelax(G) ; (unrelax(G),!,fail)).415relax_goal(G,GG):- copy_term(G,GG),relax(GG). 416 417 418relax_goal_alt_old(G,GGG):- 419 copy_term(G,GG,Gs),G=GG,G=..[_|ARGS],relax_args(GG,1,ARGS), 420 GGG=(GG,maplist(iz_member,Gs)). 421 422 423% ?- G=loves(a,b),relax_lit(G).
% relax_N(G,N,Val):- var(Val),!,setarg(N,G,Val).
% relax_N(G,N,Val):- iz(AA,[Val]),!,nb_setarg(N,G,AA).
435relax_N(_,_,Val):- var(Val),!, ((mtc_get_attr(Val,iz,_);mtc_get_attr(Val,iza,_))->true;mtc_put_attr(Val,iz,[_])). 436relax_N(G,N,Val):- dont_relax(Val)->true;(nb_setarg(N,G,NewVar),put_value(NewVar,Val)). 437 438:- if(exists_source(library(multivar))). 439% put_value(Var,Value):- multivar(Var),iz(Var,[Value]),mv_set1(Var,Value). 440 441% put_value(Var,Value):- Var==Value,!. 442put_value(Var,Value):- is_dict(Value,Tag),!, 443 (Tag==Var->true;put_value(Var,Tag)), 444 dict_pairs(Value,_Tag2,Pairs), 445 maplist(put_value_attr(Var),Pairs). 446put_value(Var,Value):- iz(Var,[Value]). 447 448put_value_attr(Var,N-V):- put_attr_value(Var,N,V). 449put_attr_value(Var,iza,V):- !, add_cond(Var,V). 450put_attr_value(Var,iz,V):- !, iz(Var,V). 451put_attr_value(Arg,Name,FA):- as_constraint_for(Arg,FA,Constraint),!,put_attr_value0(Arg,Name,Constraint). 452 453put_attr_value0(Var,Name,HintE):- 454 (mtc_get_attr(Var,Name,HintL) -> min_cond(HintE,HintL,Hint); Hint=[HintE]), !, 455 mtc_put_attr(Var,Name,Hint). 456 457 458 459:- else. 460 put_value(Var,Value):- iz(Var,[Value]). 461:- endif. 462 463dont_relax(A):- var(A),!,is_iz_or_iza(A). 464dont_relax(A):- \+ compound(A), \+ atom(A), \+ string(A).
470relax_args(G,N,[A|RGS]):-relax_N(G,N,A),!,N2 is N + 1,relax_args(G,N2,RGS). 471relax_args(_,_,[]). 472 473%:- set_prolog_flag(verbose_file_search,true). 474:- user:use_module(library(clpfd),except([ins/2,sum/3,op(_,_,_)])). % Make predicates defined 475%:- absolute_file_name(library('clp/clpr.pl'),File),writeln(File). 476%:- use_module(user:library(clpr)). % Make predicates defined 477:- use_module(library(clpr),except([{}/1])). % Make predicates defined 478:- use_module(user:library(simplex)). % Make predicates defined 479 480%:- set_prolog_flag(verbose_file_search,false). 481 482:- meta_predicate lazy_pfa(,,). % arg1 was 0 483:- meta_predicate #(). % was 0 (G):- map_lits(lazy,G). 485 486my_when(If,Goal):- when(If,Goal).
492lazy(G):- var(G),!,freeze(G,lazy(G)). 493lazy(G):- ground(G),!,call(G). 494lazy(is(X,G)):- !,clpr:{X =:= G}. 495% lazy(is(X,G)):-!,term_variables(G,Vs),lazy(Vs,is(X,G)). 496lazy(G):- functor(G,F,A),lazy_pfa(G,F,A). 497 498clp_r_arithmetic(=<). 499clp_r_arithmetic(=:=). 500clp_r_arithmetic( := ). 501clp_r_arithmetic(<). 502clp_r_arithmetic(>=). 503clp_r_arithmetic(>). 504 505lazy_pfa(G,F,2):- clp_r_arithmetic(F),!,clpr:{G}. 506lazy_pfa(G,_,1):- term_variables(G,[V1|Vs1]),!, 507 (Vs1 = [V2|Vs0] -> lazy([V1,V2|Vs0],G) 508 ; freeze(V1,G)). 509lazy_pfa(G,_,_):- term_variables(G,[V1|Vs1]), 510 (Vs1 = [V2|Vs0] -> lazy([V1,V2|Vs0],G) 511 ; freeze(V1,G)).
517lazy([V],G):- !, freeze(V,G). 518%lazy([V|Vs],G):- or_any_var([V|Vs],C)->when(C,lazy(G)). 519lazy([V|Vs],G):- !, lazy(Vs,freeze(V,G)). 520lazy(_,G):- call(G). 521 522 523or_any_var([V],nonvar(V)). 524or_any_var([V|Vs],(nonvar(V);C)):-or_any_var(Vs,C). 525 526% test lazy(isa(X,Y)),!,X=tCol,melt(Y).
532thaw(G):- call_residue_vars(G,Vs),maplist(melt,Vs).539melt(V):-frozen(V,G),call(G). 540 541/* 542 call_grounded_constraints,disable_callable_constraints,call_universals,call_each_with_ignore, 543 544 call newly grounded_constraints 545 546 enable_callable_constraints 547 call_unground_constraints 548 549*/ 550 551nonground(G):- \+ ground(G). 552enable_reactions(V):- put_attr(V,enable_reactions,true). 553disable_reactions(V):- put_attr(V,enable_reactions,false). 554 555:- meta_predicate(mpred_label()). 556:- module_transparent(mpred_label/1). 557:- meta_predicate(mpred_label(,)). 558:- module_transparent(mpred_label/2). 559mpred_label(M:G):- term_attvars(G,Vars),maplist(mpred_label_var(M,pre),Vars),maplist(mpred_label_var(M,post),Vars). 560mpred_label(How,M:G):- term_attvars(G,Vars),maplist(mpred_label_var(M,How),Vars). 561 562:- module_transparent(mpred_label_var/3). 563mpred_label_var(M,pre,V):- 564 obtain_conds(V,List),!, 565 put_attr(V,iza,[]), 566 maplist(call_when_and_save(M,V,ground),List,MidList), 567 maplist(call_when_and_save(M,V,nonground),MidList,NewMidList), 568 maplist(call_when_and_save(M,V,nonground),NewMidList,NewList), 569 put_attr(V,iza,NewList). 570 571mpred_label_var(M,while,V):- 572 obtain_conds(V,List),!, 573 maplist(call_when_and_save(M,V,ground),List,MidList), 574 maplist(call_when_and_save(M,V,nonground),MidList,NewMidList), 575 maplist(call_when_and_save(M,V,nonground),NewMidList,NewList), 576 put_attr(V,iza,NewList). 577 578mpred_label_var(M,post,V):- 579 obtain_conds(V,List), 580 put_attr(V,iza,[]),!, 581 maplist(call_when_and_save(M,V,ground),List,MidList), 582 maplist(call_when_and_save(M,V,nonground),MidList,NewMidList), 583 maplist(call_when_and_save(M,V,nonground),NewMidList,NewList), 584 put_attr(V,iza,NewList). 585 586mpred_label_var(M,Stage,V):- 587 obtain_conds(V,List), 588 maplist(call_when_and_save(M,V,Stage),List,NewList), 589 put_attr(V,iza,NewList). 590 591 592call_when_and_save(M,V,When,Cond,Cond):- M:call(When,Cond)-> call_and_save_as_proof(M,V,Cond,Cond) ; true. 593 594call_and_save_as_proof(_,_,call(proved,_),_CCond):- !. 595call_and_save_as_proof(M,_,call(call,_),CCond):- !, M:call(CCond),setarg(1,CCond,proved). 596call_and_save_as_proof(M,_V,call(ignore,_),CCond):- (M:call(CCond)->setarg(1,CCond,proved);true). 597call_and_save_as_proof(_,_V,aoc(_SK,_What),_CCond):-!. 598call_and_save_as_proof(M,_V,dif_objs(X,Y),_CCond):- !, M:dif_objs(X,Y). 599call_and_save_as_proof(M,_,CCond,CCond):- M:call(CCond),!.
assigned the value Y
Inst Isac.
612inst_cond(X, List):- predsort(comp_type,List,SList),call_cond(X,SList). 613 614 615iza_id(_). 616 617:- module_transparent unify_attr_iza/2. 618:- module_transparent unify_attr_iza/3. 619:- module_transparent unify_attr_iza_1/3. 620:- module_transparent iza:attr_unify_hook/2. 621 622izaattr_unify_hook(DVar, Y):- unify_attr_iza(DVar, Y). 623unify_attr_iza(Dom1, Y):- show_failure(mtc_get_attvar(Dom1,Self)),!,unify_attr_iza_self(Self,Dom1, Y). 624unify_attr_iza(Dom1, Y):- 625 dumpST, 626 dmsg(lhs=(Dom1)), 627 dmsg(rhs=(Y)), 628 must(show_failure(attvar(Y))),!, 629 mtc_put_attr(Y, iza, Dom1 ). 630 631unify_attr_iza_self(Self,Dom1, Y):- atom(Y),as_existential(Y,YY),% isNamed(YY,What),!, 632 mtc_get_attr(YY, iza, Dom2),!, 633 unify_conds(Dom1,Dom2,Result1),!, 634 unify_conds(Dom2,Dom1,Result2),!, 635 mtc_put_attr(YY, iza, Result2), 636 mtc_put_attr(Self, iza, Result1). 637 638 639unify_attr_iza_self(Self,Dom1, Y):- is_existential(Y),=(Y,YY),!, 640 mtc_get_attr(YY, iza, Dom2),!, 641 unify_conds(Dom1,Dom2,Result1),!, 642 unify_conds(Dom2,Dom1,Result2),!, 643 mtc_put_attr(YY, iza, Result2), 644 mtc_put_attr(Self, iza, Result1). 645 646 647unify_attr_iza_self(Self,Dom1, Y):- nonvar(Y),isNamed(Y,What),!, 648 (attvar(Self)-> \+ \+ (((attv_bind(Self,Y),chk_cond(Y,Dom1)))) ; chk_cond(Y,Dom1)),!, 649 add_cond(Self,aoc(isName,What)). 650 651unify_attr_iza_self(Self,Dom1, Y):- 652 must(show_failure(var(Self))), 653 (show_failure(attvar(Y))),!, 654 mtc_put_attr(Y, iza, Dom1 ). 655unify_attr_iza_self(_Self,Dom1, Y):- chk_cond(Y,Dom1). 656 657 658 659local_memberchk_variant(H,Dom1):- memberchk_variant(H,Dom1). 660 661:- module_transparent unify_conds/3. 662unify_conds(Dom1,Dom2,Dom1):- Dom1=@=Dom2,!. 663unify_conds(Dom1,[],Dom1):-!. 664unify_conds(Dom1,[H|Dom2],NewDomain):- local_memberchk_variant(H,Dom1),!,unify_conds(Dom1,Dom2,NewDomain). 665unify_conds(Dom1,[H|Dom2],NewDomain):- \+ rejects_cond(H,Dom1),!, 666 unify_conds(Dom1,Dom2,NewDomain1), 667 (private_cond(H) -> NewDomain1=NewDomain ; 668 \+ local_cond(H) -> ord_union(NewDomain1,[H],NewDomain) ; 669 \+ memberchk_variant(H,Dom1) -> ord_union(NewDomain1,[H],NewDomain) ; 670 NewDomain1=NewDomain). 671 672 673hide_unify_conds(Dom1,Dom2,NewDomain):- show_failure(( \+ disjoint_conds(Dom1,Dom2))), 674 % sanity(must(\+ disjoint_conds(Dom2,Dom1))), % ensure the checks got both ways 675 ord_union(Dom1, Dom2, NewDomain). 676 677 678get_typeinfos(Var,List):- obtain_conds(Var,Pre),include(is_typeinfo,Pre,List). 679get_post_labeling(Var,List):- obtain_conds(Var,Pre),exclude(is_typeinfo,Pre,List). 680 681 682is_typeinfo(Pre):- compound(Pre),!,functor(Pre,_,1). 683is_typeinfo(Pre):- atom(Pre),!. 684 685% add_all_differnt(QuantsList):- bagof(differentFromAll(I,O),QuantsList,O),L),maplist(call,L). 686add_all_differnt(QuantsList):- 687 maplist(add_all_differnt2(QuantsList),QuantsList),!. 688 689add_all_differnt2(QuantsList,Ex):- 690 delete_eq(QuantsList,Ex,DisjExs), 691 differentFromAll(Ex,DisjExs). 692 693 694add_cond_differentFromAll(Ex,DisjExs):- add_cond(Ex,differentFromAll(Ex,DisjExs)). 695 696differentFromAll(One,List):- maplist(dif_objs(One),List).
dif_objs(A,B):- tlbugger:attributedVars,!,dif(A,B).
705dif_objs(A,B):- A==B,!,fail. 706dif_objs(A,B):- obtain_object_conds(A,B,Dom1,Dom2),!, 707 dif_objs_doms(Dom1,Dom2). 708dif_objs(A,B):- dif(A,B),add_cond(A,dif_objs(A,B)),add_cond(B,dif_objs(B,A)). 709 710dif_objs_doms(Dom1,Dom2):- ((member(aoc(SK,N1),Dom1),memberchk(aoc(SK,N2),Dom2),N1=@=N2)),!,fail. 711dif_objs_doms(Dom1,Dom2):- 712 \+ non_disjoint_conds(Dom1,Dom2), 713 disjoint_conds(Dom1,Dom2). 714 715disjoint_object_conds(Var1,Var2):- 716 obtain_object_conds(Var1,Var2,Dom1,Dom2), 717 disjoint_conds(Dom1,Dom2). 718 719obtain_object_conds(Var1,Var2,Dom1,Dom2):- 720 obtain_conds(Var1,Dom1),obtain_conds(Var2,Dom2). 721 722obtain_conds(Var,Doms):- mtc_get_attr(Var,iza,Doms),!. 723obtain_conds(Var,DomsO):- compound(Var),\+ is_fort(Var),functor(Var,_,A),arg(A,Var,Doms), 724 (is_list(Doms)->DomsO=Doms; obtain_conds(Doms,DomsO)). 725obtain_conds(Var,DomsO):- as_existential(Var,X),obtain_conds(X,DomsO). 726% obtain_conds(_,[]). 727 728% conds may not be merged 729disjoint_conds(Dom1,Dom2):- 730 member(Prop,Dom1), 731 rejects_cond(Prop,Dom2). 732 733% disjoint skolems 734rejects_cond(aoc(SK,W1),Dom2):- !, memberchk(aoc(SK,W2),Dom2),'#\\='(W1,W2),!. 735rejects_cond(male,Dom2):- !, memberchk(female,Dom2). 736rejects_cond(_,_):- fail. 737 738% conds may not be merged 739non_disjoint_conds(Dom1,Dom2):- 740 member(Prop,Dom1), 741 not_rejected_cond(Prop,Dom2). 742 743 744aoc(_,_). 745 746% already same skolems 747not_rejected_cond(aoc(SK,W1),Dom2):- !, memberchk(aoc(SK,W2),Dom2),'#='(W1 , W2),!. 748not_rejected_cond(male,Dom2):- memberchk(female,Dom2). 749 750as_existential(In,Out):- is_existential(In),!,must(In=Out). 751as_existential(In,Out):- var(In),!,decl_existential(In),must(In=Out). 752% as_existential(In,Out):- strip_module(In,M,X), oo_deref(M,X,Out)->(X\==Out,is_existential(Out)),!. 753as_existential(In,Out):- \+ is_fort(In),!,trace_or_throw(as_existential(In,Out)). 754as_existential(In,Out):- nb_current_value(?('$fort2exist$'),In,Out),!. 755as_existential(In,Out):- decl_existential(Out0),!,add_cond(Out0,aoc(isNamed,In)),!, 756 must(nb_set_value(?('$fort2exist$'),In,Out0)),!, 757 must(nb_current_value(?('$fort2exist$'),In,Out)), 758 must(add_var_to_env(In,Out)). 759 760% :- ensure_loaded(library(multivar)). 761l_xvarx(Var):- xvarx(Var). 762 763decl_existential(Var):- is_existential(Var),!. 764decl_existential(Var):- var(Var),!,l_xvarx(Var),put_attr(Var,x,Var),mtc_put_iza(Var,[iza_id(Var)]). 765decl_existential(Atomic):- trace_or_throw(\+ decl_existential(Atomic)). 766 767is_existential(Var):- var(Var),!,get_attr(Var,x,V),var(V). 768is_existential(the(_)):-!. 769 770:- if(\+ current_predicate(attv_bind/2)). 771attv_bind(Var,Value):- Var=Value -> true; put_value(Var,Value). 772:- endif. 773 774xattr_unify_hook(_Was,_Becoming):-!. 775xattr_unify_hook(Was,Becoming):- (attvar(Was),attvar(Becoming)) -> attv_bind(Was,Becoming) ; true. 776xattribute_goals(Var) --> 777 ({is_existential(Var)} -> [decl_existential(Var)] ; []). 778xattr_portray_hook(Attr,Var):- one_portray_hook(Var,x(Var,Attr)). 779 780one_portray_hook(Var,Attr):- 781 locally(set_prolog_flag(write_attributes,ignore), 782 ((setup_call_cleanup(set_prolog_flag(write_attributes,ignore), 783 ((subst(Attr,Var,SName,Disp),!, 784 get_var_name(Var,Name), 785 (atomic(Name)->SName=Name;SName=self), 786 format('~p',[Disp]))), 787 set_prolog_flag(write_attributes,portray))))). 788 789:- module_transparent(user:portray_var_hook/1). 790:- multifile(user:portray_var_hook/1). 791:- dynamic(user:portray_var_hook/1). 792 793userportray_var_hook(Var) :- 794 current_prolog_flag(write_attributes,portray), 795 attvar(Var), 796 get_attr(Var,x,Val), 797 current_prolog_flag(write_attributes,Was), 798 setup_call_cleanup(set_prolog_flag(write_attributes,ignore), 799 writeq({exists(Var,Val)}), 800 set_prolog_flag(write_attributes,Was)),!. 801 802 803show_frame_and_goal(Prefix,Frame):- 804 prolog_frame_attribute(Frame,has_alternatives,Alt), 805 prolog_frame_attribute(Frame,goal,Goal), 806 prolog_frame_attribute(Frame,parent,Parent), 807 prolog_frame_attribute(Parent,goal,PGoal), 808 dmsg(frame(Prefix,Frame,Alt,Goal,PGoal)),!. 809 810clause_or_top(clause). 811clause_or_top(top). 812 813% non-repeating var 814xnr_var(Var):- 815 nonvar(Var) ->true; (get_attr(Var,xnr,_)->true; 816 ((gensym(xnr_,Id), 817 ((prolog_current_choice(clause_or_top,CP),prolog_choice_attribute(CP,frame,Frame))->true;prolog_current_frame(Frame)), 818 % show_frame_and_goal(xnr_var,Frame), 819 put_attr(Var,xnr,old_vals(Var,xnr_dif,Id,[],Frame,State)), 820 l_xvarx(Var), 821 nop(setup_call_cleanup(true,(true;(State=state(redoing))),setarg(1,State,exited)))))). 822 823xnr_var(Cmp,Var):- nonvar(Var) ->true; (get_attr(Var,xnr,_)->true;(gensym(xnr_,Id),put_attr(Var,xnr,old_vals(Var,Cmp,Id,[])))). 824xnrattr_unify_hook(AttValue,VarValue):- 825 ((prolog_current_choice(clause_or_top,CP),prolog_choice_attribute(CP,frame,Frame))->true;prolog_current_frame(Frame)), 826 AttValue=old_vals(Var,_Cmp,_Id,WazU,OldFrame,State), 827 nb_setarg(4,AttValue,[VarValue|WazU]), 828 once(has_redos(Frame,OldFrame,N)->true;N=0), 829 (var(State)->(nb_setarg(6,AttValue,N));true), 830 ((N==0) -> 831 ((arg(4,AttValue,List),show_frame_and_goal(has_redos(N),Frame),merge_compatibles(List,Set),!, 832 (member(X,Set),attv_bind(Var,X))));(show_frame_and_goal(has_redos(N),Frame),fail)). 833 834 835% :- ain(((((deduce_neg(P):- _), \+ (deduce_tru(P):-_))) ==> ((deduce_tru(P):- on_bind(P, \+ deduce_neg(P)))))). 836 837xnr(Goal):-term_variables(Goal,Vars),xnr(Vars,Goal). 838 839xnr([A],Goal):- xnr_var(A),!,. 840xnr([A|AA],Goal):- xnr_var(xnr_dif_l,[A|AA]),!,. 841xnr(_,Goal):-,!. 842 843has_redos(CPFrame,OldCPFrame,0):- OldCPFrame==CPFrame,!. 844 845has_redos(CPFrame,OldCPFrame,N):- 846 (prolog_frame_attribute(CPFrame,parent,Parent),has_redos(Parent,OldCPFrame,Nm1)), 847 (prolog_frame_attribute(CPFrame,has_alternatives,true)-> ( N is Nm1 + 1) ; N is Nm1). 848 849 850prolog_current_choice(Type,CPO):-prolog_current_choice(CP),prolog_current_choice(Type,CP,CPO). 851prolog_current_choice(Type,CP,CPO):-prolog_choice_attribute(CP,type,WasType),(call(Type,WasType) -> CP=CPO ; 852 (prolog_choice_attribute(CP,parent,CPP)->prolog_current_choice(Type,CPP,CPO);CPO=null)). 853 854 855/* 856xnr:attr_unify_hook(AttValue,VarValue):- 857 AttValue=old_vals(_Var,_Cmp,_Id,WazU,_Frame,_CP), 858 (WazU = [Old|Waz] -> 859 xnr_attr_unify_hook(AttValue,Old,Waz,VarValue) 860 ; nb_setarg(4,AttValue,[VarValue])). 861*/ 862 863xnr_attr_unify_hook(_,Old,Waz,VarValue):- member_eqz(VarValue,[Old|Waz]),!,fail. 864xnr_attr_unify_hook(AttValue,Old,Waz,VarValue):- (is_existential(Old);is_existential(VarValue)),xnr_attr_unify_hook_ex(AttValue,Old,Waz,VarValue). 865xnr_attr_unify_hook(AttValue,Old,Waz,VarValue):- (var(Old);var(VarValue)),!,nb_setarg(4,AttValue,[VarValue,Old|Waz]). 866xnr_attr_unify_hook(AttValue,Old,Waz,VarValue):- Old\=@=VarValue,!,nb_setarg(4,AttValue,[VarValue,Old|Waz]). 867 868xnr_attr_unify_hook_ex(AttValue,Old,Waz,VarValue):- ( \+ \+ (Old=VarValue) ),!, 869 nb_setarg(4,AttValue,[VarValue,Old|Waz]),member(VarValue,[Old|Waz]). 870 871xnr_attr_unify_hook_ex(AttValue,Old,Waz,VarValue):- nb_setarg(4,AttValue,[VarValue,Old|Waz]). 872 873 874xnrattribute_goals(_Var) --> !. 875xnrattribute_goals(Var) --> {fail}, 876 ({is_existential(Var)} -> [] ; [xnr_var(Var)]). 877 878xnr_dif(Old,VarValue):- Old\==VarValue,!,fail. 879xnr_dif(Old,VarValue):- (is_existential(Old);is_existential(VarValue)),!,=(Old,VarValue),!,get_attrs(Old,Attrs),nb_put_attrs(Old,Attrs),!,fail. 880xnr_dif(Old,VarValue):- (is_fort(Old);is_fort(VarValue)),!,\=(Old,VarValue). 881xnr_dif(Old,VarValue):- (var(Old);var(VarValue)),!. 882xnr_dif(Old,VarValue):- is_list(Old),!,xnr_dif_l(Old,VarValue). 883xnr_dif(Old,VarValue):- nonvar(VarValue),Old\=@=VarValue. 884 885xnr_dif_l([A|Old],[B|VarValue]):- !,(xnr_dif(A,B);xnr_dif_l(Old,VarValue)). 886xnr_dif_l(_,_). 887 888merge_compatibles([],[]):-!. 889merge_compatibles([N],[N]):-!. 890merge_compatibles([N|List],ListOut):- 891 member(N,List) *-> merge_compatibles(List,ListOut); 892 (merge_compatibles(List,ListMid),ListOut=[N|ListMid]). 893 894 895 896existential_var(Var,_):- nonvar(Var),!. 897existential_var(Var,_):- attvar(Var),!. 898existential_var(Var,P):- put_attr(Var,x,P),!. 899 900 901:- meta_predicate add_constraint_ex(,,). 902 % add_constraint_ex(_Call,_P,_V):-!,fail. 903add_constraint_ex(_,P,V):- \+ contains_var(V,P),!. 904add_constraint_ex(_,P,V):- add_cond(V,P),!. 905add_constraint_ex(Call,P,V):-freeze(V,call(Call,V,P)). 906 907 908unify_two(AN,AttrX,V):- nonvar(V),!, (V='$VAR'(_)->true;throw(unify_two(AN,AttrX,V))). 909unify_two(AN,AttrX,V):- get_attr(V,AN,OAttr),!,OAttr=@=AttrX,!. % ,show_call(OAttr=@=AttrX). 910unify_two(AN,AttrX,V):- put_attr(V,AN,AttrX). 911 912 913 914add_cond_list_val(_,_,_,[]):- !. 915add_cond_list_val(Pred1,_,X,[Y]):- atom(Pred1), X==Y -> true;P=..[Pred1,X,Y],add_cond(X,P). 916add_cond_list_val(Pred1,Pred,X,FreeVars):- list_to_set(FreeVars,FreeVarSet),FreeVars\==FreeVarSet,!, 917 add_cond_list_val(Pred1,Pred,X,FreeVarSet). 918add_cond_list_val(_Pred,Pred,X,FreeVars):- P=..[Pred,X,FreeVars],add_cond(X,P). 919 920 921:- meta_predicate never_cond(,). 922never_cond(Var,nesc(b_d(_,nesc,poss), ~ P )):- !, ensure_cond(Var,poss(P)). 923never_cond(Var,nesc(~ P )):- !, ensure_cond(Var,poss(P)). 924never_cond(Var,(~ P )):- !, ensure_cond(Var,poss(P)). 925never_cond(NonVar,Closure):- nonvar(NonVar),!, \+ call_e_tru(NonVar,Closure). 926never_cond(_Var,Closure):- ground(Closure),!, call_u(~Closure). 927never_cond(Var,Closure):- attvar(Var),!,add_cond(Var,~Closure). 928%never_cond(Var,Closure):- add_cond(Var,Closure). 929 930 931private_cond(iza_id(_)). 932local_cond(iza_id(_)). 933 934not_nameOf(Ex,V):- \+ nesc(isNamed(Ex,V)). 935 936var_plain(Var):-var(Var), \+ attvar(Var). 937 938:- module_transparent(isNamed_impl/2). 939:- module_transparent(isNamed_const_var/2). 940:- module_transparent(isNamed_var/2). 941 942isNamed_impl(Var,Str):- Var=@=Str,!. 943isNamed_impl(Var,Str):- atom(Str),!,as_existential(Str,SVar),!,SVar=Var. 944isNamed_impl(Var,Str):- var(Var),!,isNamed_var(Var,Str). 945isNamed_impl(Var,Str):- atom(Var),!,as_existential(Var,X),!,isNamed_var(X,Str). 946isNamed_impl(Var,Str):- !, Var=Str. 947isNamed_impl(Var,Str):- isNamed_const_var(Var,Str). 948 949 950isNamed_const_var(Var,Str):- compound(Str),!,proven_tru(isNamed(Var,Str)). 951isNamed_const_var(Var,Str):- number(Var),!,number_string(Var,Str). 952isNamed_const_var(Var,Str):- atomic(Var),!,text_to_string(Var,Str). 953isNamed_const_var(Var,Str):- term_string(Var,Str). 954 955 956 957 958isNamed_var(Var,Str):- var_plain(Var),var_plain(Str),!,strip_module(_,M,_), 959 my_when((nonvar(Str);nonvar(Var);?=(Var,Str)),M:isNamed(Var,Str)). 960isNamed_var(Var,Str):- nonvar(Str),(has_cond(Var,isNamed(Var,V0));has_cond(Var,aoc(isNamed,V0))),!,text_to_string(V0,Str). 961isNamed_var(Var,Str):- nrlc(proven_tru(isNamed(Var,Str))). 962isNamed_var(Var,Str):- nonvar(Str),!,add_cond(Var,isNamed(Var,Str)),add_cond(Var,aoc(isNamed,Str)),!,add_var_to_env(Str,Var). 963isNamed_var(Var,Str):- var(Str),(has_cond(Var,isNamed(Var,Str));has_cond(Var,aoc(isNamed,Str))),!, 964 (nonvar(Str)->add_var_to_env(Str,Var);true). 965 966% isNamed_impl(Var,Str):- proven_tru(isNamed(Var,Str)). 967% isNamed_impl(Var,Str):- var(Str),!,add_cond(Var,isNamed(Var,Str)),!. 968 969:- export(isNamed_impl/2). 970:- baseKB:import(isNamed_impl/2). 971:- module_transparent(baseKB:isNamed/2). 972baseKBisNamed(X,Y):- strip_module(_,M,_),M:isNamed_impl(X,Y). 973 974%:- ain((mtHybrid(Mt)==> {kb_local(Mt:isNamed/2)})). 975 976nrlc(G):- no_repeats(loop_check(G,(((dmsg(warn(looped(G)))),fail)))). 977 978 979% Translate attributes from this module to residual goals 980izaattribute_goals(X) --> 981 { mtc_get_attr(X, iza, List) },!, 982 [add_cond(X, List)].
988as_constraint_for(Arg,isa(AArg,FA),FA):- \+ kif_option_value(iza_atoms,false), atom(FA),AArg==Arg,!. 989as_constraint_for(Arg,ISA,FA):- \+ kif_option_value(iza_atoms,false), compound(ISA), ISA=..[FA,AArg],AArg==Arg,!. 990as_constraint_for(Arg,props(AArg,FA),props(FA)):- \+ kif_option_value(iza_atoms,false), atom(FA),AArg==Arg,!. 991as_constraint_for(Arg,PROP,props(ASPROP)):- \+ kif_option_value(iza_atoms,false), compound(PROP), PROP=..[FA,AArg|Rest],AArg==Arg,ASPROP=..[FA|Rest]. 992as_constraint_for(_,FA,FA). 993 994 995add_cond_rev(Prop,Var):- add_cond(Var,Prop). 996 997:- meta_predicate ensure_cond(,). 998:- module_transparent(ensure_cond/1). 999ensure_cond(Var,Closure):-!, add_cond(Var,Closure). 1000ensure_cond(NonVar,Closure):- nonvar(NonVar),!,call_e_tru(NonVar,Closure). 1001ensure_cond(Var,Closure):- is_existential(Var),!,show_failure(add_cond(Var,Closure)). 1002ensure_cond(Var,Closure):- attvar(Var),!,show_failure(add_cond(Var,Closure)). 1003ensure_cond(Var,Closure):- as_existential(Var,VarX),must(add_cond(VarX,Closure)),!. 1004 1005add_cond(Var,Prop):- is_list(Prop),!,as_existential(Var,VarX),obtain_conds(VarX,Dom1),!,maplist(add_cond3(VarX,Dom1),Prop). 1006add_cond(Var,Prop):- as_existential(Var,VarX),obtain_conds(VarX,Dom1),add_cond3(VarX,Dom1,Prop). 1007 1008add_cond1(Var,Prop):- obtain_conds(Var,Dom1),add_cond3(Var,Dom1,Prop). 1009 1010add_cond3(Var,Dom1,Prop):- as_constraint_for(Var,Prop,Constraint), 1011 show_failure(( \+ rejects_cond(Constraint,Dom1))), 1012 ord_union(Dom1, [Constraint], NewDomain), 1013 mtc_put_attr(Var,iza,NewDomain). 1014 1015 1016:- meta_predicate map_one_or_list(,). 1017 1018 1019map_one_or_list(Call2,ArgOrL):- is_list(ArgOrL)->maplist(Call2,ArgOrL);call(Call2,ArgOrL). 1020 1021has_cond(Var,Prop):- obtain_conds(Var,Doms),map_one_or_list(has_cond(Doms,Var),Prop). 1022has_cond(Doms,Var,Prop):- as_constraint_for(Var,Prop,C),member(C,Doms). 1023 1024rem_cond(Var,Prop):- obtain_conds(Var,Doms),map_one_or_list(rem_cond(Doms,Var),Prop). 1025rem_cond(Doms,Var,Prop):- as_constraint_for(Var,Prop,C),select(C,Doms,NewDoms),mtc_put_attr(Var,iza,NewDoms). 1026 1027not_has_cond(Var,Prop):- obtain_conds(Var,Doms),map_one_or_list(not_has_cond(Doms,Var),Prop). 1028not_has_cond(Doms,Var,Prop):- \+ has_cond(Doms,Var,Prop).
1037:- module_transparent(chk_cond/2). 1038chk_cond(_,_):- local_override(no_kif_var_coroutines,G),!,call(G). 1039chk_cond(E,Cs):- once(call_cond(E,Cs)). 1040 1041 1042:- module_transparent(call_cond/2). 1043:- module_transparent(call_cond_x/2).
1048call_cond(Var):- as_existential(Var,X),obtain_conds(X,Conds),call_cond_x(X,Conds). 1049call_cond(Var,Conds):- is_fort(Var),!,as_existential(Var,X),call_cond_x(X,Conds). 1050call_cond(Var,Conds):- call_cond_x(Var,Conds). 1051 1052call_cond_x(Y, [H|List]):- ground(Y),!,cond_call0(Y,H),!,cond_call00(Y, List). 1053call_cond_x(Y, [H|List]):- !,maplist(cond_call0(Y),[H|List]). 1054call_cond_x(_, _). 1055 1056cond_call00(Y, [H|List]):-!,cond_call0(Y,H),!,cond_call00(Y, List). 1057cond_call00(_, _). 1058 1059cond_call0(Y,H):- atom(H),!,nesc(isa(Y,H)). 1060cond_call0(_,dif_objs(X,Y)):-!,X\==Y. 1061cond_call0(Y,props(H)):- ereq(props(Y,H)). 1062cond_call0(Y,H):- arg(_,H,E),Y==E,!,call_u(H). 1063cond_call0(_,H):- call_u(H). 1064 1065 1066 1067/* 1068enforce_fa_unify_hook([Goal|ArgIsas],Value):- !, 1069 enforce_fa_call(Goal,Value), 1070 enforce_fa_unify_hook(ArgIsas,Value). 1071enforce_fa_unify_hook(_,_). 1072 1073enforce_fa_call(Goal,Value):- atom(Goal),!,call(Goal,Value). 1074enforce_fa_call(Goal,Value):- arg(_,Goal,Var),Var==Value,!,call(Goal). 1075enforce_fa_call(Goal,Value):- prepend_arg(Goal,Value,GVoal),!,call(GVoal). 1076 1077prepend_arg(M:Goal,Value,M:GVoal):- !, prepend_arg(Goal,Value,GVoal). 1078prepend_arg(Goal,Value,GVoal):- Goal=..[F|ARGS],GVoal=..[F,Value|ARGS]. 1079*/ 1080 1081/* 1082 1083 G=(loves(X,Y),~knows(Y,tHuman(X))),args_enforce(G,Out),maplist(call,Out). 1084 1085*/
1092attribs_to_atoms(ListA,List):-map_subterms(attribs_to_atoms0,ListA,List).1101map_subterms(Pred,I,O):-is_list(I),!,maplist(map_subterms(Pred),I,O). 1102map_subterms(Pred,I,O):-call(Pred,I,O),!. 1103map_subterms(Pred,I,O):-compound(I),!,I=..IL,maplist(map_subterms(Pred),IL,OL),O=..OL. 1104map_subterms(_Pred,IO,IO).
1113condz_to_isa(Iza,ftTerm):-var(Iza),!. 1114condz_to_isa((A,B),isAnd(ListO)):-!,conjuncts_to_list((A,B),List),list_to_set(List,Set),min_cond_l(Set,ListO). 1115condz_to_isa((A;B),isOr(Set)):-!,conjuncts_to_list((A,B),List),list_to_set(List,Set). 1116condz_to_isa(AA,AB):-must(AA=AB).
1125attribs_to_atoms0(Var,Isa):-mtc_get_attr(Var,iza,Iza),!,must(condz_to_isa(Iza,Isa)). 1126attribs_to_atoms0(O,O):- \+ (compound(O)).
1133min_cond_l(List,ListO):-isa_pred_l(lambda(Y,X,sub_super(X,Y)),List,ListO).
1141max_cond_l(List,ListO):-isa_pred_l(sub_super,List,ListO).
1149isa_pred_l(Pred,List,ListO):-isa_pred_l(Pred,List,List,ListO).1158isa_pred_l(_Pred,[],_List,[]). 1159isa_pred_l(Pred,[X|L],List,O):-member(Y,List),X\=Y,call_u(call(Pred,X,Y)),!,isa_pred_l(Pred,L,List,O). 1160isa_pred_l(Pred,[X|L],List,[X|O]):-isa_pred_l(Pred,L,List,O).
1169min_cond([H],In,Out):- !, min_cond0(H,In,Out). 1170min_cond([H|T],In,Out):- !, min_cond0(H,In,Mid),min_cond(T,Mid,Out). 1171min_cond(E,In,Out):- min_cond0(E,In,Out). 1172 1173min_cond0(HintA,[],[HintA]). 1174min_cond0(HintA,[HintB|HintL],[HintB|HintL]):- HintA==HintB,!. 1175min_cond0(HintA,[HintB|HintL],[HintA,HintB|HintL]):- functor(HintA,_,A),functor(HintB,_,B),B>A,!. 1176min_cond0(HintA,[HintB|HintL],[HintA|HintL]):- sub_super(HintA,HintB),!. 1177min_cond0(HintA,[HintB|HintL],[HintB|HintL]):- sub_super(HintB,HintA),!. 1178min_cond0(HintA,[HintB|HintL],[HintB|HintS]):- !,min_cond0(HintA,HintL,HintS). 1179 1180 1181 1182sub_super(Col1,Col2):- tCol(Col1),!,genls(Col1,Col2).
1188max_cond([H],In,Out):- !, max_cond0(H,In,Out). 1189max_cond([H|T],In,Out):- !, max_cond0(H,In,Mid),max_cond(T,Mid,Out). 1190max_cond(E,In,Out):- max_cond0(E,In,Out). 1191 1192max_cond0(HintA,[],[HintA]). 1193max_cond0(HintA,[HintB|HintL],[HintB|HintL]):- HintA==HintB,!. 1194max_cond0(HintA,[HintB|HintL],[HintA,HintB|HintL]):- functor(HintA,_,A),functor(HintB,_,B),B>A,!. 1195max_cond0(HintA,[HintB|HintL],[HintA|HintL]):- sub_super(HintB,HintA),!. 1196max_cond0(HintA,[HintB|HintL],[HintB|HintL]):- sub_super(HintA,HintB),!. 1197max_cond0(HintA,[HintB|HintL],[HintB|HintS]):- !,max_cond0(HintA,HintL,HintS). 1198 1199 1200 1201 1202 1203:- style_check(-singleton).
1212unrelax(X):-copy_term(X,X,Gs),maplist(iz_member,Gs).1221iz_member(iz(X,List)):-!,member(X,List). 1222iz_member(G):-. 1223 1224 1225:- style_check(-singleton).
1232attempt_attribute_args(_AndOr,Hint,Var):- var(Var),add_cond(Var,Hint),!. 1233attempt_attribute_args(_AndOr,_Hint,Grnd):-ground(Grnd),!. 1234attempt_attribute_args(_AndOr,_Hint,Term):- \+ (compound(Term)),!. 1235attempt_attribute_args(AndOr,Hint,+(A)):-!,attempt_attribute_args(AndOr,Hint,A). 1236attempt_attribute_args(AndOr,Hint,-(A)):-!,attempt_attribute_args(AndOr,Hint,A). 1237attempt_attribute_args(AndOr,Hint,?(A)):-!,attempt_attribute_args(AndOr,Hint,A). 1238attempt_attribute_args(AndOr,Hint,(A,B)):-!,attempt_attribute_args(AndOr,Hint,A),attempt_attribute_args(AndOr,Hint,B). 1239attempt_attribute_args(AndOr,Hint,[A|B]):-!,attempt_attribute_args(AndOr,Hint,A),attempt_attribute_args(AndOr,Hint,B). 1240attempt_attribute_args(AndOr,Hint,(A;B)):-!,attempt_attribute_args(';'(AndOr),Hint,A),attempt_attribute_args(';'(AndOr),Hint,B). 1241attempt_attribute_args(_AndOr,_Hint,Term):- use_was_isa(Term,I,C), add_cond(I,C). 1242attempt_attribute_args(AndOr,_Hint,Term):- Term=..[F,A],tCol(F),!,attempt_attribute_args(AndOr,F,A). 1243attempt_attribute_args(AndOr,Hint,Term):- Term=..[F|ARGS],!,attempt_attribute_args(AndOr,Hint,F,1,ARGS).
1252attempt_attribute_args(_AndOr,_Hint,_F,_N,[]):-!. 1253attempt_attribute_args(AndOr,_Hint,t,1,[A]):-attempt_attribute_args(AndOr,callable,A). 1254attempt_attribute_args(AndOr,Hint,t,N,[A|ARGS]):-atom(A),!,attempt_attribute_args(AndOr,Hint,A,N,ARGS). 1255attempt_attribute_args(_AndOr,_Hint,t,_N,[A|_ARGS]):- \+ (atom(A)),!. 1256attempt_attribute_args(AndOr,Hint,F,N,[A|ARGS]):-attempt_attribute_one_arg(Hint,F,N,A),N2 is N+1,attempt_attribute_args(AndOr,Hint,F,N2,ARGS).
1265attempt_attribute_one_arg(_Hint,F,N,A):-call_u(argIsa(F,N,Type)),Type\=ftTerm, \+ (compound(Type)),!,attempt_attribute_args(and,Type,A). 1266attempt_attribute_one_arg(_Hint,F,N,A):-call_u(argQuotedIsa(F,N,Type)),Type\=ftTerm, \+ (compound(Type)),!,attempt_attribute_args(and,Type,A). 1267attempt_attribute_one_arg(_Hint,F,N,A):-call_u(argIsa(F,N,Type)),Type\=ftTerm,!,attempt_attribute_args(and,Type,A). 1268attempt_attribute_one_arg(_Hint,F,N,A):-attempt_attribute_args(and,argi(F,N),A). 1269 1270 1271 1272:- was_export((samef/2,same/2)).
1280same(X,Y):- samef(X,Y),!. 1281same(X,Y):- compound(X),arg(1,X,XX)->same(XX,Y),!. 1282same(Y,X):- compound(X),arg(1,X,XX),!,same(XX,Y).
1291samef(X,Y):- quietly(((to_functor(X,XF),to_functor(Y,YF),(XF=YF->true;string_equal_ci(XF,YF))))).1300to_functor(A,O):-is_ftVar(A),!,A=O. 1301to_functor(A,O):-compound(A),get_functor(A,O),!. % ,to_functor(F,O). 1302to_functor(A,A). 1303 1304:- was_export(arg_to_var/3).
1312arg_to_var(_Type,_String,_Var). 1313 1314:- was_export(same_arg/3).
1323same_arg(_How,X,Y):-var(X),var(Y),!,X=Y. 1324same_arg(equals,X,Y):-!,equals_call(X,Y). 1325same_arg(tCol(_Type),X,Y):-!, unify_with_occurs_check(X,Y). 1326 1327same_arg(ftText,X,Y):-(var(X);var(Y)),!,X=Y. 1328same_arg(ftText,X,Y):-!, string_equal_ci(X,Y). 1329 1330same_arg(same_or(equals),X,Y):- same_arg(equals,X,Y). 1331same_arg(same_or(sub_super),X,Y):- same_arg(equals,X,Y). 1332same_arg(same_or(sub_super),Sub,Sup):- holds_t(sub_super,Sub,Sup),!. 1333same_arg(same_or(isa),X,Y):- same_arg(equals,X,Y). 1334same_arg(same_or(isa),I,Sup):- !, holds_t(Sup,I),!. 1335 1336same_arg(same_or(_Pred),X,Y):- same_arg(equals,X,Y). 1337same_arg(same_or(Pred),I,Sup):- holds_t(Pred,I,Sup),!. 1338 1339% same_arg(I,X):- promp_yn('~nSame Objects: ~q== ~q ?',[I,X]).
1347promp_yn(Fmt,A):- format(Fmt,A),get_single_char(C),C=121. 1348 1349 1350 1351% :-swi_module(iz, [ iz/2 ]). % Var, ?Domain 1352:- use_module(library(ordsets)).
1358:- was_export(iz/2). 1359 1360iz(X, Dom) :- var(Dom), !, mtc_get_attr(X, iz, Dom). 1361% iz(X, Dom) :- var(Dom), !, (mtc_get_attr(X, iz, Dom)->true;mtc_put_attr(X, iz, [iziz(Dom)])). 1362iz(X, List) :- 1363 listify(List,List0), 1364 list_to_ord_set(List0, Domain), 1365 mtc_put_attr(Y, iz, Domain), 1366 X = Y. 1367 1368:- was_export(extend_iz_member/2).
1376extend_iz_member(X, DomL):- init_iz(X, Dom2), ord_union(Dom2, DomL, NewDomain),mtc_put_attr( X, iz, NewDomain ). 1377 1378:- was_export(extend_iz/2).
1386extend_iz(X, DomE):- init_iz(X, Dom2),ord_add_element(Dom2, DomE, NewDomain),mtc_put_attr( X, iz, NewDomain ). 1387 1388:- was_export(init_iz/2).
1396init_iz(X,Dom):-mtc_get_attr(X, iz, Dom),!. 1397init_iz(X,Dom):-Dom =[_], mtc_put_attr(X, iz, Dom),!. 1398 1399% An attributed variable with attribute value Domain has been 1400% assigned the value Y 1401 1402izattr_unify_hook([Y], Value) :- same(Y , Value),!. 1403izattr_unify_hook(Domain, Y) :- 1404 ( mtc_get_attr(Y, iz, Dom2) 1405 -> ord_intersection(Domain, Dom2, NewDomain), 1406 ( NewDomain == [] 1407 -> fail 1408 ; NewDomain = [Value] 1409 -> same(Y , Value) 1410 ; mtc_put_attr(Y, iz, NewDomain) 1411 ) 1412 ; var(Y) 1413 -> mtc_put_attr( Y, iz, Domain ) 1414 ; (\+ \+ (cmp_memberchk_0(Y, Domain))) 1415). 1416 1417 1418 1419% Translate attributes from this module to residual goals 1420izattribute_goals(X) --> { mtc_get_attr(X, iz, List) },!,[iz(X, List)]. 1421 1422 1423 1424%iz:attr_portray_hook(Val, _) :- write('iz:'), write(Val),!. 1425 1426%iza:attr_portray_hook(Val, _) :- write('iza:'), write(Val),!.
1433cmp_memberchk_0(X,Y):-numbervars(X,0,_,[attvars(skip)]),member(X,Y),!.1441cmp_memberchk_00(Item, [X1,X2,X3,X4|Xs]) :- !, 1442 compare(R4, Item, X4), 1443 ( R4 = (>) -> cmp_memberchk_00(Item, Xs) 1444 ; R4 = (<) -> 1445 compare(R2, Item, X2), 1446 ( R2 = (>) -> Item = X3 1447 ; R2 = (<) -> Item = X1 1448 ;/* R2 = (=), Item = X2 */ true 1449 ) 1450 ;/* R4 = (=) */ true 1451 ). 1452cmp_memberchk_00(Item, [X1,X2|Xs]) :- !, 1453 compare(R2, Item, X2), 1454 ( R2 = (>) -> cmp_memberchk_00(Item, Xs) 1455 ; R2 = (<) -> Item = X1 1456 ;/* R2 = (=) */ true 1457 ). 1458cmp_memberchk_00(Item, [X1]) :- 1459 Item = X1. 1460 1461 1462:- meta_predicate(call_engine_m(,,,)). 1463call_engine_m(Templ,Goal,Engine,Det):- 1464 call_engine_start_m(Templ,Goal,Engine), 1465 call_engine_next_m(Engine,Templ,Det). 1466 1467:- meta_predicate(call_engine_start_m(,,)). 1468call_engine_start_m(Templ,Goal,Engine):- 1469 engine_create(Templ-TF0,(Goal,deterministic(TF0)),Engine). 1470 1471call_engine_next_m(Engine,Templ,Det):- 1472 repeat, 1473 engine_next(Engine,Templ-Det), 1474 (Det==true->!;true). 1475 1476metapred_plus(_,_):-!. 1477metapred_plus(Cmp,Plus):- 1478 (\+ compound(Cmp) -> S=0 ; compound_name_arity(Cmp,F,S)), 1479 A is S + Plus, 1480 current_predicate(F/A),!. 1481metapred_plus(_,_). 1482 1483not_dif_objs(A,B):- \+ dif_objs(A,B). 1484 1485:- meta_predicate(pred1_to_unique_pairs(,,)). 1486pred1_to_unique_pairs(Pred1,Obj1,Obj2):- 1487 sanity(assertion(metapred_plus(Pred1,1))), 1488 lazy_findall(Elem,call(Pred1,Elem),List), 1489 list_to_unique_pairs(List,Obj1,Obj2). 1490 1491:- meta_predicate(pred1_to_unique_pairs_confirmed(,,)). 1492pred1_to_unique_pairs_confirmed(Pred1,Obj1,Obj2):- 1493 Tracker = '$t'([]), 1494 Same2 = not_dif_objs, 1495 pred1_to_unique_pairs(Pred1,ObjA,ObjB), 1496 different_pairs(Same2,Tracker,ObjA,ObjB,Obj1,Obj2). 1497 1498list_to_unique_pairs(List,Obj1,Obj2):- 1499 append(_Left,[Obj1|Rest],List),member(Obj2,Rest). 1500 1501:- meta_predicate different_pairs(,,,,,). 1502different_pairs(Same2,Tracker,ObjA,ObjB,Obj1,Obj2):- 1503 Test = p(TObj1,TObj2), 1504 zotrace(sanity((must_be(compound,Tracker), 1505 assertion(metapred_plus(Pred2InstsDiff,2))))), 1506 zotrace((\+ call(Same2, ObjA, ObjA))), 1507 zotrace((( ObjA @> ObjB -> (ObjA = Obj1, ObjB = Obj2) ; (ObjA = Obj2, ObjB = Obj1)))), 1508 must(arg(1,Tracker,PrevPairs)), 1509 (((member(Test,PrevPairs),call(Same2,Obj1,TObj1),call(Same2,Obj2,TObj2)))-> fail ; true), 1510 must(nb_setarg(1,Tracker,[p(Obj1,Obj2)|PrevPairs])).
1526=@@=(X,Y):-!, ==(X,Y). 1527% =@@=(X,Y):- (attvar(X);attvar(Y))-> X==Y ;((var(X);var(Y))-> X==Y ; X=@=Y). 1528 1529:- op(700,xfx,user:('=@@=')). 1530 1531% difv(_X,_Y):-!. 1532difv(X,Y) :- 1533 \+ (X =@@= Y), 1534 difv_c_c(X,Y,_). 1535 1536difv_unifiable(X, Y, Us) :- 1537 ( current_prolog_flag(occurs_check, error) -> 1538 catch(unifiable(X,Y,Us), error(occurs_check(_,_),_), false) 1539 ; unifiable(X, Y, Us) 1540 ). 1541 1542difv_c_c(X,Y,OrNode) :- 1543 ( difv_unifiable(X, Y, Unifier) -> 1544 ( Unifier == [] -> 1545 or_one_failv(OrNode) 1546 ; 1547 difv_c_c_l(Unifier,OrNode) 1548 ) 1549 ; 1550 or_succeedv(OrNode) 1551 ). 1552 1553 1554difv_c_c_l(Unifier,OrNode) :- 1555 length(Unifier,N), 1556 extend_ornodevv(OrNode,N,List,Tail), 1557 difv_c_c_l_aux(Unifier,OrNode,List,Tail). 1558 1559extend_ornodevv(OrNode,N,List,Vars) :- 1560 ( get_attr(OrNode,difv,Attr) -> 1561 Attr = nodev(M,Vars), 1562 O is N + M - 1 1563 ; 1564 O = N, 1565 Vars = [] 1566 ), 1567 put_attr(OrNode,difv,nodev(O,List)). 1568 1569difv_c_c_l_aux([],_,List,List). 1570difv_c_c_l_aux([X=Y|Unifier],OrNode,List,Tail) :- 1571 List = [X=Y|Rest], 1572 add_ornodevv(X,Y,OrNode), 1573 difv_c_c_l_aux(Unifier,OrNode,Rest,Tail). 1574 1575add_ornodevv(X,Y,OrNode) :- 1576 add_ornodev_var1(X,Y,OrNode), 1577 ( var(Y) -> 1578 add_ornodev_var2(X,Y,OrNode) 1579 ; 1580 true 1581 ). 1582 1583add_ornodev_var1(X,Y,OrNode) :- 1584 ( get_attr(X,difv,Attr) -> 1585 Attr = vardifv(V1,V2), 1586 put_attr(X,difv,vardifv([OrNode-Y|V1],V2)) 1587 ; 1588 put_attr(X,difv,vardifv([OrNode-Y],[])) 1589 ). 1590 1591add_ornodev_var2(X,Y,OrNode) :- 1592 ( get_attr(Y,difv,Attr) -> 1593 Attr = vardifv(V1,V2), 1594 put_attr(Y,difv,vardifv(V1,[OrNode-X|V2])) 1595 ; 1596 put_attr(Y,difv,vardifv([],[OrNode-X])) 1597 ). 1598 1599difvattr_unify_hook(vardifv(V1,V2),Other) :- 1600 ( var(Other) -> 1601 reverse_lookupsv(V1,Other,OrNodes1,NV1), 1602 or_one_failvsv(OrNodes1), 1603 get_attr(Other,difv,OAttr), 1604 OAttr = vardifv(OV1,OV2), 1605 reverse_lookupsv(OV1,Other,OrNodes2,NOV1), 1606 or_one_failvsv(OrNodes2), 1607 remove_obsoletev(V2,Other,NV2), 1608 remove_obsoletev(OV2,Other,NOV2), 1609 append(NV1,NOV1,CV1), 1610 append(NV2,NOV2,CV2), 1611 ( CV1 == [], CV2 == [] -> 1612 del_attr(Other,difv) 1613 ; 1614 put_attr(Other,difv,vardifv(CV1,CV2)) 1615 ) 1616 ; 1617 verify_compoundsv(V1,Other), 1618 verify_compoundsv(V2,Other) 1619 ). 1620 1621remove_obsoletev([], _, []). 1622remove_obsoletev([N-Y|T], X, L) :- 1623 ( Y=@@=X -> 1624 remove_obsoletev(T, X, L) 1625 ; L=[N-Y|RT], 1626 remove_obsoletev(T, X, RT) 1627 ). 1628 1629reverse_lookupsv([],_,[],[]). 1630reverse_lookupsv([N-X|NXs],Value,Nodes,Rest) :- 1631 ( X =@@= Value -> 1632 Nodes = [N|RNodes], 1633 Rest = RRest 1634 ; 1635 Nodes = RNodes, 1636 Rest = [N-X|RRest] 1637 ), 1638 reverse_lookupsv(NXs,Value,RNodes,RRest). 1639 1640verify_compoundsv([],_). 1641verify_compoundsv([OrNode-Y|Rest],X) :- 1642 ( var(Y) -> 1643 true 1644 ; OrNode == (-) -> 1645 true 1646 ; 1647 difv_c_c(X,Y,OrNode) 1648 ), 1649 verify_compoundsv(Rest,X). 1650 1651%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1652or_succeedv(OrNode) :- 1653 ( attvar(OrNode) -> 1654 get_attr(OrNode,difv,Attr), 1655 Attr = nodev(_Counter,Pairs), 1656 del_attr(OrNode,difv), 1657 OrNode = (-), 1658 del_or_difv(Pairs) 1659 ; 1660 true 1661 ). 1662 1663or_one_failvsv([]). 1664or_one_failvsv([N|Ns]) :- 1665 or_one_failv(N), 1666 or_one_failvsv(Ns). 1667 1668or_one_failv(OrNode) :- 1669 ( attvar(OrNode) -> 1670 get_attr(OrNode,difv,Attr), 1671 Attr = nodev(Counter,Pairs), 1672 NCounter is Counter - 1, 1673 ( NCounter == 0 -> 1674 fail 1675 ; 1676 put_attr(OrNode,difv,nodev(NCounter,Pairs)) 1677 ) 1678 ; 1679 fail 1680 ). 1681 1682del_or_difv([]). 1683del_or_difv([X=Y|Xs]) :- 1684 cleanup_dead_nodesv(X), 1685 cleanup_dead_nodesv(Y), 1686 del_or_difv(Xs). 1687 1688cleanup_dead_nodesv(X) :- 1689 ( attvar(X) -> 1690 get_attr(X,difv,Attr), 1691 Attr = vardifv(V1,V2), 1692 filter_dead_orsv(V1,NV1), 1693 filter_dead_orsv(V2,NV2), 1694 ( NV1 == [], NV2 == [] -> 1695 del_attr(X,difv) 1696 ; 1697 put_attr(X,difv,vardifv(NV1,NV2)) 1698 ) 1699 ; 1700 true 1701 ). 1702 1703filter_dead_orsv([],[]). 1704filter_dead_orsv([Or-Y|Rest],List) :- 1705 ( var(Or) -> 1706 List = [Or-Y|NRest] 1707 ; 1708 List = NRest 1709 ), 1710 filter_dead_orsv(Rest,NRest). 1711 1712/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1713 The attribute of a variable X is vardifv/2. The first argument is a 1714 list of pairs. The first component of each pair is an OrNode. The 1715 attribute of each OrNode is node/2. The second argument of node/2 1716 is a list of equations A = B. If the LHS of the first equation is 1717 X, then return a goal, otherwise don''t because someone else will. 1718- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 1719 1720difvattribute_goals(Var) --> !. 1721difvattribute_goals(Var) --> 1722 ( { get_attr(Var, difv, vardifv(Ors,_)) } -> 1723 or_nodesv(Ors, Var) 1724 ; or_nodev(Var) 1725 ). 1726 1727or_nodev(O) --> 1728 ( { get_attr(O, difv, nodev(_, Pairs)) } -> 1729 { eqs_lefts_rightsv(Pairs, As, Bs) }, 1730 mydifv(As, Bs), 1731 { del_attr(O, difv) } 1732 ; [] 1733 ). 1734 1735or_nodesv([], _) --> []. 1736or_nodesv([O-_|Os], X) --> 1737 ( { get_attr(O, difv, nodev(_, Eqs)) } -> 1738 ( { Eqs = [LHS=_|_], LHS =@@= X } -> 1739 { eqs_lefts_rightsv(Eqs, As, Bs) }, 1740 mydifv(As, Bs), 1741 { del_attr(O, difv) } 1742 ; [] 1743 ) 1744 ; [] % or-node already removed 1745 ), 1746 or_nodesv(Os, X). 1747 1748mydifv([X], [Y]) --> !, difv_if_necessary(X, Y). 1749mydifv(Xs0, Ys0) --> 1750 { reverse(Xs0, Xs), reverse(Ys0, Ys), % follow original order 1751 X =.. [f|Xs], Y =.. [f|Ys] }, 1752 difv_if_necessary(X, Y). 1753 1754difv_if_necessary(X, Y) --> 1755 ( { difv_unifiable(X, Y, _) } -> 1756 [difv(X,Y)] 1757 ; [] 1758 ). 1759 1760eqs_lefts_rightsv([], [], []). 1761eqs_lefts_rightsv([A=B|ABs], [A|As], [B|Bs]) :- 1762 eqs_lefts_rightsv(ABs, As, Bs).
1768type_size(C,S):-a(completeExtentEnumerable,C),!,setof(E,call_u(t(C,E)),L),length(L,S). 1769type_size(C,1000000):-a(ttExpressionType,C),!. 1770type_size(_,1000). 1771 1772/* 1773 1774?- Z #=:= 2 + X, Z #< 2 . 1775 1776succ(succ(0)). 1777 1778S2I 1779I2E 1780 17812 17822 17832 1784E2S 1785 1786S = succ/1. 1787I = integer 1788E = 2 1789 1790a:p(1). 1791 1792a:p(X):-b:p(X). 1793b:p(X):-c:p(X). 1794 1795b:p(2). 1796 1797*/
1804comp_type(Comp,Col1,Col2):-type_size(Col1,S1),type_size(Col2,S2),compare(Comp,S1,S2). 1805 1806 1807:- fixup_exports. 1808 1809mpred_type_constraints_file.
system:goal_expansion(G,O):- \+ current_prolog_flag(xref,true),\+ pldoc_loading, nonvar(G),boxlog_goal_expansion(G,O).
The difv/2 constraint
*/