1:- module(hilog,
2 [ expand_var_functors/5, set_functor_wrap/1, unset_functor_wrap/0 ]). 3
4
5:- multifile((system:term_expansion/4,system:term_expansion/2)). 6:- dynamic((system:term_expansion/4,system:term_expansion/2)). 7
8:- thread_local(t_l:disable_px/0). 9
10:- dynamic((var_functor_quote/1,was_allow_variable_name_as_functor/1, var_functor_wrap/1)). 11
12
13compound_or_atom_name_arguments(In,Name,ArgsO):- compound(In),compound_name_arguments(In,Name,ArgsO).
14compound_or_atom_name_arguments(In,Name,ArgsO):- fail,atom(In),Name=In,ArgsO=[].
15
16
17expand_var_functors(T,VFE,Outer,In,Out):-
18 \+ compound(In)->In=Out;
19 (compound_name_arguments(In,Name,Args),
20 ((Args==[],\+ compound(In))->Out=Name;
21 ((Name=VFE,Args=[JustOne] )-> (expand_var_functors(T,VFE,VFE,JustOne,VOut),((nonvar(VOut),functor(VOut,T,_))->Out=VOut;Out=..[VFE,VOut]));
22 ( maplist(expand_var_functors(T,VFE,Name),Args,ArgsO),
23 ((Name\='[|]',Outer=VFE,atom_codes(Name,[C|_]),code_type(C,prolog_var_start),
24 (get_varname_list(Vs)->true;Vs=[]),(member(Name=Var,Vs)->true;put_variable_names( [Name=Var|Vs])))
25 -> Out=..[T,Var|ArgsO]; (Args==ArgsO->(Out=In);compound_name_arguments(Out,Name,ArgsO))))))).
26
27
28system:term_expansion(I,O):- var_functor_wrap(T),
29 compound(I),functor(I,VFE,_), 30 \+ t_l:disable_px,
31 must((locally_tl(disable_px,expand_var_functors(T,VFE,(:-),I,O)))),I\=@=O.
32
33system:goal_expansion(I,O):- var_functor_wrap(T),
34 compound(I),functor(I,VFE,_), 35 \+ t_l:disable_px,
36 must((expand_var_functors(T,VFE,(:-),I,O))),I\=@=O.
37
38save_allow_variable_name_as_functor:- (was_allow_variable_name_as_functor(_)->true;current_prolog_flag(allow_variable_name_as_functor,Was),asserta(was_allow_variable_name_as_functor(Was))).
39restore_allow_variable_name_as_functor:-current_prolog_flag(allow_variable_name_as_functor,Was),asserta(was_allow_variable_name_as_functor(Was)).
40
41set_functor_wrap(T) :- save_allow_variable_name_as_functor, asserta(var_functor_wrap(T)),set_prolog_flag(allow_variable_name_as_functor,true).
42
43unset_functor_wrap:- retract(var_functor_wrap(_)), (var_functor_wrap(_) -> true;restore_allow_variable_name_as_functor).
44
45var_functor_quote('?').
46var_functor_quote('&').
47var_functor_quote('$').
49var_functor_quote(A):-atom(A),atom_codes(A,[C]),C>255.
50var_functor_quote('\2323\')