/*  OUTPUT.PL  */


/*
:- module output.


:- public output/1,
          add_user_output/1,
          del_user_output/1.
*/


/*
SPECIFICATION
-------------

This module exports output/1, a simple formatted write predicate.
It defines the following operators, used to join the arguments to
output:
*/
:- op( 30, xf, ~ ).
:- op( 30, xf, ~~ ).
:- op( 40, xfy, ~<> ).
:- op( 40, xfy, <> ).
:- op( 40, xfy, ... ).
/*

PUBLIC output( Term ):
----------------------

If Term is uninstantiated, action is undefined (in fact, we call 'bug').
This is justified because we rarely _do_ want to output variables, while
treating uninstantiated Terms as an error has caught several bugs. You can
use var_ if you do want to output variables.

If
    user_output( Term )
succeeds, assume that the call of user_output has written Term, and
return, doing no other output. user_output provides a means of extending
'output' by adding new clauses for particular kinds of term, in the same
way that 'portray' does for 'print'.

If Term = A~, output A followed by a newline. (Tilde looks like an N for
newline: think of its use in Spanish).

If Term = A~~, output A followed by two newlines.

If Term = A<>B, output A immediately followed by B.

If Term = A~<>B, output A followed by a newline followed by B.

If Term = A...B, output A, then a space, then B.

If Term = result_(Pred,Arg), call the goal
    Pred(Arg,Text)
with a new variable Text, then output Text. Undefined if Pred
fails.

If Term = seplist_(List,Sep), write the elements of List separated
by Sep.

If Term = seplist_(List,Sep,Elt,Form), bind each element of List to
Elt, then write Form, which should contain Elt as a free variable.
As above, separate by Sep. Example:
    output( seplist_([a+1,b+2],' ',X+Y,X) )
will write a b.

If Term = nl_, write a newline.

If Term = write_(X), then call write(X).

If Term = writeq_(X), then call writeq(X).

if Term = display_(X), then call display(X).

If Term = put_(C), then put(C) (unless, is_newline_char(C), when we call
nl).

If Term = puts_(S) then S is a list of character codes. Do as above on
each one.

If Term = var_(V) then V is a variable. Action undefined (i.e. call bug)
if it isn't, else write(V).

If Term = anything else, call write(Term).


PUBLIC add_user_output( P+ ):
-----------------------------

"There is a clause
    user_output( Term ) :- P( Term )
in the database".

P must be the name of an arity-1 predicate. 'add_user_output' adds (if
one does not already exist) a clause like that shown above defining
'user_output' to call P. This gives a way of extending 'output'.

Example: Suppose we want 'output' to write all two-element lists in the
form
    ( Element1 Element2 )
and all atoms as
    atom<<Atom>>

We define
    my_output( [E1,E2] ) :-
        !,
        output( '('...E1...E2...')' ).
    my_output( A ) :-
        atom(A),
        !,
        output( 'atom<<'<>A<>'>>' ).
and call
    add_user_output( my_output ).


PUBLIC del_user_output( P+ ):
-----------------------------

"There is no clause
    user_output( Term ) :- P( Term )
in the database".

The argument should be as for add_user_output. 'del_user_output' deletes
any clause of the form shown above.

Example: To delete the link to 'my_output' shown above:
    del_user_output( my_output ).
*/


/*
IMPLEMENTATION
--------------
*/


:- needs
   add_linking_clause / 3,
   bug / 1,
   bug / 2,
   del_linking_clause / 3,
   is_newline_char / 1.


:- dynamic user_output/1.


output( V ) :-
    var(V), !, bug('output: variable argument').

output( X ) :-
    user_output( X ), !.

output( A~ ) :-
    !, output( A ), output( nl_ ).

output( A~~ ) :-
    !, output( A ), output( nl_ ), output( nl_ ).

output( A<>B ) :-
    !, output(A), output(B).

output( A~<>B ) :-
    !, output(A), output( nl_ ), output(B).

output( A...B ) :-
    !, output(A), output(' '), output(B).

output( spaces_(N) ) :-
    !,
    output_spaces( N ).

output( result_(Pred,Arg) ) :-
    !,
    functor( Goal, Pred, 2 ),
    arg( Goal, Arg, 1 ),
    arg( Goal, Text, 2 ),
    (
        call( Goal )
    ->
        output( Text )
    ;
        bug( 'output: result_ failed', result_(Pred,Arg) )
    ).

output( seplist_(X,_) ) :-
    ( var(X) ; ( X\=[], X\=[_|_] ) ),
    !,
    bug( 'output: bad arg to seplist_', X ).

output( seplist_(L,Sep) ) :-
    !,
    output_seplist( L, Sep ).

output( seplist_(X,_,Elt,Form) ) :-
    ( var(X) ; ( X\=[], X\=[_|_] ) ),
    !,
    bug( 'output: bad arg to seplist_', X ).

output( seplist_(L,Sep,Elt,Form) ) :-
    !,
    output_seplist( L, Sep, Elt, Form ).

output( nl_ ) :-
    !, nl.

output( write_(X) ) :-
    !, write( X ).

output( writeq_(X) ) :-
    !, writeq( X ).

output( display_(X) ) :-
    !, display( X ).

output( puts_(S) ) :-
    !,
    output_string( S ).

output( put_(C) ) :-
    !,
    (
        is_newline_char(C)
    ->
        output(nl_)
    ;
        put( C )
    ).

output( var_(V) ) :-
    !,
    (
        nonvar(V)
    ->
        bug( 'output: var_ argument not a variable.', [V] )
    ;
        write(V)
    ).

output( X ) :-
    !, write( X ).


output_seplist( [], Sep ) :- !.

output_seplist( [H], Sep ) :-
    !, output( H ).

output_seplist( [H|T], Sep ) :-
    !,
    output( H ),
    output( Sep ),
    (
        T = [X]
    ->
        output( X )
    ;
        output_seplist( T, Sep )
    ).


output_seplist( [], Sep, _, _ ) :- !.

output_seplist( [H], Sep, E, Form ) :-
    !,
    not(not(( H=E, output(Form) ))).

output_seplist( [H|T], Sep, E, Form ) :-
    !,
    not(not(( H=E, output(Form) ))),
    output( Sep ),
    (
        T = [X]
    ->
        not(not(( X=E, output(Form) )))
    ;
        output_seplist( T, Sep, E, Form )
    ).


output_spaces( 0 ) :- !.

output_spaces( N ) :-
    output( ' ' ),
    Nd is N-1,
    output_spaces( Nd ).


output_string( [] ) :- !.

output_string( [C|T] ) :-
    output( put_(C) ),
    output_string( T ).


add_user_output( P ) :-
    add_linking_clause( user_output, P, 1 ).


del_user_output( P ) :-
    del_linking_clause( user_output, P, 1 ).


/*
:- endmodule.
*/