1:- module(portray_vars, [debug_var/2,maybe_debug_var/2,pretty_numbervars/2,guess_pretty/1,
    2  into_symbol_name/2,
    3  prologcase_name/2,
    4  may_debug_var/2,
    5  maybe_debug_var/2,
    6  simpler_textname/2,simpler_textname/3]).    7:- set_module(class(library)).    8/*  Logicmoo Debug Tools
    9% ===================================================================
   10% File 'logicmoo_util_varnames.pl'
   11% Purpose: An Implementation in SWI-Prolog of certain debugging tools
   12% Maintainer: Douglas Miles
   13% Contact: $Author: dmiles $@users.sourceforge.net ;
   14% Version: 'logicmoo_util_varnames.pl' 1.0.0
   15% Revision: $Revision: 1.1 $
   16% Revised At:  $Date: 2002/07/11 21:57:28 $
   17% ===================================================================
   18*/
   19
   20% debug_var(_A,_Var):-!.
   21debug_var(X,Y):- notrace(catch(debug_var0(X,Y),_,fail)) -> true ; rtrace(debug_var0(X,Y)).
   22
   23maybe_debug_var(X,Y):- notrace(maybe_debug_var0(X,Y)).
   24maybe_debug_var0(_,Y):- nonvar(Y),!.
   25maybe_debug_var0(X,_):- get_var_name(X,_),!.
   26maybe_debug_var0(X,Y):- (catch(debug_var0(X,Y),_,fail)) -> true ; rtrace(debug_var0(X,Y)).
   27
   28debug_var(Sufix,X,Y):- notrace((flatten([X,Sufix],XS),debug_var(XS,Y))).
   29
   30p_n_atom(Cmpd,UP):- sub_term(Atom,Cmpd),nonvar(Atom),\+ number(Atom), Atom\==[], catch(p_n_atom0(Atom,UP),_,fail),!.
   31p_n_atom(Cmpd,UP):- term_to_atom(Cmpd,Atom),p_n_atom0(Atom,UP),!.
   32
   33filter_var_chars([58|X],[107, 119, 95|Y]):- filter_var_chars_trim_95(X,Y).
   34filter_var_chars([95|X],[95|Y]):- !, filter_var_chars_trim_95(X,Y).
   35filter_var_chars(X,Y):- filter_var_chars_trim_95(X,Y).
   36
   37
   38
   39filter_var_chars_trim_95(X,Y):- filter_var_chars0(X,M),trim_95(M,Y),!.
   40
   41trim_95([X],[X]).
   42trim_95([95|M],Y):-!, trim_95(M,Y).
   43trim_95([X|L],[100,X|Y]):- char_type(X,digit), trim_96(L,Y).
   44trim_95([X|L],[97,X|Y]):- \+ char_type(X,alpha), trim_96(L,Y).
   45trim_95(X,Y):- trim_96(X,Y).
   46
   47trim_96([95],[]).
   48trim_96([],[]).
   49trim_96([95,95|M],Y):- trim_96([95|M],Y).
   50trim_96([X|M],[X|Y]):- trim_96(M,Y).
   51
   52
   53
   54filter_var_chars0([],[]).
   55
   56
   57% WATN WHEN MAKING SYMBOLs...  `_` -> `__`
   58
   59%  `-` -> `c45`
   60filter_var_chars0(`-`,`c45`):-!.
   61%  `*` -> `_xx_`
   62filter_var_chars0([42|T],[95,120,120,95|Rest]):-!,filter_var_chars0(T,Rest).
   63%  `%` -> `_pf_`
   64filter_var_chars0([37|T],[95,112, 102, 95| Rest]):-!,filter_var_chars0(T,Rest).
   65%  `-` -> `_`
   66filter_var_chars0([45|T],[95|Rest]):-!,filter_var_chars0(T,Rest).
   67%  `:` -> `_`
   68filter_var_chars0([42|T],[95,120,95|Rest]):-!,filter_var_chars0(T,Rest).
   69filter_var_chars0([H|T],[H|Rest]):-  code_type(H, prolog_identifier_continue),!,filter_var_chars0(T,Rest).
   70filter_var_chars0([H|T],Rest):- number_codes(H,Codes), filter_var_chars0(T,Mid),append([95, 99|Codes],[95|Mid],Rest).
   71
   72atom_concat_some_left(L,R,LR):- atom_concat(L,R,LR),atom_length(R,Len),Len>0.
   73atom_concat_some_left(L,R,LR):- upcase_atom(L,L0),L\==L0,atom_concat(L0,R,LR),atom_length(R,Len),Len>0.
   74atom_concat_some_left(L,R,LR):- downcase_atom(L,L0),L\==L0,atom_concat(L0,R,LR),atom_length(R,Len),Len>0.
   75
   76reduce_atomLR(L,R):- atom_concat_some_left('Cl_',LL,L),reduce_atomLR(LL,R).
   77reduce_atomLR(L,R):- atom_concat_some_left('U_',LL,L),reduce_atomLR(LL,R).
   78reduce_atomLR(L,R):- atom_concat_some_left('F_',LL,L),reduce_atomLR(LL,R).
   79reduce_atomLR(L,R):- atom_concat_some_left('Pf_',LL,L),reduce_atomLR(LL,R).
   80reduce_atomLR(L,R):- atom_concat_some_left('Kw_',LL,L),reduce_atomLR(LL,R).
   81reduce_atomLR(L,R):- atom_concat_some_left('Sys_',LL,L),reduce_atomLR(LL,R).
   82reduce_atomLR(L,L).
   83
   84%p_n_atom0(Atom,UP):- simpler_textname(Atom,M),Atom\==M,!,p_n_atom0(M,UP).
   85p_n_atom0(Atom,UP):- atom(Atom),!,
   86  reduce_atomLR(Atom,AtomR),
   87  name(AtomR,[C|Was]),to_upper(C,U),filter_var_chars([U|Was],CS),name(UP,CS).
   88p_n_atom0(String,UP):- string(String),!,string_to_atom(String,Atom),!,p_n_atom0(Atom,UP).
   89p_n_atom0([C|S],UP):- !,notrace(catch(atom_codes(Atom,[C|S]),_,fail)),!,p_n_atom0(Atom,UP).
   90
   91debug_var0(_,NonVar):-nonvar(NonVar),!.
   92debug_var0([C|S],Var):- notrace(catch(atom_codes(Atom,[C|S]),_,fail)),!,debug_var0(Atom,Var).
   93debug_var0([AtomI|Rest],Var):-!,maplist(p_n_atom,[AtomI|Rest],UPS),atomic_list_concat(UPS,NAME),debug_var0(NAME,Var),!.
   94debug_var0(Atom,Var):- p_n_atom(Atom,UP),  
   95  check_varname(UP),
   96  add_var_to_env_loco(UP,Var),!.
   97
   98
   99add_var_to_env_loco(UP,Var):- var(Var), get_var_name(Var,Prev),atomic(Prev),add_var_to_env_locovs_prev(UP,Prev,Var).
  100add_var_to_env_loco(UP,Var):-add_var_to_env(UP,Var).
  101
  102add_var_to_env_locovs_prev(UP,Prev,_Var):- UP==Prev,!.
  103add_var_to_env_locovs_prev(UP,_Prev,_Var):- atom_concat_or_rtrace_priv('_',_,UP),!.
  104add_var_to_env_locovs_prev(UP,_Prev,_Var):- atom_concat_or_rtrace_priv(_,'_',UP),!.
  105add_var_to_env_locovs_prev(UP,_Prev,Var):-add_var_to_env(UP,Var).
  106add_var_to_env_locovs_prev(UP,Prev,Var):- atom_concat_or_rtrace_priv('_',_,Prev),!,add_var_to_env(UP,Var).
  107add_var_to_env_locovs_prev(UP,Prev,Var):- atom_concat_or_rtrace_priv(UP,Prev,New),add_var_to_env(New,Var).
  108add_var_to_env_locovs_prev(UP,_Prev,Var):- add_var_to_env(UP,Var).
  109
  110check_varname(UP):- name(UP,[C|_]),(char_type(C,digit)->throw(check_varname(UP));true).
  111                        
  112
  113
  114resolve_char_codes('','_').
  115resolve_char_codes('pf','%').
  116%resolve_char_codes(C48,C):- notrace(catch((name(C48,[99|Codes]),number_codes(N,Codes),name(C,[N])),_,fail)),!,fail.
  117resolve_char_codes(C48,_):- notrace(catch((name(C48,[99|Codes]),number_codes(_,Codes)),_,fail)),!,fail.
  118resolve_char_codes(D1,N):- atom_concat('d',N,D1),notrace(catch(atom_number(N,_),_,fail)),!.
  119resolve_char_codes(C,CC):- atom_concat(C,'-',CC).
  120
  121into_symbol_name(Atom,UPPER):- atomic(Atom),atomic_list_concat([Pkg|HC],'_',Atom),!,into_symbol_name([Pkg|HC],UPPER).
  122into_symbol_name(HC,UPPER):- maplist(resolve_char_codes,HC,RHC),atomics_to_string(RHC,'',STR),
  123   atom_trim_suffix(STR,'-',Trimed),string_upper(Trimed,UPPER),!.
  124
  125% *PACKAGE* becomes xx_package_xx
  126% %MAKE-PACKAGE becomes pf_make_package
  127
  128prologcase_name(I,O):-notrace(prologcase_name0(I,O)),assertion(O\=='').
  129
  130prologcase_name0(String,Nonvar):-nonvar(Nonvar),!,prologcase_name(String,ProposedName),!,ProposedName==Nonvar.
  131prologcase_name0(String,ProposedName):- 
  132  string_lower(String,In),string_codes(In,Was),!,filter_var_chars(Was,CS),!,name(ProposedName,CS),!.
  133
  134
  135atom_trim_prefix(Root,Prefix,Result):- atom_concat(Prefix,Result,Root) -> true ; Result=Root.
  136atom_trim_suffix(Root,Suffix,Result):- atom_concat(Result,Suffix,Root) -> true ; Result=Root.
  137
  138shrink_naut_vars(I,I).
  139
  140pretty_numbervars(Term, TermO):- ground(Term), !, TermO=Term.
  141pretty_numbervars(Term, TermO):-
  142  shrink_naut_vars(Term,Term1),
  143  (ground(Term1) 
  144    -> TermO = Term1 ;
  145  (guess_pretty(Term1),
  146   source_variables_lwv(Term1,Vs),
  147   copy_term(Term+Vs,TermO+Vs2, _),
  148   our_implode_var_names(Vs2))),!.
  149
  150our_implode_var_names(Vars):- \+ compound(Vars),!.
  151our_implode_var_names([N=V|Vars]):- ignore(V='$VAR'(N)), our_implode_var_names(Vars).
  152
  153guess_pretty(H):- pretty_enough(H), !.
  154guess_pretty(O):- !,((pretty1(O),pretty1a(O),pretty2(O),pretty3(O))),!.
  155%make_pretty(I,O):- is_user_output,!,shrink_naut_vars(I,O), pretty1(O),pretty2(O),pretty3(O).
  156%make_pretty(I,O):- I=O, pretty1(O),pretty2(O),pretty3(O).
  157
  158/*
  159:- export(print_clause_plain/1).
  160print_clause_plain(I):-
  161  current_prolog_flag(color_term, Was),
  162  make_pretty(I,O),
  163    setup_call_cleanup(set_prolog_flag(color_term, false),
  164     (nl,lcolormsg1((O))),
  165     set_prolog_flag(color_term, Was)).
  166*/
  167
  168%lcolormsg1(Msg):- mesg_color(Msg,Ctrl),!,ansicall_maybe(Ctrl,fmt9(Msg)).
  169lcolormsg1(Msg):- fmt9(Msg).
  170
  171% print_clause_plain(C):- portray_clause_w_vars(O).
  172
  173
  174may_debug_var(_,_,V):- nonvar(V),!.
  175may_debug_var(_,_,V):- variable_name(V,_),!.
  176may_debug_var(L,_,_):- upcase_atom(L,L),!.
  177may_debug_var(L,R,V):- atom(L),atom_concat('f_',LL,L),may_debug_var(LL,R,V).
  178may_debug_var(L,R,V):- atomic_list_concat([_A1,A2,A3|AS],'_',L),atomic_list_concat([A2,A3|AS],'_',LL),may_debug_var(LL,R,V).
  179may_debug_var(L,R,V):- debug_var([L,R],V).
  180
  181may_debug_var(_,V):- nonvar(V),!.
  182may_debug_var(_,V):- variable_name(V,_),!.
  183may_debug_var(R,V):- debug_var(R,V).
  184
  185pretty_enough(H):- ground(H), !.
  186pretty_enough(H):- \+ compound(H),!. % may_debug_var(F,'_Call',H).
  187pretty_enough(H):- compound_name_arity(H,_,0), !.
  188
  189pretty1(H):- pretty_enough(H),!.
  190pretty1(as_rest(Name, Rest, _)):- may_debug_var(Name,Rest).
  191pretty1(get_var(Env, Name, Val)):- may_debug_var('GEnv',Env),may_debug_var(Name,Val).
  192pretty1(deflexical(Env,_Op, Name, Val)):- may_debug_var('SEnv',Env),may_debug_var(Name,Val).
  193pretty1(set_var(Env,Name, Val)):- may_debug_var('SEnv',Env),may_debug_var(Name,Val).
  194
  195pretty1(f_slot_value(_Env, Name, Val)):- may_debug_var(slot,Name,Val).
  196%pretty1(get_kw(ReplEnv, RestNKeys, test, test, f_eql, true, True)
  197pretty1(Env=[List|_]):- compound(List),var(Env),List=[H|_],compound(H),H=bv(_,_), may_debug_var('Env',Env),
  198  maplist(pretty1,List).
  199pretty1(Env=List):- compound(List),var(Env),List=[H|_],compound(H),H=bv(_,_), may_debug_var('Env',Env),
  200  maplist_not_tail(pretty1,List).
  201pretty1(P):- compound_name_arguments(P,_,[_|List]),append(_,[Name, Val|_],List),atom(Name),var(Val),may_debug_var(Name,Val).
  202pretty1(debug_var(R,V)):- may_debug_var(R,V).
  203pretty1(bv(R,V)):- may_debug_var(R,V).
  204pretty1(H):-compound_name_arguments(H,_,ARGS),must_maplist_det(pretty1,ARGS).
  205
  206pretty1a(H):- pretty_enough(H),!.
  207pretty1a(H):- is_list(H), !, maplist(pretty1a,H).
  208pretty1a(H):- compound_name_arguments(H,F,ARGS),
  209   pretty1a(1,F,ARGS), !.
  210
  211pretty1a(_,_,[]).
  212pretty1a(N,F,[E|ARGS]):-
  213  Np1 is N + 1,
  214  maybe_nameable_arg(F,N,E),
  215  pretty1a(Np1,F,ARGS).
  216
  217maybe_nameable_arg(F,N,E):- compound(E)-> pretty1a(E) ; 
  218 ((var(E),arg_type_decl_name(F,N,T))-> may_debug_var(T,E) ; true).
  219
  220arg_type_decl_name(holds_at,2,time).
  221arg_type_decl_name(releasedAt,2,time).
  222arg_type_decl_name(happens,2,maptime).
  223arg_type_decl_name(at,2,location).
  224
  225:- meta_predicate(maplist_not_tail(1,*)).  226maplist_not_tail(_,ArgS):- var(ArgS),!.
  227maplist_not_tail(G,[X|ArgS]):-call(G,X),maplist_not_tail(G,ArgS).
  228
  229pretty2(H):- pretty_enough(H),!.
  230%pretty2([H|T]):-!,maplist_not_tail(pretty2,[H|T]).
  231pretty2(H):-  
  232 must_det((compound_name_arity(H,F,A),
  233   compound_name_arguments(H,F,[P1|ARGS]),   
  234   (A>1 -> may_debug_var(F,'_Param',P1) ; true),
  235   must_maplist_det(pretty2,[P1|ARGS]))),!. 
  236
  237pretty3(H):-pretty4(H),pretty5(H).
  238
  239pretty4(H):- pretty_enough(H),!. 
  240%pretty4([H|T]):-!,maplist_not_tail(pretty4,[H|T]).
  241pretty4(H):-  
  242 ignore(((compound_name_arity(H,F,_), fail,
  243  nop((wl:init_args(N,F),integer(N),
  244   A is N + 1,   
  245   arg(A,H,R),may_debug_var('KeysNRest',R)))),
  246   compound_name_arguments(H,F,[P1|ARGS]),  
  247   must_maplist_det(pretty4,[P1|ARGS]))),!. 
  248
  249pretty5(H):- pretty_enough(H),!.
  250pretty5([H | B]):- pretty5(H),pretty5(B),may_debug_var('CAR',H),may_debug_var('CDR',B).
  251pretty5(H):-  
  252 must_det((compound_name_arity(H,F,A),
  253   compound_name_arguments(H,F,[P1|ARGS]),   
  254   arg(A,H,R),may_debug_var(F,'_Ret',R),   
  255   nop(may_debug_var(F,'_Param',P1)),
  256   must_maplist_det(pretty5,[P1|ARGS]))),!. 
  257
  258atom_concat_or_rtrace_priv(X,Y,Z):- tracing->atom_concat(X,Y,Z);catch(atom_concat(X,Y,Z),_,break).
  259
  260
  261:- export(i_name_lc/2).  262
  263%= 	 	 
 i_name_lc(?OType, ?IType) is semidet
Instance Name Not Loop Checked.
  269i_name_lc(OType,IType):-typename_to_iname0('',OType,IOType),!,string_equal_ci(IOType,IType).
  270
  271
  272
  273%= 	 	 
 to_iname(?T, ?T) is semidet
Converted To Iname.
  279to_iname(T,TT):- var(T),!,freeze(T,to_iname(T,TT)).
  280to_iname(T,TT):- not(current_predicate(i_name/3)),!,T=TT.
  281%to_iname(T,TT):- (not_log_op(T),i_name(t,T,TT))->true;TT=T.
  282
  283
  284
  285%= 	 	 
 toUpperCamelcase(?Type, ?TypeUC) is semidet
Converted To Upper Camelcase.
  291toUpperCamelcase(Type,TypeUC):-toCamelcase(Type,TypeUC). % ,toPropercase(TypeC,TypeUC),!.
  292:- export(i_name/2).  293
  294
  295icn_tcn(I,IC):-atom(I),i_name('t',I,IC)->I\==IC.
  296
  297%= 	 	 
 i_name(?OType, ?IType) is semidet
Instance Name.
  303i_name(OType,IType):-typename_to_iname0('',OType,IOType),!,IOType=IType.
  304:- export(i_name/3).  305
  306%= 	 	 
 i_name(?I, ?OType, ?IType) is semidet
Instance Name.
  312i_name(I,OType,IType):-typename_to_iname0(I,OType,IOType),!,IOType=IType.
  313
  314:- export(typename_to_iname0/3).  315
  316
  317%= 	 	 
 typename_to_iname0(?I, ?OType, ?IType) is semidet
Typename Converted To Iname Primary Helper.
  323typename_to_iname0(I, [], O):- trace_or_throw(bad_typename_to_iname0(I, [], O)).
  324%typename_to_iname0(I,OType,IType):- fail, (type_prefix(Prefix,_)),atom_concat(Prefix,Type,OType),capitalized(Type),!,typename_to_iname0(I,Type,IType).
  325typename_to_iname0(I,Type,IType):-nonvar(Type),toUpperCamelcase(Type,UType),atom_concat(I,UType,IType).
  326
  327:- export(split_name_type/3).  328:- '$hide'(split_name_type/3).  329
  330%= 	 	 
 split_name_type(?Suggest, ?InstName, ?Type) is semidet
Split Name Type.
  336split_name_type(Suggest,InstName,Type):- maybe_notrace(split_name_type_0(Suggest,NewInstName,NewType)),!,must((NewInstName=InstName,NewType=Type)),!.
  337
  338
  339%= 	 	 
 split_name_type_0(?S, ?P, ?C) is semidet
split name type Primary Helper.
  345split_name_type_0(S,P,C):- string(S),!,atom_string(A,S),split_name_type_0(A,P,C),!.
  346%split_name_type_0(FT,FT,ttExpressionType):-a(ttExpressionType,FT),!,dmsg(trace_or_throw(ttExpressionType(FT))),fail.
  347split_name_type_0(T,T,C):- compound(T),compound_name_arity(T,C,_),!.
  348split_name_type_0(T,T,C):- quietly((once(atomic_list_concat_safe([CO,'-'|_],T)),atom_string(C,CO))).
  349split_name_type_0(T,T,C):- quietly((atom(T),atom_codes(T,AC),last(AC,LC),is_digit(LC),append(Type,Digits,AC),
  350  catch(number_codes(_,Digits),_,fail),atom_codes(CC,Type),!,i_name(t,CC,C))).
  351split_name_type_0(C,P,C):- var(P),atom(C),i_name(i,C,I),gensym(I,P),!.
  352
  353
  354
  355
  356
  357%= 	 	 
 toCamelAtom0(:TermA, ?O) is semidet
Converted To Camel Atom Primary Helper.
  363toCamelAtom0([A],O):-nonvar(A),!,toPropercase(A,O),!.
  364toCamelAtom0([A|List],O):-!,toPropercase(A,AO),toCamelAtom0(List,LO),atom_concat(AO,LO,O).
  365toCamelAtom0(A,O):-toPropercase(A,O),!.
  366
  367
  368
  369%= 	 	 
 to_prefixed(?Prefix, ?I, ?O) is semidet
Converted To Prefixed.
  375to_prefixed(Prefix,I,O):-to_atomic_name(I,i_name(Prefix),O).
  376
  377:- meta_predicate to_atomic_name(?,2,?).  378
  379%= 	 	 
 to_atomic_name(?I, :PRED2Pred, ?O) is semidet
Converted To Atomic Name.
  385to_atomic_name(I,Pred,O):-is_list(I),toCamelAtom0(I,A),!,to_atomic_name(A,Pred,O).
  386to_atomic_name(I,Pred,O):-string(I),!,string_to_atom(I,A),!,to_atomic_name(A,Pred,O).
  387%to_atomic_name(Name,Pred,O):-atomic(Name),ereq(mudKeyword(W,KW)),string_equal_ci(Name,KW),!,to_atomic_name(W,Pred,O).
  388to_atomic_name(Name,Pred,_):- not(atom(Name)),!,trace_or_throw(todo(not_atom_to_atomic_name(Name,Pred))).
  389to_atomic_name(Name,Pred,O):- call(Pred,Name,O).
  390
  391
  392simpler_textname(Name,Text):- simpler_textname(Name,'',Text).
  393simpler_textname(Name,Sep,Text):-atomic(Name),to_case_breaks(Name,ListN),to_case_breaks_trimed(Name,ListN,Sep,Text),!.
  394
  395to_case_breaks_trimed(Name,[xti(TextL,ClassL),xti(TextR,ClassR)|ListN],Sep,Text):-  ClassL==ClassR,!,
  396    maplist(to_descriptive_name(Name),[xti(TextL,ClassL),xti(TextR,ClassR)|ListN],Desc),
  397    (string(Sep) -> atomics_to_string(Desc,Sep,Text) ; atomic_list_concat(Desc,Sep,Text)).
  398
  399to_case_breaks_trimed(Name,[xti(_,lower),xti(TextR,ClassR)|ListN],Sep,Text):-
  400    maplist(to_descriptive_name(Name),[xti(TextR,ClassR)|ListN],Desc),
  401    (string(Sep) -> atomics_to_string(Desc,Sep,Text) ; atomic_list_concat(Desc,Sep,Text)).
  402
  403to_case_breaks_trimed(Name,ListN,Sep,Text):- is_list(ListN),!,
  404    maplist(to_descriptive_name(Name),ListN,Desc),
  405    (string(Sep) -> atomics_to_string(Desc,Sep,Text) ; atomic_list_concat(Desc,Sep,Text)).
  406
  407
  408
  409%to_descriptive_name(For,Desc,Atom):- type_descriptive_name(Type,Desc,Atom),isa(For,Type),!.
  410%to_descriptive_name(_For,Pefix,Desc):- (type_prefix(Pefix,TypeName)), simpler_textname(TypeName,Desc).
  411%to_descriptive_name(For,xti(Pefix,lower),Desc):-!,to_descriptive_name(For,Pefix,Desc).
  412to_descriptive_name(For,xti(Pefix,_),Desc):-!,to_descriptive_name(For,Pefix,Desc).
  413to_descriptive_name(_For,X,X).
  414
  415:- multifile(user:portray/1).  416:- dynamic(user:portray/1).  417:- discontiguous(user:portray/1).  418
  419user:portray(Term):- fail,
  420  \+ ground(Term),
  421  pretty_numbervars(Term,PrettyVarTerm),
  422  Term \=@= PrettyVarTerm,
  423  prolog_pretty_print:print_term(PrettyVarTerm, [output(current_output)])