25
26:- module(multivar,
27 [
28 test_case_1/0,
29 test_case_2/0,
30 test_case_3/0,
31 test_case_4/0
32 44 ]). 45
46:- use_module(logicmoo_common). 47:- meta_predicate user:attvar_variant(0,0). 48:- use_module(library(option),[dict_options/2,option/2]). 49
50:- export((mdwq/1,
51 plvar/1,
52 nb_var/1, nb_var/2,
53 vdict/1, vdict/2,
54 un_mv/1, un_mv1/1,
55 mv_peek_value/2,mv_peek_value1/2,
56 mv_set_values/2,
57 58 mv_set1/2,
59 mv_add1/2,mv_allow/2,
60 ic_text/1, xvarx/1, is_mv/1, multivar/1)). 61
64
66
67mdwq(Q):- format(user_error,'~NMWQ: ~q~n',[Q]).
68
69:- meta_predicate(mdwq_call(*)). 70mdwq_call(Q):- !, call(Q).
72
73:- define_into_module(system,mdwq_call/1). 74
75:- create_prolog_flag(attr_pre_unify_hook,false,[keep(true)]). 76:- create_prolog_flag(attr_pre_unify_hook,true,[keep(true)]). 77
78
79
80
81:- if(current_prolog_flag(attr_pre_unify_hook,true)). 82
83:- module_transparent(user:attr_pre_unify_hook/3). 84:- user:export(user:attr_pre_unify_hook/3). 85
86:- '$set_source_module'('$attvar'). 87
88:- module_transparent(system : = /2). 89:- module_transparent(wakeup/2). 90:- module_transparent('$wakeup'/1). 91wakeup(wakeup(Attribute, Value, Rest),M) :- !,
92 begin_call_all_attr_uhooks(Attribute, Value, M),
93 '$wakeup'(Rest).
94wakeup(_,_).
95
96:- import(user:attr_pre_unify_hook/3). 97:- module_transparent(user:attr_pre_unify_hook/3). 99begin_call_all_attr_uhooks(att('$VAR$', IDVar, Attrs),Value, M) :- !,
100 M:attr_pre_unify_hook(IDVar, Value, Attrs).
101
102begin_call_all_attr_uhooks(Attribute, Value, M) :-
103 call_all_attr_uhooks(Attribute, Value, M).
104
105:- module_transparent(call_all_attr_uhooks/3). 106call_all_attr_uhooks(att(Module, AttVal, Rest), Value, M) :- !,
107 uhook(Module, AttVal, Value, M),
108 call_all_attr_uhooks(Rest, Value, M).
109call_all_attr_uhooks(_, _, _).
110
111:- module_transparent(uhook/4). 112uhook(freeze, Goal, Y, M) :-
113 M:(
114 !,
115 ( attvar(Y)
116 -> ( get_attr(Y, freeze, G2)
117 -> put_attr(Y, freeze, '$and'(G2, Goal))
118 ; put_attr(Y, freeze, Goal)
119 )
120 ; '$attvar':unfreeze(Goal)
121 )).
122
123uhook(Module, AttVal, Value, M) :-
124 M:(
125 true,
126 Module:attr_unify_hook(AttVal, Value)).
127
128
129:- ((abolish('$wakeup'/1),'$attvar':asserta('$wakeup'(M:G):-wakeup(G,M)))). 130:- meta_predicate('$wakeup'(:)). 131
133:- debug(logicmoo(loader),'~N~p~n',[all_source_file_predicates_are_transparent(File)]),
134 forall((source_file(ModuleName:P,File),functor(P,F,A)),
135 ignore((
136 ignore(( \+ atom_concat('$',_,F), ModuleName:export(ModuleName:F/A))),
137 \+ (predicate_property(ModuleName:P,(transparent))),
138 139 (module_transparent(ModuleName:F/A))))). 140
141:- '$set_source_module'('multivar'). 142
143:- module_transparent(attr_pre_unify_hook_m/4). 144:- dynamic(attr_pre_unify_hook_m/4). 145:- export(attr_pre_unify_hook_m/4). 146attr_pre_unify_hook_m(IDVar, Value, _, M):- \+ attvar(IDVar),!, M:(IDVar=Value).
147attr_pre_unify_hook_m(Var,Value,Rest, M):-
148 mdwq_call('$attvar':call_all_attr_uhooks(Rest, Value, M)),
149 nop(M:mv_add1(Var,Value)).
150
151:- module_transparent(attr_pre_unify_hook/3). 152:- dynamic(attr_pre_unify_hook/3). 153:- export(attr_pre_unify_hook/3). 154attr_pre_unify_hook(Var,Value,Rest):- strip_module(Rest,M,_), attr_pre_unify_hook_m(Var,Value,Rest,M).
155
156
157
158:- else. 159
160
161:- module_transparent(user:meta_unify/3). 162user:meta_unify(Var,Rest,Value):- user:attr_pre_unify_hook(Var,Value,Rest).
163
166
167
168user:attr_pre_unify_hook(IDVar, Value, _):- \+ attvar(IDVar),!, IDVar=Value.
176user:attr_pre_unify_hook(Var,Value,Rest):-
177 mdwq_call('$attvar':call_all_attr_uhooks(Rest, Value)),
178 nop(mv_add1(Var,Value)).
179
180:- endif. 181
182
183
184call_verify_attributes([], _, _) --> [].
185call_verify_attributes(att(Module, _, Rest), Value, IDVar) -->
186 { Module:verify_attributes(IDVar, Value, Goals) },
187 Goals,
188 call_verify_attributes(Rest, Value, IDVar).
189
191use_va(Var):-
192 put_attr(Var,'$VAR$',Var).
193
195
196verify_attributes(Var, _, Goals) :-
197 get_attr(Var, '$VAR$', Info), !,
198 \+ contains_var(Var,Info),
199 Goals=[].
200
201verify_attributes(_, _, []).
202
203
205
206swiu_case_1 :-
207 use_va(Y), put_attr(Y,'$VAR$',Y),
208 Y = 4201.
209
211test_case_1 :- \+ swiu_case_1.
212
213
215
217
218swiu_case_2 :-
219 use_va(Y), put_attr(Y, '$VAR$', al(Y,a(X))),
220 X = 420,
221 Y = 420.
222
224test_case_2 :- \+ swiu_case_2.
225
226
229
230swiu_case_3 :-
231 use_va(Y), put_attr(Y,'$VAR$', a(420)),
232 Y = 420.
233
235test_case_3 :- swiu_case_3.
236
237
238
241
242swiu_case_4 :-
243 use_va(Y), put_attr(Y,'$VAR$', X),
244 X = 420,
245 Y = 420.
246
248test_case_4 :- swiu_case_4.
249
250
254
256
257
260
261xvarx(Var):-
262 get_attr(Var,'$VAR$',_MV)-> true ;
263 (get_attrs(Var,Attrs) -> put_attrs(Var,att('$VAR$',Var,Attrs)) ;
264 (true -> put_attrs(Var,att('$VAR$',Var,[])))).
265:- export(xvarx/1). 266:- system:import(xvarx/1). 267
268
269
271is_mv(Var):- attvar(Var),get_attr(Var,'$VAR$',_Waz).
272
276
277'$VAR$':attr_unify_hook(_,_).
278'$VAR$':attribute_goals(Var) --> {is_implied_xvarx(Var)}->[] ; [xvarx(Var)].
279
280is_implied_xvarx(MV):- get_attrs(MV,ATTS),is_implied_xvarx(MV,ATTS).
281is_implied_xvarx(MV,att(M,Val,ATTS)):- ((Val==MV, \+ atom_concat('$',_,M)) -> true ; is_implied_xvarx(MV,ATTS)).
285
286'variant':attr_unify_hook(_,_).
287user:attvar_variant(N,Var):- (N==Var -> true ; mdwq_call( \+ \+ =(N,Var) )).
288
292
293'references':attr_unify_hook(_,_).
294user:attvar_references(N,Var):- (N==Var -> true ; mdwq_call( \+ \+ =(N,Var) )).
295
296
300multivar(Var):- var(Var)->multivar1(Var);(term_variables(Var,Vars),maplist(multivar1,Vars)).
301multivar1(Var):- xvarx(Var),(get_attr(Var,'$value',some(Var,_))->true; put_attr(Var,'$value',some(Var,[]))).
302'$value':attr_unify_hook(some(Was,Values),Becoming):- var(Was),attvar(Becoming),!,mv_add_values(Becoming,Values).
303'$value':attr_unify_hook(some(Var,_Values),Value):- mv_add1(Var,Value).
304
306'$value':attribute_goals(Var)--> {get_attr(Var,'$value',some(Var,Values))},[mv_set_values(Var,Values)].
307
308
309mv_set_values(Var,Values):- put_attr(Var,'$value',some(Var,Values)).
310mv_set1(Var,Value):- put_attr(Var,'$value',some(Var,[Value])).
311mv_add1(Var,NewValue):- Var==NewValue,!.
312mv_add1(Var,NewValue):- mv_prepend1(Var,'$value',NewValue).
313mv_add_values(Becoming,Values):- maplist(mv_add1(Becoming),Values).
314
315
316mv_prepend1(Var,Mod,Value):- get_attr(Var,Mod,some(Var,Was))->(prepend_val(Value,Was,New)->put_attr(Var,Mod,some(Var,New)));put_attr(Var,Mod,some(Var,[Value])).
317mv_prepend_values(Becoming,Mod,Values):- maplist(mv_prepend1(Becoming,Mod),Values).
318
319prepend_val(Value,[],[Value]).
320prepend_val(Value,Was,[Value|NewList]):- pred_delete_first(call(==,Value),Was,NewList).
321
322pred_delete_first(_,[],[]).
323pred_delete_first(P,[Elem0|NewList],NewList):- call(P,Elem0),!.
324pred_delete_first(P,[ElemKeep|List],[ElemKeep|NewList]):-pred_delete_first(P,List,NewList).
325
327mv_prepend(Var,Mod,Value):- get_attr(Var,Mod,some(Var,Was))->
328 put_attr(Var,Mod,some(Var,[Value|Was]));
329 put_attr(Var,Mod,some(Var,[Value])).
330
334
335mv_peek_value(Var,Value):- mv_members(Var,'$value',Value).
336mv_peek_value1(Var,Value):- mv_peek_value(Var,Value),!.
337
338
339
343
344mv_members(Var,Mod,Value):- get_attr(Var,Mod,some(_,Values)),!,member(Value,Values).
346
347
348bless_plvar(V):- nonvar(V),!.
349bless_plvar(V):- attvar(V),!.
350bless_plvar(V):- xvarx(V),!.
351
352project_lst_goals_as(Var,Attr,Pred,Res):-
353 get_attr(Var,Attr,some(Var,List)),
354 (List==[] -> Res=[] ;
355 List=[V] -> (Call=..[Pred,Var,V], Res=[Call]) ;
356 (Call=..[Pred,Var], Res=[maplist(Call,List)])).
357
361
362check_allow(Var,Value):- get_attr(Var,'$allow',some(Var,Allow)), memberchk_variant_mv(Value,Allow).
363mv_allow(Var,Allow):- bless_plvar(Allow),mv_prepend(Var,'$allow',Allow).
364'$allow':attr_unify_hook(some(Var,Allow),Value):- \+ ((memberchk_variant_mv(Value,Allow)->true;get_attr(Var,ic_text,_))),!,fail.
365'$allow':attr_unify_hook(some(Was,Values),Becoming):-
366 ignore((var(Was),attvar(Becoming),!,mv_prepend_values(Becoming,'$allow',Values))).
367'$allow':attribute_goals(Var)--> {project_lst_goals_as(Var,'$allow',mv_allow,Res)},Res.
368
372
373check_disallow(Var,Value):- (get_attr(Var,'$disallow',some(Var,Disallow)) -> \+ memberchk_variant_mv(Value,Disallow) ; true).
374mv_disallow(Var,Disallow):- bless_plvar(Disallow),mv_prepend(Var,'$disallow',Disallow).
375'$disallow':attr_unify_hook(some(_Var,Disallow),Value):- memberchk_variant_mv(Value,Disallow),!,fail.
376'$disallow':attr_unify_hook(some(Was,Values),Becoming):-
377 ignore((var(Was),attvar(Becoming),!,mv_prepend_values(Becoming,'$disallow',Values))).
378'$disallow':attribute_goals(Var)--> {project_lst_goals_as(Var,'$disallow',mv_disallow,Res)},Res.
379
380
387memberchk_variant_mv(X, List) :- is_list(List),!, \+ atomic(List), C=..[v|List],(var(X)-> (arg(_,C,YY),X==YY) ; (arg(_,C,YY),X =@= YY)),!.
388memberchk_variant_mv(X, Ys) :- nonvar(Ys), var(X)->memberchk_variant0(X, Ys);memberchk_variant1(X,Ys).
389memberchk_variant0(X, [Y|Ys]) :- X==Y ; (nonvar(Ys),memberchk_variant0(X, Ys)).
390memberchk_variant1(X, [Y|Ys]) :- X =@= Y ; (nonvar(Ys),memberchk_variant1(X, Ys)).
391
392
393member_predchk_variant_mv(X, Ys) :- each_from(Ys, E), call(E,X).
394
396each_from(Ys, E) :- nonvar(Ys), Ys=[Y|Ys2], (E=Y ; each_from(Ys2, E)).
398
399
403
405
406check_allow_p(Var,Value):- get_attr(Var,'$allow_p',some(Var,Allow_p)), memberchk_variant_mv(Value,Allow_p).
407mv_allow_p(Var,Allow_p):- bless_plvar(Allow_p),mv_prepend(Var,'$allow_p',Allow_p).
408'$allow_p':attr_unify_hook(some(Var,Allow_p),Value):- \+ ((memberchk_variant_mv(Value,Allow_p)->true;get_attr(Var,ic_text,_))),!,fail.
409'$allow_p':attr_unify_hook(some(Was,Values),Becoming):-
410 ignore((var(Was),attvar(Becoming),!,mv_prepend_values(Becoming,'$allow_p',Values))).
411'$allow_p':attribute_goals(Var)--> {project_lst_goals_as(Var,'$allow_p',mv_allow_p,Res)},Res.
412
416
417check_disallow_p(Var,Value):- (get_attr(Var,'$disallow_p',some(Var,Disallow_p)) -> \+ memberchk_variant_mv(Value,Disallow_p) ; true).
418mv_disallow_p(Var,Disallow_p):- bless_plvar(Disallow_p),mv_prepend(Var,'$disallow_p',Disallow_p).
419'$disallow_p':attr_unify_hook(some(_Var,Disallow_p),Value):- memberchk_variant_mv(Value,Disallow_p),!,fail.
420'$disallow_p':attr_unify_hook(some(Was,Values),Becoming):-
421 ignore((var(Was),attvar(Becoming),!,mv_prepend_values(Becoming,'$disallow_p',Values))).
422'$disallow_p':attribute_goals(Var)--> {project_lst_goals_as(Var,'$disallow_p',mv_disallow_p,Res)},Res.
423
427
428un_mv(Var):-del_attr(Var,'$VAR$')->(mv_peek_value(Var,Value)*->Var=Value;true);true.
429un_mv1(Var):-del_attr(Var,'$VAR$')->ignore(mv_peek_value1(Var,Var));true.
430
431
460plvar(Var):- xvarx(Var),put_attr(Var,plvar,Var),multivar(Var).
462'plvar':attr_unify_hook(Var,Value):- mv_peek_value1(Var,Was)-> Value=Was; mv_set1(Var,Value).
463'plvar':attribute_goals(Var)--> {get_attr(Var,'plvar',VarWas),Var==VarWas},[plvar(Var)].
464
465
467:- meta_predicate multivar_call(1,0). 468multivar_call(Type,Goal):-term_variables(Goal,Vars),maplist(Type,Vars),call(Goal).
469
470
474nb_var(Var):- gensym(nb_var_,Symbol),nb_var(Symbol, Var).
475nb_var(Symbol, Var):- xvarx(Var), put_attr(Var,nb_var,some(Var,Symbol)), nb_linkval(Symbol,Var).
476
480'nb_var':attr_unify_hook(some(_Var,Symbol),Value):-
481 nb_getval(Symbol,Prev),
482 ( 483 (var(Value),nonvar(Prev)) -> Value=Prev;
484 485 Value==Prev->true;
486 487 Value=Prev->nb_setval(Symbol,Prev)).
488
492edict(Var):- xvarx(Var),put_attr(Var,'edict',Var),multivar(Var).
493edict(Value,Var):- edict(Var),Var=Value.
494
495'edict':attr_unify_hook(Var,OValue):-
496 to_dict(OValue,Value),
497 (mv_peek_value(Var,Prev)
498 -> (merge_dicts(Prev,Value,Result)-> mv_set1(Var,Result))
499 ; mv_add1(Var,Value)).
500
501vdict(Var):- put_attr(Var,vdict,Var),multivar(Var).
502vdict(Value,Var):- vdict(Var),Var=Value.
503'vdict':attr_unify_hook(Var,OValue):-
504 to_dict(OValue,Value)-> mv_peek_value(Var,Prev),
505 merge_dicts(Prev,Value,Result)-> mv_set1(Var,Result).
506
507
508to_dict(Value,Value):- is_dict(Value),!.
509to_dict(OValue,Value):- is_list(OValue),!,dict_options(Value,OValue).
510to_dict(OValue,Value):- compound(OValue),!,option(OValue,[MValue]),!,dict_options(Value,[MValue]).
511to_dict(OValue,Value):- option('$value'=OValue,[MValue]),!,dict_options(Value,[MValue]).
512
513
514merge_dicts(Value,Value,Value).
515merge_dicts(Prev,Value,Prev):- Value :< Prev.
516merge_dicts(Value,Prev,Prev):- Value :< Prev.
517merge_dicts(Dict1,Dict2,Combined):- dicts_to_same_keys([Dict1,Dict2],dict_fill(_),[Combined,Combined]).
518
522
523ic_text(Var):- put_attr(Var,ic_text,Var),multivar(Var),!.
524
525'ic_text':attr_unify_hook(Var,Value):- check_disallow(Var,Value),
526 ((mv_members(Var,'$allow',One);mv_peek_value1(Var,One))*-> ic_unify(One,Value)).
527'ic_text':attribute_goals(Var)--> {get_attr(Var,'ic_text',Var)},[ic_text(Var)].
530
531ic_unify(One,Value):- (One=Value -> true ; (term_upcase(One,UC1),term_upcase(Value,UC2),UC1==UC2)).
532
533term_upcase(Value,UC2):-catch(string_upper(Value,UC2),_,(format(string(UC1),'~w',Value),string_upper(UC1,UC2))).
544
545:- system:import((mdwq/1,
546 plvar/1,
547 nb_var/1, nb_var/2,
548 vdict/1, vdict/2,
549 un_mv/1, un_mv1/1,
550 mv_peek_value/2,mv_peek_value1/2,
551 mv_set_values/2,
552 553 mv_set1/2,
554 mv_add1/2,mv_allow/2,
555 ic_text/1, xvarx/1, is_mv/1, multivar/1)). 556:- fixup_exports.