1:- use_module(prolog_version).    2:- (is_dialect(swi) -> use_module(swi_specific) ; use_module(sicstus_specific)).    3:- use_module(sciff_options).    4
    5:- multifile portray/1.    6
    7:- use_module(text_style).    8
    9% Predicate portray is called, both in SICStus and in SWI, recursively for each nonvariable
   10% term. If it succeeds, the host Prolog assumes the term has been printed.
   11% So, if I want to redefine the printing of the term e([F,A],Atom,T) to E(Atom,T), I should do  the following:
   12%
   13%   portray(e(_,A,B)) :- write('E('), print(A), write(','), print(T), write(')').
   14%
   15% In fact, print/1 calls portray/1, while write/1 does not (does the default printing).
   16%
   17% I want to change the default printing of the variables as well, so my portray predicate does
   18% a recursive call, instead of calling print/1.
   19
   20% In SWI it works, but in SICStus variables get printed as '$VAR([codelist....])
   21% So, in SWI, the portray predicate has a recursive call (and must always succeed,
   22% while in SICStus it calls print, and may fail (for a general term, ...), so that the default
   23% print is used.
   24
   25portray(Var):-
   26    is_dialect(swi),
   27    var(Var),!,
   28    (get_quant(Var,Q)
   29        ->  set_print_style_of_quantification(Q),
   30            write(Var), reset_text_style
   31        ;   write(Var)
   32    ).
   33
   34
   35%%% Insert here the redefinition of the printing of terms
   36
   37
   38portray(e([_,_],A,T)):-
   39    %functor(A,F,N),
   40    print(e(A,T)).
   41portray(h([_,_],A,T)):-
   42    %functor(A,F,N),
   43    print(h(A,T)).
   44portray(en([_,_],A,T)):-
   45    %functor(A,F,N),
   46    print(en(A,T)).
   47portray(abd([_,_],A,T)):-
   48    %functor(A,F,N),
   49    print(abd(A,T)).
   50
   51portray(e(A,T)):-
   52    foreground_color(green), text_property(bold,1), write('e('), reset_text_style,
   53    my_print(A),
   54    foreground_color(green), text_property(bold,1), write(','), reset_text_style,
   55    my_print(T),
   56    foreground_color(green), text_property(bold,1), write(')'), reset_text_style.
   57portray(en(A,T)):-
   58    foreground_color(green), text_property(bold,1), write('en('), reset_text_style,
   59    my_print(A),
   60    foreground_color(green), text_property(bold,1), write(','), reset_text_style,
   61    my_print(T),
   62    foreground_color(green), text_property(bold,1), write(')'), reset_text_style.
   63portray(h(A,T)):-
   64    foreground_color(blue), text_property(bold,1), write('h('), reset_text_style,
   65    my_print(A),
   66    foreground_color(blue), text_property(bold,1), write(','), reset_text_style,
   67    my_print(T),
   68    foreground_color(blue), text_property(bold,1), write(')'), reset_text_style.
   69
   70portray(ic(Body,Head)):-
   71    get_option(portray_ic,on),
   72    (get_option(coloring,on) -> true ; write('ic:')),
   73    nl,
   74    portray_args(Body),
   75    nl,
   76    foreground_color(red), text_property(bold,1),
   77    write('--->\t'),
   78    reset_text_style,
   79    print_disjunction(Head), nl.
   80
   81portray(psic(Body,Head)):-
   82    get_option(portray_ic,on),
   83    (get_option(coloring,on) -> true ; write('psic:')),
   84    nl,
   85%    print_body(Body),
   86    print_psic_body(Body),
   87    %(portray_args(Body) -> true ;  write('failed portray_args('), write(Body), write(')'),nl, fail),
   88    nl,
   89    foreground_color(cyan), text_property(bold,1),
   90    write('--->\t'),
   91    reset_text_style,
   92    print_disjunction(Head), nl.
   93
   94portray(clp_constraint(C)):- my_print(C).
   95portray(st(C)):- my_print(C).
   96
   97% CLP constraints (SICStus)
   98
   99    portray(clpfd:'t=u IND'(A,B)):-
  100        print(A), write(#=), print(B).
  101
  102    portray(clpfd:'x\\=y IND'(A,B)):-
  103        print(A), write(#\=), print(B).
  104
  105
  106    portray(clpfd:'t=<u+c'(A,B,C)):-
  107        (C=0    -> print(A#=<B);
  108         C= -1   -> print(A#<B);
  109         C>0    -> print(A#=<B+C);
  110                   print(A#=<B), print(C) % Negative number: sign written by print(C)
  111         ).
  112
  113
  114    portray(clpfd:'t>=u+c'(A,B,C)):-
  115        (C=0    -> print(A#>=B);
  116         C=1    -> print(A#>B);
  117         C>0    -> print(A#>=B+C);
  118                   print(A#>=B), print(C) % Negative number: sign written by print(C)
  119         ).
  120
  121portray(A):-
  122    is_dialect(swi),
  123    atomic(A), !, write(A).
  124
  125portray(List):-
  126    is_dialect(swi),
  127    is_list(List),!,    % Questo non va bene se e` una difference list o una lista tipo: [A|p]
  128    print('['),
  129    portray_list(List),
  130    print(']').
  131
  132
  133portray(Term):-
  134    is_dialect(swi),
  135    Term =.. [Op|Args],
  136    current_op(_,Type,Op),
  137    (member(Type,[xfx, xfy, yfx, yfy])
  138        ->  Args = [X,Y],
  139            portray(X), print(Op), portray(Y)
  140        ;
  141     member(Type,[xf,yf])
  142        ->  Args = [X],
  143            portray(X), print(Op)
  144        ;
  145     member(Type,[fx,fy])
  146        ->  Args = [X],
  147            print(Op), portray(X)
  148        ;   print(Op), print('('), portray_args(Args),
  149            print(')')
  150    ).
  151
  152portray(Term):-
  153    is_dialect(swi),
  154    Term =.. [F|Args],
  155%    one_is_var(Args),
  156    print(F), print('('), portray_args(Args),
  157    print(')').
  158
  159
  160set_print_style_of_quantification(forall):- foreground_color(magenta).
  161set_print_style_of_quantification(forallf):- foreground_color(magenta), text_property(underlined,1).
  162set_print_style_of_quantification(exists):- foreground_color(blue).
  163set_print_style_of_quantification(existsf):- foreground_color(blue), text_property(underlined,1).
  164
  165portray_args([Term]):-!,
  166    my_print(Term).
  167portray_args([A,B|T]):- !,
  168    my_print(A), write(','), portray_args([B|T]).
  169
  170
  171portray_list(Var):- var(Var),!, write('|'), write(Var).
  172portray_list([X]):- !, print(X).
  173portray_list([A,B|T]):-
  174    print(A), write(','), portray_list([B|T]).
  175
  176my_print(X):- 
  177    (is_dialect(swi), portray(X) -> true ; print(X)).
  178
  179
  180
  181
  182%%% Auxiliary predicates
  183is_code_list([]).
  184is_code_list([H|T]):-
  185    integer(H),
  186    is_code_list(T).
  187
  188print_disjunction([H]):- !,
  189    portray_args(H).
  190print_disjunction([H1,H2|T]):-
  191    portray_args(H1), nl, write('\\/\t'),
  192    print_disjunction([H2|T]).
  193
  194print_body([]).
  195print_body([H|T]):- !,
  196    print_body(H), write(','),
  197    print_body(T).
  198print_body(A):- print(A).
  199
  200print_psic_body([[]|T]):- !,print_psic_body(T).
  201print_psic_body([A|T]):- !,portray_args(A),
  202    (empty_body(T) -> true ; write(','), print_psic_body(T)).
  203
  204empty_body([]).
  205empty_body([[]|T]):- empty_body(T)