1:- module( debug_call, 2 [ 3 debug_call/2, 4 debug_call/3, 5 debug_call/4, 6 debuc/1, debuc/2, debuc/3, debuc/4, 7 debug_chain/2, debug_chain/3, 8 debug_consec/3, debug_consec/4, 9 debug_message/3, 10 debug_on/1, 11 debug_portray/2, 12 debug_set/2, 13 debugging_status/2, 14 debug_topic/2, 15 debug_topic/3, 16 debug_call_version/2, 17 debugging_topic/1 18 ] ). 19 20:- multifile(user:message_property/2). 21:- dynamic(debug_call_message_property/2). 22 23usermessage_property( Dbg, Property ) :- 24 debug_call_message_property( Dbg, Property ).
?- debug_call_version( -V, -D ). V = 1:5:0, D = date(2022,12,29).
*/
107debug_call_version( 1:5:0, date(2022,12,29) ). 108 109:- use_module(library(apply)). % maplist/4,... 110:- use_module(library(lists)). % member/4,... 111:- use_module(library(debug)). % debug/1,... 112:- use_module(library(lib)). 113 114:- lib(source(debug_call), [homonyms(true),index(false)]). 115:- lib(stoics_lib:locate/3 ). 116:- lib(stoics_lib:en_list/2). 117:- lib(stoics_lib:message_report/3). 118:- lib(stoics_lib:datime_readable/1). 119:- lib(end(debug_call) ).
130debuc( Topic ) :- 131 debug( Topic ). 132debuc( Topic, Goal ) :- 133 debug_call( Topic, Goal ). 134debuc( Topic, Goal, Args ) :- 135 debug_call( Topic, Goal, Args ). 136debuc( Topic, Goal, Pfx, Args ) :- 137 debug_call( Topic, Goal, Pfx, Args ).
If Goal with arity +2 is available call that instead of Goal with extra arguments Mess and Args
that will be passed to debug/3. If the goal (original or +2) fail, nothing is printed by
debug_call and the debug_call(T,G)
itself succeeds.
?- goal( Goal, Mess, Args ).
Examples
?- assert( (simple_mess(KVs,Mess,Args):- KVs =[a=A,b=B], atom_concat(A,B,Mess), Args=[]) ). ?- debug_call( ex, simple_mess([a=1,b=2],
160debug_call( Topic, Goal ) :- 161 debugging_topic( Topic ), 162 !, 163 debug_call_goal( Topic, Goal ). 164debug_call( _Topic, _Goal ). 165 166debug_call_goal( Topic, Moal ) :- 167 ( Moal = Mod:Goal -> true; Goal = Moal, Mod=user ), 168 functor( Goal, Functor, Arity ), 169 Extra is Arity + 2, 170 current_predicate( Mod:Functor/Extra ), 171 !, 172 ( call(Mod:Goal,Mess,Args) -> 173 debug( Topic, Mess, Args ) 174 ; 175 true 176 ). 177debug_call_goal( _Topic, Goal ) :- 178 ( call(Goal) -> true; true ).
194debug_chain( Topic, Then ) :- 195 to_list( Then, Thens ), 196 maplist( debug_chain(Topic), Thens, _Priors ). 197 198debug_chain( Topic, Then, Prior ) :- 199 debugging_topic( Topic ), 200 !, 201 debugging_status( Then, Prior ), 202 debug( Then ). 203debug_chain( _Topic, _Then, true ). 204 % setting 3rd to true is a bit presumptious of its uses later on
lib(debug)
does not create a record by inspecting the term (via expansion).
Particularly useful in sending uninstantiated Topics.
220debug_message( Topic, Mess, Args ) :-
221 Call =.. [debug,Topic,Mess,Args],
222 call( Call ).
lib(debug)
does not create a record by inspecting the term (via expansion).
Particularly useful in sending uninstantiated Topics.
238debugging_topic( Topic ) :-
239 Call =.. [debugging,Topic],
240 call( Call ).
debugging(Topic)
succeeds. Else, it is false.
Similar to debugging/2, but does not fail for undefined Topic.
?- debug( something ). true. ?- debugging_status( something, Some ). Some = true. ?- debugging_status( some_else, Else ). Else = false.
257debugging_status( Topic, Status ) :- 258 debugging_topic( Topic ), 259 !, 260 Status = true. 261debugging_status( _Topic, false ).
?- nodebug( chained ). true. ?- debug( testo ). Warning: testo: no matching debug topic (yet) true. ?- debug( chained, 'debugs chains 1', [] ). true. ?- debug_chain( testo, chained, Prior ). Prior = false. ?- debug( chained, 'debugs chains 2', [] ). % debugs chains 2 true. ?- Prior = false, debug_set( Prior, chained ). Prior = false. ?- debug( chained, 'debugs chains 3', [] ). true
290debug_set( false, Topic ) :- 291 nodebug( Topic ). 292debug_set( true, Topic ) :- 293 debug( Topic ).
options(debug(true),Opts)
, with Restore
being instantiated to a term that can be used to restore the
original debug state of Topic (see options_restore/2). If options(debug(false),Opts)
then Topic is stopped from being debugged (Restore still holds the
correct term for restoring debugging state for topic to precall status).
?- assert( ( on_t(I,Topic) :- (debugging(Topic) -> write(I-y(Topic)) ; write(I-n(Topic))), nl ) ). ?- T = options, debug(T), on_t(1,T), debug_topic(T,[debug(false)],R), on_t(2,T), debug_set(R,T), on_t(3,T). 1-y(options) 2-n(options) 3-y(options) T = options, R = true. ?- T = options, nodebug(T), on_t(1,T), debug_topic(T,[debug(true)],R), on_t(2,T), debug_set(R,T), on_t(3,T). 1-n(options) 2-y(options) 3-n(options) T = options, R = false.
324debug_topic( Topic, Opts, Restore ) :- 325 memberchk( debug(Dbg), Opts ), 326 Dbg == true, 327 !, 328 debug_topic_restore( Topic, Restore ), 329 debug( Topic ). 330debug_topic( Topic, _Opts, Restore ) :- % becomes default under this implementation 331 debug_topic_restore( Topic, Restore ), 332 nodebug( Topic ). 333 334debug_topic_restore( Topic, Restore ) :- 335 debugging_topic( Topic ), 336 !, 337 Restore = true. 338debug_topic_restore( _Topic, false ).
?- debug_topic( true, example ).
352debug_topic( true, Topic ) :- 353 debug( Topic ). 354debug_topic( false, Topic ) :- 355 nodebug(Topic).
361debug_on( Topic ) :-
362 asserta( prolog_debug:debugging(Topic,true,[user_error])).
portray_clause(Term)
if we are debugging Topic.
371debug_portray( Topic, Term ) :- 372 debugging_topic( Topic ), 373 !, 374 portray_clause( Term ). 375debug_portray( _Topic, _Term ).
When Goal is a known abbreviation, then Arg usually qualifies the output generated.
When Goal is of the form call(Goal)
, Arg will be passed to debug(Topic,Mess,Arg)
.
Goal in:
debug( Topic, Mess, Args)
. (Goal is called in non-deterministic context).call(Goal)
loc(File,Exts)
or simply File in which case Exts = ''.arg(1)
) and its current instantiation (arg(2)
)loc(File,Exts)
or simply File in which case Exts = ''.?- debug( ex ). ?- debug_call( ex, length, '', list1/[x,y,z] ). % Length for list, list1: 3 ?- debug_call( ex, length, 'some prefix', [list1,list2]/[[x,y,z],[a,b,c]] ). % some prefix lengths for lists, list1: 3, list2: 3 ?- debug_call( ex, wrote, loc(file,csv) ). % Could not locate wrote on file specified by: file, and extensions: csv ?- csv_write_file( 'file.csv', [] ). ?- debug_call( ex, wrote, loc(file,csv) ). % Wrote on file: '/home/nicos/pl/lib/src/trace/file.csv' ?- debug_call( ex, task(stop), 'write on file' ). % At 15:44:1 on 2nd of Jul 2014 finished task: write on file. ?- debug_call( ex, (length([a,b,c],L),write(len(L)),nl) ). len(3) L = 3. ?- Etcs = [suv-17.09.26.txg,suv-17.09.21.txg], Etc = suv-17.09.26.txg, debug_call( suv, ns_sel, c(Etc,Etcs,'suv file',true) ) Continuing with: suv file, as: suv-17.09.26.txg, from non singleton list: [suv-17.09.26.txg,suv-17.09.21.txg] ?- debuc( ex, pwd, here ). % Pwd at, here, is: '/Users/nicosangelopoulos/.local/share/swi-prolog/pack/Downloads/bio_db_repo-publish/bio_db_repo-20.09.14/data/hs/maps/hgnc/' true. ?- debuc( ex, pwd, false ). % Pwd: '/Users/nicosangelopoulos/.local/share/swi-prolog/pack/Downloads/bio_db_repo-publish/bio_db_repo-20.09.14/data/hs/maps/hgnc/' true.
At some point around SWI-Prolog 8, behaviour of debug/3 changed in being more strict about messages with no arguments. As of version 1.2 debug_call/3 can act as a replacement of debug/3 but with the old behaviour.
?- debug( ex, 'Messagging...', true ). Messagging... [[ EXCEPTION while printing message 'Messagging...' with arguments user:true: raised: format('too many arguments') ]] true. ?- debug_call( ex, 'Messagging...', true ). % Messagging... true.
501debug_call( Topic, Goal, Args ) :- 502 debug_call( Topic, Goal, '', Args ). 503 504debug_call( Topic, Goal, Pfx, Args ) :- 505 debugging_topic( Topic ), 506 !, 507 debugging_call( Topic, Goal, Pfx, Args ). 508debug_call( _Topic, _Goal, _Mess, _Args ). 509 510debugging_call( Topic, Goal, Mess, Args ) :- 511 debug_call_topic( Goal, Mess, Args, Topic ), 512 !. 513debugging_call( Topic, call(Goal), Mess, Args ) :- 514 !, 515 call( Goal ), 516 debug_message( Topic, Mess, Args ). 517debugging_call( Topic, Goal, Mess, Args ) :- 518 compound( Goal ), 519 call( Goal ), 520 !, 521 debug_message( Topic, Mess, Args ). 522% 20.03.07: this makes debug_call/3 a replacement for debug/3... 523debugging_call( Topic, Mess, '', DbgCallArgs ) :- 524 % as of SWI-Prolog 8.?.? there is an error thrown when true is used instead of [] as 3rd arg of debug/3 525 atomic( Mess ), 526 !, 527 ( DbgCallArgs == true -> Args = []; DbgCallArgs = Args ), 528 debug( Topic, Mess, Args ). 529debugging_call( Topic, Goal, Mess, Args ) :- 530 Called = debug_call(Topic,Goal,Mess,Args), 531 message_report( 'failure ignored on: ~w', Called, warning ).
?- debug( dbg ). ?- debug_consec( dbg, 'what:~w', when ). % what: when <- in blue ?- debug_consec( dbg, 'what:~w', when ). % what: when <- in magenta ?- debug_consec( dbg, [blue,green], 'what:~w', when ). % what: when <- in blue ?- debug_consec( dbg, [blue,green], 'what:~w', when ). % what: when <- in green
Version 0.2
?- debug_consec( dbg, magenta, 'what:~w', when ). % what: when <- in magenta
566debug_consec( Topic, Mess, Args ) :- 567 Clrs = [blue,magenta], 568 debug_consec( Topic, Clrs, Mess, Args ). 569 570debug_consec( Topic, ClrS, Mess, Args ) :- 571 debugging_topic( Topic ), 572 !, 573 ( is_list(ClrS) -> Clrs = ClrS; Clrs = [ClrS] ), 574 debug_consec_topic( Topic, Clrs, Mess, Args ). 575debug_consec( _Topic, _Clrs, _Mess, _Args ). 576 577debug_consec_topic( Topic, Clrs, Mess, Args ) :- 578 with_output_to( atom(Topicat), write_term(Topic,[]) ), 579 ( nb_current(Topicat,Value) -> true; Value = 1 ), 580 ( nth1(Value, Clrs, Clr) -> true; Clrs = [Clr|_] ), 581 debug_consec_color( Topic, Clr, Mess, Args ), 582 length( Clrs, Len ), 583 ( Value < Len -> Next is Value + 1; Next is 1 ), 584 nb_setval( Topicat, Next ). 585 586debug_consec_color( Topic, Clr, Mess, Args ) :- 587 user:message_property( debug(_), color(Attrs) ), 588 !, 589 retractall( debug_call_message_property(debug(_),color(_)) ), 590 assert( debug_call_message_property(debug(_),color(fg(Clr))) ), 591 debug_message( Topic, Mess, Args ), 592 retractall( debug_call_message_property(debug(_),color(_)) ), 593 assert( debug_call_message_property(debug(_),color(Attrs)) ). 594debug_consec_color( Topic, Clr, Mess, Args ) :- 595 assert( debug_call_message_property(debug(_),color(fg(Clr))) ), 596 debug_message( Topic, Mess, Args ), 597 retractall( debug_call_message_property(debug(_),color(_)) ). 598 599debug_call_topic( info, Pfx, Arg, _Topic ) :- 600 ( (\+ var(Arg),Arg = Mess/Args) -> 601 true 602 ; 603 % fixme: not sure what to do here ? 604 Mess = Arg, 605 Args = [] 606 ), 607 % lib_message_report( Format, Args, Kind ) :- 608 debug_message_prefixed( Pfx, Mess, Prefixed ), 609 phrase('$messages':translate_message(debug(Prefixed,Args)), Lines), 610 print_message_lines(current_output, kind(informational), Lines). 611 612debug_call_topic( dims, Pfx, NamesPrv/MtxsPrv, Topic ) :- 613 ( is_list(NamesPrv) -> Names=NamesPrv, MtxsPrv=Mtxs, With = 'Dimensions for matrices, ' 614 ; [NamesPrv] = Names, [MtxsPrv]=Mtxs, With = 'Dimensions for matrix, ' 615 ), 616 debug_message_prefixed( Pfx, With, Prefixed ), 617 maplist( debug_mtx_dims, Mtxs, NRows, NCols ), 618 findall( PartM, (member(_,Names),PartM=' (~w) nR: ~d, nC: ~d.'), MParts ), 619 atomic_list_concat( MParts, '', Right ), 620 findall( [Name,NRow,NCol], (nth1(N,Names,Name),nth1(N,NRows,NRow),nth1(N,NCols,NCol)), NNest ), 621 flatten( NNest, Vars ), 622 atom_concat( Prefixed, Right, Message ), 623 debug_message( Topic, Message, Vars ). % do the messaging ! 624debug_call_topic( enum, Pfx, InArg, Topic ) :- 625 ground( InArg ), 626 ( InArg = Left/Term -> true; Left = unnamed, Term = InArg ), 627 ( is_list(Term) -> 628 length( Term, Len ), 629 number_codes( Len, LenCs ), 630 length( LenCs, SpcLen ), 631 debug_call_topic_list_delim( Left, Topic, Pfx, 'Starting enumeration of list: ~w' ), 632 debug_call_topic_enum( Term, 1, SpcLen, Topic ), 633 debug_call_topic_list_delim( Left, Topic, Pfx, 'Ended enumeration of list: ~w' ) 634 ; 635 Term =.. Args, 636 length( Args, Len ), 637 number_codes( Len, LenCs ), 638 length( LenCs, SpcLen ), 639 debug_call_topic_list_delim( Left, Topic, Pfx, 'Starting enumeration of list: ~w' ), 640 debug_call_topic_enum( Args, 1, SpcLen, Topic ), 641 debug_call_topic_list_delim( Left, Topic, Pfx, 'Ended enumeration of list: ~w' ) 642 ). 643debug_call_topic( length, Pfx, NamesPrv/ListsPrv, Topic ) :- 644 % add version without names 645 ( is_list(NamesPrv) -> Names=NamesPrv, ListsPrv=Lists, With = 'Lengths for lists, ' 646 ; [NamesPrv] = Names, [ListsPrv]=Lists, With = 'Length for list, ' 647 ), 648 debug_message_prefixed( Pfx, With, Prefixed ), 649 maplist( length, Lists, Lengths ), 650 findall( ['~w: ~w',', '], member(_,Lengths), WsNest ), 651 flatten( WsNest, WsL ), 652 once( append(WsLComma,[_],WsL) ), 653 append( WsLComma, ['.'], WsLDot ), 654 atomic_list_concat( WsLDot, '', Right ), 655 atom_concat( Prefixed, Right, Message ), 656 findall( [Name,Length], (nth1(N,Names,Name),nth1(N,Lengths,Length)), NLNest ), 657 flatten( NLNest, NLs ), 658 debug_message( Topic, Message, NLs ). % do the messaging 659debug_call_topic( list, _Pfx, InArg, Topic ) :- 660 ground( InArg ), 661 ( InArg = Left/List -> 662 ( Left = Hdr/Ftr -> true ; Hdr = Left, Ftr = '' ) 663 ; 664 List = InArg, Hdr = '', Ftr = '' 665 ), 666 debug_call_topic_list_delim( Hdr, Topic, Pfx, 'Starting listing of list: ~w' ), 667 maplist( debug_message(Topic,'~w'), List ), 668 debug_call_topic_list_delim( Ftr, Topic, Pfx, 'Ended listing of list: ~w' ). 669debug_call_topic( odir, Pfx, Odir, Topic ) :- 670 ( exists_directory(Odir) -> 671 Mess = 'Ouput in directory: ~w' 672 ; 673 Mess = 'Output (claimed) in (non-existing) directory: ~w' 674 ), 675 debug_message_prefixed( Pfx, Mess, Prefixed ), 676 debug_message( Topic, Prefixed, [Odir] ). 677debug_call_topic( options, _Pfx, InArg, Topic ) :- 678 ( InArg = Left/Opts -> true; Left = unnamed, Opts = InArg ), 679 debug( Topic, 'Options in predicate: ~w, are: ~w', [Left,Opts] ). 680debug_call_topic( term, Pfx, DbgTerm, Topic ) :- 681 Mess = '~w', 682 debug_message_prefixed( Pfx, Mess, Prefixed ), 683 debug_message( Topic, Prefixed, [DbgTerm] ). 684debug_call_topic( var, Pfx, DbgTerm, Topic ) :- 685 arg( 1, DbgTerm, Var ), 686 arg( 2, DbgTerm, Val ), 687 Mess = 'Variable: ~a, value: ~w', 688 debug_message_prefixed( Pfx, Mess, Prefixed ), 689 debug_message( Topic, Prefixed, [Var,Val] ). 690debug_call_topic( wrote, Pfx, ForLoc, Topic ) :- 691 ( ForLoc = loc(Spec,Ext) -> true; Spec=ForLoc, Ext = '' ), 692 catch( locate(Spec,Ext,Loc), Excp, true ), 693 MessW = 'Wrote on file: ~p', 694 debug_call_location_exception_message( Excp, Loc, MessW, Mess, Args ), 695 debug_message_prefixed( Pfx, Mess, Prefixed ), 696 debug_message( Topic, Prefixed, Args ). 697debug_call_topic( read, Pfx, ForLoc, Topic ) :- 698 ( ForLoc = loc(Spec,Ext) -> true; Spec=ForLoc, Ext = '' ), 699 catch( locate(Spec,Ext,Loc), Excp, true ), 700 MessW = 'Read from file: ~p', 701 debug_call_location_exception_message( Excp, Loc, MessW, Mess, Args ), 702 debug_message_prefixed( Pfx, Mess, Prefixed ), 703 debug_message( Topic, Prefixed, Args ). 704debug_call_topic( task(Whc), Pfx, Task, Topic ) :- 705 datime_readable( Readable ), 706 debug_call_topic_time_which_readable( Whc, Whcable ), 707 atomic_list_concat( [Readable,' ',Whcable,' task: ~w.'], Mess ), 708 debug_message_prefixed( Pfx, Mess, Prefixed ), 709 debug_message( Topic, Prefixed, [Task] ). 710debug_call_topic( start, Pfx, Arg, Topic ) :- 711 Mess = 'Starting: ~w', 712 debug_message_prefixed( Pfx, Mess, Prefixed ), 713 ( Arg == true -> Rep = Topic; Rep = Arg ), 714 debug_message( Topic, Prefixed, [Rep] ). 715debug_call_topic( end, Pfx, Arg, Topic ) :- 716 Mess = 'Finished: ~w', 717 debug_message_prefixed( Pfx, Mess, Prefixed ), 718 ( Arg == true -> Rep = Topic; Rep = Arg ), 719 debug_message( Topic, Prefixed, [Rep] ). 720debug_call_topic( pwd, Pfx, Stage, Topic ) :- 721 working_directory( Pwd, Pwd ), 722 ( Stage == false -> 723 Mess = 'Pwd: ~p', Args = [Pwd] 724 ; 725 Mess = 'Pwd at, ~w, is: ~p', Args = [Stage,Pwd] 726 ), 727 debug_message_prefixed( Pfx, Mess, Prefixed ), 728 debug_message( Topic, Prefixed, Args ). 729debug_call_topic( ns_sel, Pfx, Term, Topic ) :- 730 % ( Term = [Fst,Sec] -> true; arg(1,Term,Fst),arg(2,Term,Sec) ), 731 arg( 1, Term, Fst ), 732 arg( 2, Term, Sec ), 733 functor( Term, _Tname, Arity ), 734 ( Sec == [] -> 735 true % fixme: it will make more sense to throw an error if Sec = [] 736 ; 737 ( Sec = [_Single] -> 738 ( (Arity>3,arg(4,Term,true)) -> 739 ( (Arity>2,\+ arg(3,Term,false)) -> 740 arg(3,Term,Trd), 741 Mess= 'Continuing with: ~w as: ~w, (only match).', MArgs = [Trd,Fst] 742 ; 743 Mess= 'Continuing with only match: ~w.', MArgs = [Fst,Sec] 744 ) 745 ; 746 Mess = 'Continuing: ~w, from non singleton list: ~w', MArgs = [Fst,Sec] 747 ) 748 ; 749 ( (Arity>2,\+ arg(3,Term,false)) -> 750 arg(3,Term,Trd), 751 Mess = 'Continuing with: ~w, as: ~w, from non singleton list: ~w', MArgs = [Trd,Fst,Sec] 752 ; 753 Mess = 'Continuing: ~w, from non singleton list: ~w', MArgs = [Fst,Sec] 754 ) 755 ), 756 debug_message_prefixed( Pfx, Mess, Prefixed ), 757 debug_message( Topic, Prefixed, MArgs ) 758 ). 759 760debug_call_topic_enum( [], _I, _Len, _Topic ). 761debug_call_topic_enum( [H|T], I, Len, Topic ) :- 762 number_codes( I, ICs ), 763 length( ICs, ICsLen ), 764 PadLen is Len - ICsLen, 765 findall( ' ', between(1,PadLen,_), Spcs ), 766 atomic_list_concat( Spcs, '', Pad ), 767 atomic_list_concat( [Pad,'~d.~w'], '', Mess ), 768 debug_message( Topic, Mess, [I,H] ), 769 J is I + 1, 770 debug_call_topic_enum( T, J, Len, Topic ). 771 772debug_call_topic_list_delim( '', _Topic, _Pfx, _Mess ). 773debug_call_topic_list_delim( ListName, Topic, Pfx, Mess ) :- 774 debug_message_prefixed( Pfx, Mess, Prefixed ), 775 debug_message( Topic, Prefixed, [ListName] ). 776 777debug_call_topic_time_which_readable( Wch, Wchable ) :- 778 debug_call_topic_time_which_readable_known( Wch, Wchable ), 779 !. 780debug_call_topic_time_which_readable( Wch, Wch ). 781 782debug_call_topic_time_which_readable_known( start, starting ). 783debug_call_topic_time_which_readable_known( finish, finished ). 784 785debug_call_location_exception_message( Var, Loc, MessI, MessO, Args ) :- 786 var(Var), 787 !, 788 MessI = MessO, 789 Args = Loc. 790debug_call_location_exception_message( locate(cannot_locate(Spec,Ext)), _Loc, _MessI, Mess, Args ) :- 791 Mess = 'Could not locate file specified by: ~w, and extensions: ~w', 792 Args = [Spec,Ext]. 793debug_call_location_exception_message( Error, _Loc, _MessI, _Mess, _Args ) :- 794 % fixme: 795 throw( debug_call_caught(Error) ). 796 797debug_mtx_dims( [], 0, 0 ) :- 798 !. 799debug_mtx_dims( Rows, NRows, NCols ) :- 800 length( Rows, NRows ), 801 Rows = [Hdr|_], 802 ( is_list(Hdr) -> length(Hdr,NCols); functor(Hdr,_,NCols) ). 803 804debug_message_prefixed( '', Standard, Standard ) :- !. 805debug_message_prefixed( Pfx, Standard, Prefixed ) :- 806 sub_atom( Standard, 0, 1, Aft, Fst ), 807 downcase_atom( Fst, Low ), 808 sub_atom( Standard, 1, Aft, 0, Right ), 809 atomic_list_concat( [Pfx,' ',Low,Right], Prefixed )
Debugging with calls.
Avoids running goals to produce output that is only relevant while debugging. Includes pre-canned, often used calls.
Examples
Variable topics
This library avoids the messy way in which
package(debug)
deals with variable debug topics. That is, their term expansion and subsequent pattern matching mishandles goals of the form debugging/1 and debug/3 that have an unbound variable in the 1st argument. debug_calls uses dynamic -..Pack info
*/
options_debug( Opts, Mess, Args )
only writes if Opts containsdebug(true)
. maybe this should be part ofpack(options)
lib(debug)
's expansions