% -----------------------------------------------------------------------------
%  (C) Altran Praxis Limited
% -----------------------------------------------------------------------------
% 
%  The SPARK toolset is free software; you can redistribute it and/or modify it
%  under terms of the GNU General Public License as published by the Free
%  Software Foundation; either version 3, or (at your option) any later
%  version. The SPARK toolset is distributed in the hope that it will be
%  useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
%  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
%  Public License for more details. You should have received a copy of the GNU
%  General Public License distributed with the SPARK toolset; see file
%  COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
%  the license.
% 
% =============================================================================


/* used to print out unbound variables in SICSTUS */
portray('$VAR2'(Num)) :-
    print('_'),
    print(Num),
    !.

/* Portray a BINARY operator */
portray(Term):-
    nonvar(Term),
    functor(Term, Name_Atom, 2),
    arg(1,Term, A),
    arg(2,Term, B),
    /* Find a BINARY operator that matches */
    current_op(Pred,F,Name_Atom),
    (
       F = xfx
     ;
       F = yfx
     ;
       F = xfy
    ),
    /* Find the precedences of sub-terms A and B */
    term_pri(A, AP),
    term_pri(B, BP),
    (
        /* We parenthesize A in two cases:                                         */
        /* 1) For xfx operators, we parenthesize if A's functor is                 */
        /*    equal or lower in precedence to that of Term/                        */
        /* 2) If A's principal functor is lower precedence than that of Term, then */
        /*    we need to parenthesize A.                                           */
        /* Note that in ISO PROLOG, operator precedence numbers are SMALLER for    */
        /* more tightly binding operators, so we need the ">" operator to test     */
        /* for "lower precedence" here.                                            */
        (
           F = xfx,  /* Case 1 */
           AP >= Pred
        ;
           F \= xfx, /* Case 2 */
           AP > Pred
        ),
        write('('),
        write_term(A, [priority(Pred), portrayed(true), numbervars(true)]),
        write(')')
    ;
        (
           F = xfx,
           AP < Pred  /* not Case 1 */
        ;
           F \= xfx, 
           AP =< Pred /* not case 2 */
        ),
        write_term(A, [priority(Pred), portrayed(true), numbervars(true)])
    ),
    write(' '),
    write(Name_Atom),
    write(' '),
    (
        /* If B's principal functor is lower or equal precedence than that of Term, then */
        /* we need to parenthesize B                                                     */
        /* This is to re-produce the POPLOG behaviour where multi-term expressions       */
        /* with equal-precedence operators are printed with the RHS parenthesized        */
        /* For example, we want "A + (B + C)" NOT "A + B + C"                            */
        BP >= Pred,
        write('('),
        write_term(B, [priority(Pred), portrayed(true), numbervars(true)]),
        write(')')
    ;
        BP < Pred,
        write_term(B, [priority(Pred), portrayed(true), numbervars(true)])
    ),
    !.

/* Portray an UNARY operator of type fx or fy */
portray(Term):-
    nonvar(Term),
    functor(Term, Name_Atom, 1),
    arg(1,Term, A),
    /* Find a UNARY operator that matches */
    (
        current_op(Pred,fx,Name_Atom)
     ;
        current_op(Pred,fy,Name_Atom)
    ),
    /* Find the precedences of sub-term A */
    term_pri(A, AP),
    write(Name_Atom),
    write(' '),
    (
        /* If A's principal functor is lower or equal precedence than that of   */
        /* Term, then we need to parenthesize A                                 */
        AP >= Pred,
        write('('),
        write_term(A, [priority(Pred), portrayed(true), numbervars(true)]),
        write(')')
    ;
        AP < Pred,
        write_term(A, [priority(Pred), portrayed(true), numbervars(true)])
    ),
    !.

/* Portray an UNARY operator of type xf or yf */
portray(Term):-
    nonvar(Term),
    functor(Term, Name_Atom, 1),
    arg(1,Term, A),
    /* Find a UNARY operator that matches */
    (
        current_op(Pred,xf,Name_Atom)
     ;
        current_op(Pred,yf,Name_Atom)
    ),
    /* Find the precedences of sub-term B */
    term_pri(A, AP),
    (
        /* If A's principal functor is lower precedence than that of Term, then */
        /* we need to parenthesize A                                            */
        AP > Pred,
        write('('),
        write_term(A, [priority(Pred), portrayed(true), numbervars(true)]),
        write(')')
    ;
        AP =< Pred,
        write_term(A, [priority(Pred), portrayed(true), numbervars(true)])
    ),
    write(' '),
    write(Name_Atom),
    !.

/* Portray clauses for built-in PROLOG operators */
portray(List) :-
        (List = [] ; List = [_|_]), !,
        print_list(List).

/* Catch all - functor F, which is not an operator, with non-zero */
/*             number of arguments - print as F(Args) with commas */
/*             between the arguments.                             */
portray(X) :-
        X =.. [F|Args],
        atomic(F),
        Args \== [],
        !,
        write(F),
        write('('),
        print_list1(Args),
        write(')'),
        !.

/* print_list/1 - prints a list enclosed in [ ] with */
/* comma and space between each element              */
print_list(List) :-
        write('['),
        print_list1(List),
        write(']').

print_list1(.(X, A)) :-
        A == [],
        !,
        print(X).

/* Special case to deal with the tail of a list which is an unbound */
/* variable generated by mynumbervars/3                             */
print_list1(.(X, A)) :-
        A = '$VAR2'(Num),
        !,
        print(X),
        write(' | _'),
        print(Num).

print_list1(.(X, A)) :-
        var(A),
        !,
        print(X),
        write(' | '),
        print(A).

print_list1([X|Xs]) :- !,
        print(X),
        write(', '),
        print_list1(Xs).

print_list1([]).

/* term_pri/2 - returns the precedence of the principal functor of Term */
term_pri(Term, Prio) :-
    /* Careful here to only look for BINARY operators */
    nonvar(Term),
    functor(Term, Name_Atom, 2),
    (
       current_op(Prio, xfx, Name_Atom)
     ;
       current_op(Prio, yfx, Name_Atom)
     ;
       current_op(Prio, xfy, Name_Atom)
    ).

term_pri(Term, Prio) :-
    /* Careful here to only look for UNARY operators */
    nonvar(Term),
    functor(Term, Name_Atom, 1),
    (
       current_op(Prio, fx, Name_Atom)
     ;
       current_op(Prio, fy, Name_Atom)
     ;
       current_op(Prio, xf, Name_Atom)
     ;
       current_op(Prio, yf, Name_Atom)
    ).

/* We don't want to parenthesize atoms, literals and so on, so we pretend */
/* that these have a very high precedence                                 */
term_pri(_Term, Prio) :-
    Prio = 1,
    !.


%###############################################################################
%END-OF-FILE
