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,_), % var_functor_quote(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,_), % var_functor_quote(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('$').
   48% ttmricher requested these
   49var_functor_quote(A):-atom(A),atom_codes(A,[C]),C>255.
   50var_functor_quote('\2323\')