1/* Part of LogicMOO Base Logicmoo Debug Tools
    2% ===================================================================
    3% File '$FILENAME.pl'
    4% Purpose: An Implementation in SWI-Prolog of certain debugging tools
    5% Maintainer: Douglas Miles
    6% Contact: $Author: dmiles $@users.sourceforge.net ;
    7% Version: '$FILENAME.pl' 1.0.0
    8% Revision: $Revision: 1.1 $
    9% Revised At:  $Date: 2002/07/11 21:57:28 $
   10% Licience: LGPL
   11% ===================================================================
   12*/
   13:- if((prolog_load_context(source,F),prolog_load_context(file,F))).   14:- else.   15%module(_,Y):- maplist(export,Y).
   16:- endif.   17:- module(dumpst,[
   18          getPFA/3,getPFA1/3,getPFA2/3,get_m_opt/4,fdmsg/1,fdmsg1/1,
   19          neg1_numbervars/3,clauseST/2,
   20          dtrace/0,dbreak/0,
   21          dtrace/1,dtrace/2,
   22          dumptrace/1,dumptrace/2,dumptrace0/1,dumptrace1/1,
   23          dumptrace_ret/1,
   24          drain_framelist/1,
   25          drain_framelist_ele/1,
   26          printable_variable_name/2,
   27          v_name1/2,
   28          v_name2/2,
   29          dump_st/0,
   30          with_source_module/1,
   31          to_wmsg/2,
   32          fmsg_rout/1,
   33          simplify_goal_printed/2,
   34          dumpST/0,dumpST/1,dumpST1/0,
   35          dumpST0/0,dumpST0/1,dumpST0/2,
   36          dumpST9/0,dumpST9/1,dumpST9/2,dumpST_now/2,printFrame/3,frame_to_fmsg/4
   37
   38   ]).   39
   40:-  meta_predicate dumptrace_ret(?),
   41  neg1_numbervars(?, ?, 0),
   42  with_source_module(0),
   43  dumptrace_ret(0),
   44  dumptrace0(0),
   45  dumptrace1(0),
   46  dumptrace(0),
   47  dtrace(*,0).   48
   49:- set_module(class(library)).   50% % % OFF :- system:use_module(library(apply)).
   51% % % OFF :- system:use_module(library(logicmoo/util_strings)).
   52% % % OFF :- system:use_module(library(logicmoo_utils_all)).
   53% % % OFF :- system:use_module((ucatch)).
   54% % % OFF :- system:use_module(library(logicmoo/no_loops)).
   55% % % OFF :- system:use_module((rtrace)).
   56% % % OFF :- system:use_module(library(must_sanity)).
   57
   58:- use_module(library(backcomp)).   59:- use_module(library(debug)).   60:- use_module(library(occurs)).   61:- use_module(library(check)).   62:- use_module(library(edinburgh)).   63:- use_module(library(prolog_stack)).   64:- use_module(library(make)).   65
   66
   67
   68:- use_module(library(logicmoo_startup)).   69:- use_module(library(logicmoo_common)).   70%:- use_module(library(debuggery/first)).
   71:- use_module(library(logicmoo/util_strings)).   72%:- use_module(library(debuggery/dmsg)).
   73:- use_module(library(debuggery/rtrace)).   74%:- use_module(library(debuggery/bugger)).
   75%:- use_module(library(debuggery/dumpst)).
   76%:- use_module(library(debuggery/ucatch)).
   77:- use_module(library(debuggery/frames)).   78
   79
   80:- set_prolog_flag(backtrace_depth,      200).   81:- set_prolog_flag(backtrace_goal_depth, 20).   82:- set_prolog_flag(backtrace_show_lines, true).   83
   84:- module_transparent
   85          getPFA/3,getPFA1/3,getPFA2/3,get_m_opt/4,fdmsg/1,fdmsg1/1,
   86          neg1_numbervars/3,clauseST/2,
   87          % dtrace/0,
   88          dtrace/1,dtrace/2,
   89          dumptrace/1,dumptrace/2,
   90          dumptrace_ret/1,
   91          dump_st/0,
   92          dumpST/0,dumpST/1,
   93          dumpST0/0,dumpST0/1,dumpST0/2,
   94          dumpST9/0,dumpST9/1,dumpST9/2.   95
   96
   97
   98%:- ensure_loaded(library(debug)).
   99% % % OFF :- system:use_module((dmsg)).% WAS OFF  :- system:use_module(library(logicmoo_util_strings)).
  100
  101
  102%=
 dump_st is semidet
Dump Stack Trace.
  108dump_st:- prolog_current_frame(Current),dumpST0(Current,100),!.
  109
  110
  111%=
 dumpST0 is semidet
Dump S True Stucture Primary Helper.
  117dumpST0:- prolog_current_frame(Current),
  118  dbreak,(tracing->zotrace((CU=dtrace,notrace));CU=true),dumpST0(Current,800),!,CU.
  119
  120%=
 dumpST0(?Opts) is semidet
Dump S True Stucture Primary Helper.
  126dumpST0(Opts):- prolog_current_frame(Current), once(nb_current('$dump_frame',Frame);Frame=Current),dumpST0(Frame,Opts).
  127
  128%=
 dumpST0(?Frame, ?MaxDepth) is semidet
Dump S True Stucture Primary Helper.
  134:- thread_local(tlbugger:ifHideTrace/0).  135dumpST0(_,_):- tlbugger:ifHideTrace,!.
  136dumpST0(Frame,MaxDepth):-  prolog_current_frame(Current),(number(Frame);get_dump_frame(Current,Frame)),!,
  137   ignore(MaxDepth=5000),Term = dumpST(MaxDepth),!,
  138   ignore(( get_prolog_backtrace(MaxDepth, Trace,[frame(Frame),goal_depth(13)]),
  139    format(user_error, '% dumpST ~p', [Term]), nl(user_error),
  140    attach_console,dtrace,
  141    dbreak,
  142
  143    print_prolog_backtrace(user_error, Trace,[subgoal_positions(true)]), nl(user_error), fail)),!.
  144
  145
  146
  147% dumpstack_arguments.
  148
  149%=
 dumpST is semidet
Dump S True Stucture.
  156%:- use_module(library(sandbox)).
  157%sandbox:safe_primitive(dumpST/0).
  158
  159dumpST:- ((prolog_current_frame(Current),get_dump_frame(Current,Frame),
  160  no_bfly(zotrace(with_all_dmsg((b_setval('$dump_frame',Frame),dumpST1)))))).
  161
  162%no_bfly(Goal):- current_predicate(in_bfly/2)->in_bfly(f,Goal);call(Goal).
  163
  164:- thread_local(tlbugger:no_slow_io/0).  165:- multifile(tlbugger:no_slow_io/0).  166
  167%=
 dumpST1 is semidet
Dump S True Stucture Secondary Helper.
  173dumpST1:- current_prolog_flag(dmsg_level,never),!.
  174dumpST1:- tlbugger:no_slow_io,!,dumpST0,!.
  175dumpST1:- tlbugger:ifHideTrace,!.
  176dumpST1:- show_current_source_location,!,loop_check_early(dumpST9,dumpST0).
  177
  178%=
 dumpST(?Depth) is semidet
Dump S True Stucture.
  184dumpST(Depth):-
  185   prolog_current_frame(Current),
  186   no_bfly((zotrace((b_setval('$dump_frame',Current))),
  187   loop_check_early(dumpST9(Depth),dumpST0(Depth)))).
  188
  189
  190%=
 get_m_opt(?Opts, ?Max_depth, ?D100, ?RetVal) is semidet
Get Module Opt.
  196get_m_opt(Opts,Max_depth,D100,RetVal):- univ_safe_2(E,[Max_depth,V]),(((member(E,Opts),nonvar(V)))->RetVal=V;RetVal=D100).
  197
  198
  199
  200%=
 dumpST9 is semidet
Dump S T9.
  206dumpST9:- prolog_current_frame(Current),get_dump_frame(Current,Frame),dumpST9(Frame,5000).
  207
  208%=
 dumpST9(?Depth) is semidet
Dump S T9.
  214dumpST9(Depth):-prolog_current_frame(Current),get_dump_frame(Current,Frame),dumpST9(Frame,Depth).
  215
  216
  217get_dump_frame(Current,Frame):- (nb_current('$dump_frame',Frame),number(Frame))->true;Frame=Current.
  218
  219%=
 dumpST9(?Frame, :TermMaxDepth) is semidet
Dump S T9.
  225dumpST9(_,_):- tlbugger:ifHideTrace,!.
  226dumpST9(Frame,MaxDepth):- integer(MaxDepth),!,dumpST_now(Frame,[max_depth(MaxDepth),numbervars(true),show([level,has_alternatives,hidden,context_module,goal,clause])]).
  227dumpST9(Frame,From-MaxDepth):- integer(MaxDepth),!,dumpST_now(Frame,[skip_depth(From),max_depth(MaxDepth),numbervars(true),show([level,has_alternatives,hidden,context_module,goal,clause])]).
  228dumpST9(Frame,List):- is_list(List),dumpST_now(Frame,[show([level,has_alternatives,hidden,context_module,goal,clause])|List]).
  229
  230
  231
  232%=
 drain_framelist(?Opts) is semidet
Drain Framelist.
  238drain_framelist(Opts):- repeat, \+ drain_framelist_ele(Opts).
  239
  240
  241%=
 drain_framelist_ele(?Opts) is semidet
Drain Framelist Ele.
  247drain_framelist_ele(Opts):-
  248    nb_getval('$current_stack_frame_list',[N-Frame|Next]),
  249    nb_setval('$current_stack_frame_list',Next),!,
  250    printFrame(N,Frame,Opts),!.
  251
  252
  253
  254
  255%=
 dumpST_now(?FrameIn, ?Opts) is semidet
Dump S True Stucture Now.
  261dumpST_now(FrameInto,Opts):-
  262   prolog_current_frame(Current),
  263  (number(FrameInto) -> FrameIn=FrameInto ; FrameIn=Current),
  264   nb_setval('$hide_rest_frames',false),
  265   b_setval('$current_stack_frame_depth',0),
  266   b_setval('$current_stack_frame_list',[]),
  267   get_m_opt(Opts,max_depth,100,MD),
  268   b_setval('$current_stack_frame_handle',FrameIn),
  269  (repeat,
  270     nb_getval('$current_stack_frame_depth',N),
  271     nb_getval('$current_stack_frame_handle',Frame),
  272    ((pushFrame(N,Frame,Opts),MD>N)->
  273     ((getPFA2(Frame,parent,ParentFrame)->
  274       (nb_setval('$current_stack_frame_handle',ParentFrame),
  275       NN is N +1,nb_setval('$current_stack_frame_depth',NN),fail); !));
  276     (!))),
  277   drain_framelist(Opts),!.
 pushFrame(?N, ?Frame, ?Opts) is semidet
Push Frame.
  285pushFrame(N,Frame,_Opts):- nb_getval('$current_stack_frame_list',Current),nb_setval('$current_stack_frame_list',[N-Frame|Current]).
  286
  287
  288%=
 printFrame(?N, ?Frame, ?Opts) is semidet
Print Frame.
  294printFrame(_,_,_):- nb_current('$hide_rest_frames',true),!.
  295printFrame(N,Frame,Opts):-
  296  ignore(((frame_to_fmsg(N,Frame,Opts,Out)),must(fmsg_rout(Out)))),!.
  297
  298
  299%=
 frame_to_fmsg(?N, ?Frame, ?Opts, ?N) is semidet
Frame Converted To Functor Message.
  305frame_to_fmsg(N,Frame,Opts,[nf(max_depth,N,Frame,Opts)]):-get_m_opt(Opts,max_depth,100,MD),N>=MD,!,fail.
  306%  dumpST9(N,Frame,Opts,[nf(max_depth,N,Frame,Opts)]):-get_m_opt(Opts,skip_depth,100,SD),N=<SD,!.
  307frame_to_fmsg(_,Frame,Opts,[fr(Goal)]):- get_m_opt(Opts,show,goal,Ctrl),getPFA(Frame,Ctrl,Goal),!.
  308frame_to_fmsg(N,Frame,Opts,[nf(no(Ctrl),N,Frame,Opts)]):- get_m_opt(Opts,show,goal,Ctrl),!.
  309frame_to_fmsg(N,Frame,Opts,[nf(noFrame(N,Frame,Opts))]).
  310
  311
  312
  313
  314%=
 fmsg_rout(:TermRROut) is semidet
Functor Message Rout.
  320fmsg_rout([]):-!.
  321fmsg_rout([fr(E)|_]):- member(goal=GG,E),end_dump(GG),!,ignore(fdmsg(fr(E))),!.
  322fmsg_rout([fr(E)|_]):- member(goal=GG,E),end_dump(GG),!,ignore(fdmsg(fr(E))),!.
  323fmsg_rout([E|RROut]):- ignore(fdmsg(E)),!,fmsg_rout(RROut).
  324fmsg_rout(RROut):- show_call(why,forall(member(E,RROut),fdmsg(E))),!.
  325
  326
  327%=
 neg1_numbervars(?Out, ?Start, :GoalROut) is semidet
Negated Secondary Helper Numbervars.
  333neg1_numbervars(T,-1,T):-!.
  334neg1_numbervars(Out,false,Out):-!.
  335neg1_numbervars(Out,true,ROut):-copy_term(Out,ROut),!,snumbervars(ROut,777,_).
  336neg1_numbervars(Out,Start,ROut):-copy_term(Out,ROut),integer(Start),!,snumbervars(ROut,Start,_).
  337neg1_numbervars(Out,safe,ROut):-copy_term(Out,ROut),safe_numbervars(ROut).
  338
  339if_defined_mesg_color(G,C):- current_predicate(mesg_color/2),mesg_color(G,C).
  340
  341%=
 fdmsg1(?G) is semidet
Fdmsg Secondary Helper.
  347fdmsg1(txt(S)):-'format'(S,[]),!.
  348fdmsg1(level=L):-'format'('(~q)',[L]),!.
  349fdmsg1(context_module=G):- simplify_m(G,M),!,if_defined_mesg_color(G,Ctrl),ansicall(Ctrl,format('[~w]',[M])),!.
  350fdmsg1(has_alternatives=G):- (G==(false)->true;'format'('<*>',[])),!.
  351fdmsg1(hidden=G):- (G==(false)->true;'format'('$',[])),!.
  352fdmsg1(goal=G):- do_fdmsg1(G).
  353fdmsg1(clause=[F,L]):- directory_file_path(_,FF,F),'format'('  %  ~w:~w: ',[FF,L]),!.
  354fdmsg1(clause=[F,L]):- fresh_line,'format'('%  ~w:~w: ',[F,L]),!.
  355fdmsg1(clause=[]):-'format'(' /*DYN*/ ',[]),!.
  356fdmsg1(G):- if_defined_mesg_color(G,Ctrl),ansicall(Ctrl,fmt_gg(G)),!.
  357fdmsg1(M):-dmsg(failed_fdmsg1(M)).
  358
  359do_fdmsg1(G):-
  360  simplify_goal_printed(G,GG),!,
  361  (GG\==G->write('#');true),
  362  do_fdmsg2(GG),!.
  363
  364term_contains_ansi_b(S,N):- compound(S), !, arg(_,S,E),term_contains_ansi_b(E,N),!.
  365term_contains_ansi_b(S,S):- string(S),!,sub_string(S,_,_,_,'\x1B').
  366term_contains_ansi_b(S,S):- atom(S),!,sub_string(S,_,_,_,'\x1B').
  367
  368%do_fdmsg2(GG):- term_contains_ansi_b(GG,_),pt(GG),!.
  369do_fdmsg2(GG):- term_contains_ansi_b(GG,_),write(GG),!.
  370%do_fdmsg2(GG):- term_contains_ansi_b(GG,N),write(N),fail.
  371do_fdmsg2(GG):-
  372  term_variables(GG,_Vars),
  373  copy_term_nat(GG,GGG), =(GG,GGG),
  374  numbervars(GGG,0,_,[attvar(skip)]),
  375  if_defined_mesg_color(GGG,Ctrl),ansicall(Ctrl,fmt_gg(GGG)),!.
  376
  377fmt_gg(GGG):- term_contains_ansi_b(GGG,_),!,write(' '),write(GGG),write('. ').
  378fmt_gg(GGG):- format(' ~q. ',[GGG]).
  379
  380%=
 simplify_m(?G, ?M) is semidet
Simplify Module.
  387% simplify_m(G,M):-atom(G),sub_atom(G,_,6,0,M),!.
  388simplify_m(G,G).
  389
  390%=
 fdmsg(?M) is semidet
Fdmsg.
  396fdmsg(fr(List)):-is_list(List),!,must((fresh_line,ignore(forall(member(E,List),fdmsg1(E))),nl)).
  397fdmsg(M):- logicmoo_util_catch:ddmsg(failed_fdmsg(M)).
  398
  399:- thread_local(tlbugger:plain_attvars/0).  400
  401:-export(simplify_goal_printed/2).  402
  403
  404printable_variable_name(Var, Name) :- nonvar(Name),!,must(printable_variable_name(Var, NameO)),!,Name=NameO.
  405printable_variable_name(Var, Name) :- nonvar(Var),Var='$VAR'(Named), (nonvar(Named)-> Name=Named ; format(atom(Name),"~w_",[Var])).
  406printable_variable_name(Var, Name) :- nonvar(Var),format(atom(Name),"(_~q_)",[Var]).
  407printable_variable_name(Var,Name):- (get_attr(Var, vn, Name1);
  408  get_attr(Var, varnames, Name1)),
  409 (var_property(Var,name(Name2))->
  410   (Name1==Name2-> atom_concat(Name1,'_VN',Name) ; Name=(Name1:Name2));
  411    (atom(Name1)->atom_concat('?',Name1,Name);
  412   format(atom(Name),"'$VaR'(~q)",[Var]))),!.
  413printable_variable_name(Var,Name):- v_name1(Var,Name),!.
  414printable_variable_name(Var,Name):- v_name2(Var,Name),!. % ,atom_concat(Name1,'_TL',Name).
  415
  416v_name1(Var,Name):- var_property(Var,name(Name)),!.
  417v_name1(Var,Name):- get_varname_list(Vs),member(Name=V,Vs),atomic(Name),V==Var,!.
  418v_name1(Var,Name):- nb_current('$old_variable_names', Vs),member(Name=V,Vs),atomic(Name),V==Var,!.
  419v_name2(Var,Name):- get_varname_list(Vs),format(atom(Name),'~W',[Var, [variable_names(Vs)]]).
  420
  421
  422%attrs_to_list(att(sk,_,ATTRS),[sk|List]):-!,attrs_to_list(ATTRS,List).
  423attrs_to_list(att(vn,_,ATTRS),List):-!,attrs_to_list(ATTRS,List).
  424attrs_to_list(att(M,V,ATTRS),[M=VV|List]):- locally(tlbugger:plain_attvars,simplify_goal_printed(V,VV)),!,attrs_to_list(ATTRS,List).
  425attrs_to_list([],[]).
  426attrs_to_list(_ATTRS,[]).
 simplify_goal_printed(:TermVar, :TermVar) is semidet
Simplify Goal Printed.
  433% public_file_link(M:G,MG):-
  434
  435:- multifile(dumpst_hook:simple_rewrite/2).  436:- dynamic(dumpst_hook:simple_rewrite/2).  437
  438simplify_var_printed(Var,'aVar'('$VAR'(Name))):- tlbugger:plain_attvars,must(printable_variable_name(Var,Name)),!.
  439simplify_var_printed(Var,'$VAR'(Name)):-  get_attrs(Var,att(vn, _, [])),printable_variable_name(Var, Name),!.
  440simplify_var_printed(Var,'aVar'('$VAR'(Name))):- tlbugger:plain_attvars,must(printable_variable_name(Var,Name)),!.
  441simplify_var_printed(Var,'aVar'(Dict)):- get_attrs(Var,ATTRS),must(printable_variable_name(Var,Name)),attrs_to_list(ATTRS,List),
  442                         dict_create(Dict,'$VAR'(Name),List).
  443simplify_var_printed(Var,'$VAR'(Name)):- is_ftVar(Var),!,printable_variable_name(Var, Name).
  444
  445simplify_goal_printed(Var,Printed):- nonvar(Printed),!,simplify_goal_printed(Var,UnPrinted),ignore(Printed=UnPrinted),!.
  446% simplify_goal_printed(Var,Name):-is_ftVar(Var), \+ current_prolog_flag(variable_names_bad,true), simplify_var_printed(Var,Name),!.
  447simplify_goal_printed(Var,VarO):- var(Var),!,VarO=Var.
  448simplify_goal_printed(Var,VarO):- is_ftVar(Var),!,VarO=Var.
  449simplify_goal_printed(Var,Name):-cyclic_term(Var),!,w_o_c(Name=Var).
  450simplify_goal_printed(setup_call_catcher_cleanup,sccc).
  451% simplify_goal_printed(existence_error(X,Y),existence_error(X,Y)):-nl,writeq(existence_error(X,Y)),nl,fail.
  452simplify_goal_printed(setup_call_cleanup,scc).
  453%simplify_goal_printed(existence_error,'existence_error_XXXXXXXXX__\e[0m\e[1;34m%-6s\e[m\'This is text\e[0mRED__existence_error_existence_error').
  454simplify_goal_printed(each_call_cleanup,ecc).
  455simplify_goal_printed(call_cleanup,cc).
  456simplify_goal_printed([Var|_],'$'):-compound(Var),Var = (VT = _ ), (attvar(VT);var(VT);VT = var_tracker(_); VT = fbound(_)),!.
  457%  %simplify_goal_printed(M:G,MG):-atom(M),number(G),exists_file_safe(M),public_file_link(M:G,MG),!.
  458%  %simplify_goal_printed(M,MG):-atom(M),exists_file_safe(M), public_file_link(M,MG),!.
  459simplify_goal_printed(M:G,MS:GS):-atom(M), simplify_m(M,MS),!,simplify_goal_printed(G,GS).
  460simplify_goal_printed(M:I,M:O):-!, simplify_goal_printed(I,O).
  461%simplify_goal_printed(M:I,O):- atom(M),(M==user;M==system),!,simplify_goal_printed(I,O).
  462%simplify_goal_printed(M:I,O):- atom(M),!,simplify_goal_printed(I,O).
  463%simplify_goal_printed(catch(I,V,_),O):- var(V),!,simplify_goal_printed(I,O).
  464simplify_goal_printed(always(I),O):- !,simplify_goal_printed(I,O).
  465simplify_goal_printed(must_det_lm(M,G),GS):-!,simplify_goal_printed(M:must_det_l(G),GS).
  466%simplify_goal_printed('<meta-call>'(G),GS):-!,simplify_goal_printed(G,GS).
  467%simplify_goal_printed(call(G),GS):-!,simplify_goal_printed(G,GS).
  468simplify_goal_printed(M:G,MS:GS):-atom(M), simplify_m(M,MS),!,simplify_goal_printed(G,GS).
  469simplify_goal_printed(dinterp(_,_,I,_),O):- !,simplify_goal_printed(I,O).
  470simplify_goal_printed(call_term_expansion(_,A,_,B,_),O):- !, simplify_goal_printed(call_term_expansion_5('...',A,'...',B,'...'),O).
  471%simplify_goal_printed(A,'/.../'(Dir,SA)):- atom(A),atom_concat('/',_,A),directory_file_path(DirL,SA,A),directory_file_path(_,Dir,DirL),!.
  472%simplify_goal_printed(A,'...'(SA)):- atom(A),concat_atom([_,SA1|SA2],'logicmoo_',A),!,(SA2==[]->SA=SA1;SA=SA2).
  473simplify_goal_printed(GOAL=A,AS):- goal==GOAL,!,simplify_goal_printed(A,AS).
  474simplify_goal_printed(Var,Var):- \+ compound(Var),!.
  475simplify_goal_printed(P,O):- compound(P), \+ is_dict(P),compound_name_arguments(P,F,[I]),
  476  atom_contains(F,must),!,simplify_goal_printed(I,O).
  477simplify_goal_printed(term_position(_,_,_,_,_),'$..term_position/4..$').
  478%simplify_goal_printed(user:G,GS):-!,simplify_goal_printed(G,GS).
  479%simplify_goal_printed(system:G,GS):-!,simplify_goal_printed(G,GS).
  480%simplify_goal_printed(catchv(G,_,_),GS):-!,simplify_goal_printed(G,GS).
  481%simplify_goal_printed(catch(G,_,_),GS):-!,simplify_goal_printed(G,GS).
  482%simplify_goal_printed(skolem(V,N,_F),GS):-!,simplify_goal_printed(skeq(V,N,'..'),GS).
  483simplify_goal_printed(I,O):- once(dumpst_hook:simple_rewrite(I,O)), I \== O,!.
  484
  485simplify_goal_printed(List,O):- current_prolog_flag(dmsg_len,Three),
  486  is_list(List),length(List,L),L>Three,
  487   append([A,B,C],[F|_],List),F \='...'(_), !,
  488  simplify_goal_printed([A,B,C,'....'(L>Three)],O).
  489
  490
  491simplify_goal_printed([E|OList],O):- fail,  \+ is_list(OList),
  492   append(List,Open,OList),var(Open),!,
  493    current_prolog_flag(dmsg_len,Three),
  494   is_list(List),length(List,L),L>Three,
  495    append([A,B,C],[F|_],[E|List]),F \='...'(_), !,
  496   simplify_goal_printed([A,B,C,'...'(_)],O).
  497
  498
  499simplify_goal_printed([F|A],[FS|AS]):- !,simplify_goal_printed(F,FS),simplify_goal_printed(A,AS).
  500simplify_goal_printed(G,GS):- univ_safe_2(G,[F|A]),maplist(simplify_goal_printed,A,AA),univ_safe_2(GS,[F|AA]).
  501
  502
  503:-create_prolog_flag(dmsg_len,99,[keep(true)]).  504
  505:- multifile(user:portray/1).  506:- dynamic(user:portray/1).  507:- discontiguous(user:portray/1).  508% user:portray
  509
  510
  511
  512
  513%=
 getPFA(?Frame, ?Ctrl, ?Goal) is semidet
Get Pred Functor A.
  519getPFA(Frame,[L|List],Goal):- !,findall(R, (member(A,[L|List]),getPFA1(Frame,A,R)) ,Goal).
  520getPFA(Frame,Ctrl,Goal):-getPFA1(Frame,Ctrl,Goal).
  521
  522
  523%=
 getPFA1(?Frame, ?Txt, ?Txt) is semidet
Get Pred Functor A Secondary Helper.
  529getPFA1(_Frame,txt(Txt),txt(Txt)):-!.
  530getPFA1(Frame,clause,Goal):-getPFA2(Frame,clause,ClRef),clauseST(ClRef,Goal),!.
  531getPFA1(Frame,Ctrl,Ctrl=Goal):-getPFA2(Frame,Ctrl,Goal),!.
  532getPFA1(_,Ctrl,no(Ctrl)).
  533
  534
  535%=
 getPFA2(?Frame, ?Ctrl, ?Goal) is semidet
Get Pred Functor A Extended Helper.
  541getPFA2(Frame,Ctrl,Goal):- catchv((prolog_frame_attribute(Frame,Ctrl,Goal)),E,Goal=[error(Ctrl,E)]),!.
  542
  543
  544%=
 clauseST(?ClRef, :TermGoal) is semidet
Clause S True Stucture.
  550clauseST(ClRef,clause=Goal):- findall(V,(member(Prop,[file(V),line_count(V)]),clause_property(ClRef,Prop)),Goal).
  551
  552clauseST(ClRef,Goal = HB):- ignore(((clause(Head, Body, ClRef),copy_term(((Head :- Body)),HB)))),
  553   snumbervars(HB,0,_),
  554   findall(Prop,(member(Prop,[source(_),line_count(_),file(_),fact,erased]),clause_property(ClRef,Prop)),Goal).
  555
  556
  557:- thread_local(tlbugger:ifCanTrace/0).  558
  559
  560%=
 end_dump(:TermGG) is semidet
End Dump.
  566end_dump(true):-!,fail.
  567end_dump(_:GG):-!,end_dump(GG).
  568end_dump(GG):-compound(GG),functor(GG,F,_),atom_concat(dump,_,F),nb_setval('$hide_rest_frames',true).
  569
  570% =====================
  571% dtrace/0/1/2
  572% =====================
  573
  574%:- redefine_system_predicate(system:dtrace()).
  575dtrace:- wdmsg("DUMP_TRACE/0"), (thread_self_main->(dumpST,rtrace);(dumpST(30),abort)).
  576%=
 dtrace is semidet
(debug) Trace.

:- redefine_system_predicate(system:dbreak()).

  584:- thread_local(t_l:no_dbreak/0).  585%dbreak:- wdmsg("DUMP_BREAK/0"), !, break, throw(abort).
  586dbreak:- wdmsg("DUMP_BREAK/0"), !, throw(abort).
  587dbreak:- wdmsg("DUMP_BREAK/0"),((ignore(on_x_fail(dumpST)), break,wdmsg("DUMP_BREAK/0"))),!,
  588  (t_l:no_dbreak -> wdmsg("NO__________________DUMP_BREAK/0") ;
  589      (thread_self_main->(dumpST,dtrace(system:break),break);true)).
  590
  591:- thread_local(tlbugger:has_auto_trace/1).  592:-meta_predicate(dtrace(0)).  593
  594%=
 dtrace(:GoalG) is semidet
(debug) Trace.
  601dtrace(G):- zotrace((tlbugger:has_auto_trace(C),wdmsg(has_auto_trace(C,G)))),!,call(C,G).
  602dtrace(G):- strip_module(G,_,dbreak),\+ thread_self_main,!.
  603% dtrace(G):- zotrace((tracing,notrace)),!,wdmsg(tracing_dtrace(G)),
  604%   scce_orig(notrace,restore_trace((leash(+all),dumptrace_or_cont(G))),trace).
  605
  606dtrace(G):- zotrace((once(((G=dmsg(GG);G=_:dmsg(GG);G=GG),nonvar(GG))),wdmsg(GG)))->true;
  607 catch(dumptrace1(G),E, handle_dumptrace_signal(G,E)),fail. %always fails
  608%dtrace(G):- \+ tlbugger:ifCanTrace,!,quietly((wdmsg((not(tlbugger:ifCanTrace(G)))))),!,badfood(G),!,dumpST.
  609%dtrace(G):- \+ tlbugger:ifCanTrace,!,quietly((wdmsg((not(tlbugger:ifCanTrace(G)))))),!,badfood(G),!,dumpST.
  610dtrace(G):-
  611    catch(dumptrace1(G),E,handle_dumptrace_signal(G,E)).
  612
  613handle_dumptrace_signal(G,E):-arg(_,v(continue,abort),E),!,wdmsg(continuing(E,G)),notrace,nodebug.
  614handle_dumptrace_signal(_,E):-throw(E).
  615%:- export(dumptrace_or_cont/1).
  616%dumptrace_or_cont(G):- catch(dumptrace(G),E,handle_dumptrace_signal(G,E)).
  617
  618
  619
  620% :-meta_predicate(dtrace(+,?)).
  621
  622%=
 dtrace(+MSG, ?G) is semidet
(debug) Trace.
  628dtrace(MSG,G):-wdmsg(MSG),dtrace(G).
  629
  630
  631%=
 to_wmsg(:TermG, :TermWG) is semidet
Converted To Wmsg.
  637to_wmsg(G,WG):- \+ compound(G),!,WG=G.
  638to_wmsg(M:G,M:WG):-atom(M), to_wmsg(G,WG).
  639to_wmsg(dmsg(G),WG):-!, to_wmsg(G,WG).
  640to_wmsg(wdmsg(G),WG):-!, to_wmsg(G,WG).
  641to_wmsg(G,WG):- (G=WG).
  642
  643
  644with_source_module(G):-
  645  '$current_source_module'(M),
  646  '$current_typein_module'(WM),
  647  scce_orig('$set_typein_module'(M),G,'$set_typein_module'(WM)).
  648
  649
  650
  651% =====================
  652% dumptrace/1/2
  653% =====================
  654% :-meta_predicate(dumptrace(?)).
  655
  656%=
 dumptrace(?G) is semidet
Dump Trace.
  662dumptrace(G):- non_user_console,!,dumpST_error(non_user_console+dumptrace(G)),abort,fail.
  663dumptrace(G):-
  664  locally(set_prolog_flag(gui_tracer, false),
  665   locally(set_prolog_flag(gui, false),
  666    locally(set_prolog_flag(runtime_debug,0),
  667     dumptrace0(G)))).
  668
  669dumptrace0(G):- zotrace((tracing,notrace,wdmsg(tracing_dumptrace(G)))),!, catch(((dumptrace0(G) *-> dtrace ; (dtrace,fail))),_,true).
  670dumptrace0(G):-dumptrace1(G).
  671dumptrace1(G):-
  672  catch(attach_console,_,true),
  673    repeat,
  674    (tracing -> (!,fail) ; true),
  675    to_wmsg(G,WG),
  676    fmt(in_dumptrace(G)),
  677    wdmsg(WG),
  678    (get_single_char(C)->with_all_dmsg(dumptrace(G,C));throw(cant_get_single_char(!))).
  679
  680:-meta_predicate(dumptrace(0,+)).  681
  682ggtrace:-
  683  leash(-all),
  684  visible(+all),
  685  % debug,
  686  maybe_leash(+exception).
  687
  688%=
 dumptrace(:GoalG, +C) is semidet
Dump Trace.
  694dumptrace(_,0'h):- listing(dumptrace/2),!,fail.
  695dumptrace(_,0'g):-!,dumpST,!,fail.
  696dumptrace(_,0'G):-!,zotrace(dumpST0(500000)),!,fail.
  697dumptrace(_,0'D):-!,prolog_stack:backtrace(8000),!,fail.
  698dumptrace(_,0'd):-!,prolog_stack:backtrace(800),!,fail.
  699
  700dumptrace(G,0'l):-!,
  701  restore_trace(( zotrace(ggtrace),G)),!,notrace.
  702%dumptrace(G,0's):-!,quietly(ggtrace),!,(quietly(G)*->true;true).
  703dumptrace(G,0'S):-!, wdmsg(skipping(G)),!.
  704dumptrace(_,0'c):-!, throw(continue).
  705%dumptrace(G,0'i):-!,quietly(ggtrace),!,ignore(G).
  706dumptrace(_,0'b):-!,debug,break,!,fail.
  707dumptrace(_,0'a):-!,abort,!,fail.
  708% dumptrace(_,0'x):-!,must(lex),!,fail.
  709dumptrace(_,0'e):-!,halt(1),!.
  710dumptrace(_,0'm):-!,make,fail.
  711dumptrace(G,0'L):-!,use_module(library(xlisting)),call(call,xlisting,G),!,fail.
  712dumptrace(G,0'l):-!,visible(+all),show_and_do(rtrace(G)).
  713% dumptrace(G,0'c):-!, show_and_do((G))*->true;true.
  714dumptrace(G,0'r):-!, stop_rtrace,notrace,nortrace,srtrace,(rtrace((trace,G,notrace))),!,fail.
  715dumptrace(G,0'f):-!, notrace,(ftrace((G,notrace))),!,fail.
  716dumptrace(G,0't):-!,visible(+all),leash(+all),trace,!,G.
  717dumptrace(G,10):-!,dumptrace_ret(G).
  718dumptrace(G,13):-!,dumptrace_ret(G).
  719dumptrace(G,Code):- number(Code),char_code(Char,Code),!,dumptrace(G,Char).
  720dumptrace(_G,'p'):- in_cmt(if_defined(pp_DB,fail)),!,fail.
  721
  722
  723dumptrace(_,C):-fmt(unused_keypress(C)),!,fail.
  724% )))))))))))))) %  '
  725
  726%=
 dumptrace_ret(?G) is semidet
Dump Trace Ret.
  732dumptrace_ret(G):- zotrace((leash(+all),visible(+all),visible(+unify),trace)),G.
  733
  734% % % OFF :- system:use_module(library(logicmoo_utils_all)).
  735
  736% % % OFF :- system:use_module(library(logicmoo_startup)).
  737:- fixup_exports.