/*  SDO.PL  */
 
 
:- module sdo.
 
 
:- public sdo_reconsult/1,
          sdo_reconsult/0,
          sdo_rewrite/2.
 
 
/*
SPECIFICATION
-------------
 
This module defines predicates for syntax-directed pretty-printing. The
idea is that you can write, using DCG notation, rules that specify how
terms are to be written out. For example
    if( if(Cond,Then,Else) ) -->
        [if], statement(Cond), [then], nl,
        +(4), statement(Then), -(4), nl,                    
        [else], nl,
        +(4), statement(Else), -(4), nl.
 
    statement( assign(L,R) ) -->
        expression(L), [:=], expression(R).
    statement( call(Proc,Args) ) -->
        [Proc, '('], arglist(Args), [')'].
    statement( if(Cond,Then,Else) ) -->
        if( if(Cond,Then,Else) ).
    ...
where if(Cond,Then,Else) is the internal form of an IF-statement for
(e.g.) Pascal; assign(L,R) is the internal form of an assignment, and so
on.
 
The intention is that elements of lists (e.g. "if", ":=") are written
out as they stand. There are also a few special terms: these include
+(N) ("advance left margin by N places"), sp ("write a space"), and nl
("newline"). You can define how certain kinds of token are to be
written, and whether they're to be separated by a space or not. For
example, in most programming languages, we can immediately follow an
identifier by a plus sign; but if it's to be followed by a number, we
must leave a space so that the number doesn't look like part of the
identifier.
 
The predicate sdo_reconsult reads a file of SDO rules and asserts the
Prolog equivalents. You can then pretty-print a term by doing
    ?- pretty( Cat, LineLength, Tag )
where Cat is some SDO rule head (pretty is the SDO analogue of
"phrase"). For example,
    ?- pretty( if( a=1, assign(b,2), call(halt) ), 80, pascal ).
 
We also define sdo_rewrite, for rewriting a file of SDO rules into
another file of Prolog clauses, which can then be consulted separately.
 
The implementation section of this module explains in detail how SDO
rules are implemented.
 
 
The SDO system comes as two modules. The first part (this one) contains
the rule translator, and can (via sdo_rewrite) be used independently of
the token output predicates called by pretty. So if you just want to use
sdo_rewrite, but not yet to consult the file it makes, then you only
need this module.
 
The token output predicates live in the second part (module SDO_OUTPUT).
You need these whenever you call pretty. When you've got to the end of
the specification section here, you should turn to SDO_OUTPUT.
 
 
PUBLIC sdo_reconsult( File+: atom ):
------------------------------------
 
sdo_reconsult reads a file and acts as similarly as possible to
reconsult, but expanding SDO rules to clauses before asserting them.
If clauses for the rules already exist, they will be superseded.
Its action is undefined if the file can't be opened, read, etc.
 
It treats terms in the following way:
        TERM            EFFECT
        :-(T)           Call T, and proceed regardless of its success/
                        failure.
        ?-(T)           As :-(T).
        L-->R           Translate into a Prolog clause and assert it
                        (see below for details of asserting).
        Any other       Assert it unchanged.
 
The way sdo_reconsult decides whether to retract existing clauses before
asserting a new one is as follows. Just before asserting a clause C, it
has a note of the functor and arity of the head of the previous clause
in the file. If these are the same as those of C, sdo_reconsult asserts
C and does not change the database in any other way. If either or both
of them are different (or if C was the _first_ clause in the file),
sdo_reconsult first retracts all clauses with the same head arity and
functor as C, and then asserts C. This happens regardless of whether
C came from an SDO rule or not.
 
This achieves the usual effect of 'reconsult'. If the file contains a
sequence of clauses
    C1
    C1
    C1
    C2
    C1  <-
    C1
where all C1s have the same head functor and arity, which is different
from that of C2, then on encountering the fourth C1, the first three
will be retracted.
 
 
PUBLIC sdo_reconsult:
---------------------
 
As sdo_reconsult/1, but reads from the current input stream. Needed for
compatibility with lib_scan in LIB.PL.
 
 
PUBLIC sdo_rewrite( File1+:atom, File2+:atom ):
-----------------------------------------------
 
The arguments name an input and output file. sdo_rewrite reads terms
from the input file and rewrites them onto the output file, then closes
both files and leaves the CIS and COS as they were. Action is undefined
if the files can't be opened, written, etc.
 
It treats terms in the following way:
        TERM            EFFECT
        :-(T)           Write :-(T), then call it.
        ?-(T)           Write ?-(T), then call it.
        L-->R           Translate into Prolog clause and write that.
        Any other       Write it unchanged.
The original variable names are lost during rewriting, and replaced
consistently by names of the form _1, _2, etc. Directives (:-(C) and
?-(C)) are called because they may define operators used later on in the
file.
 
 
Terms in SDO rules:
-------------------
 
Rules can contain the following terms:
 
1)  A list
    Each element is output as a token.
 
2)  { Goal }
    Treated as for DCG rules: the Goal is called.
 
3)  !
    Cuts execution at this point. Since token output is guaranteed to
    succeed (if it doesn't, the SDO system calls 'bug'), it's pointless
    to put a cut after a token. It will usually be used after a {Goal},
    or at the start of a rule to cut off alternatives.
 
4)  (A,B)
    Obeys A and then B.
 
5)  (A;B)
    If A fails, obeys B. As with cut, token output can't fail, so
    the alternative will only be selected if a {Goal} fails.
 
6)  (A->B;C)
    Here, A is treated as a goal. This will call B if A succeeds, C
    otherwise.
 
7)  nl
    Emits a newline and spaces to the current left margin.
 
8)  sp(N)
    Emits N spaces.
 
    sp is an abbreviation for sp(1).
 
9)  +(N)
    Add N to the left margin.
 
10) -(N)
    As +(N), but subtracts N.
 
11) get_margin(N)
    Unifies N with the current left margin.
 
12) set_margin(N)
    Sets the left margin to N. Takes effect at the next newline.
 
13) get_position(N)
    Unifies N with the current character position.
 
14) set_position(N)
    Spaces up to position N on the current line.
 
 
Now turn to the specification part of SDO_OUTPUT.
*/
 
 
/*
IMPLEMENTATION
--------------
 
 
SDO rules
---------
 
The SDO-to-Prolog translator was derived from a DCG-to-Prolog
translator. If you're not familiar with how DCGs translate to Prolog,
you'll find it helpful to read ``Programming in Prolog'' by Clocksin and
Mellish.
 
The idea behind this implementation of SDO rules is that we need to make
up for the deficiencies of Prolog output. Most Prologs provide no way to
discover how many characters have been written to the current line of
output. This information is essential when pretty-printing, because we
need to know whether our output is going to run off the end of the
current line. Sice we can't ask for such information, we need to keep
track of it for ourselves, by knowing how much space each token takes
when written, and by keeping a running total of space used on the
current line. Of course, we also need to know the maximum length
permitted on the current line.
 
Another piece of data we need to hold onto is indentation. Usually when
pretty-printing, we want, inside certain constructs, to advance the left
margin by (say) 4 spaces. For example:
    if condition then
        statement1
    else
        statement2
    endif
In the SDO rules, we can specify relative indentations by the special
terms +(N) and -(N), and absolute indentations by margin(N). As with
position on the line, we need to pass the current left margin around
from token to token, so that we can indent properly when we take a
newline.
 
Yet another piece of information is the previous token written. This is
needed so that we can prevent tokens running in to one another. For
example, given tokens FRED and 123, we must write
    FRED 123
and not
    FRED123
- in most languages, the latter would denote a single identifier. But
it's OK to write
    FRED+
because + can't usually be part of an identifier.
 
If we were doing this in straight Prolog, we could implement it
something like
    wr( tree(A,B,C), Env0, Env ) :-
        wr( A, Env0, Env1 ),
        wr( B, Env1, Env2 ),
        wr( C, Env2, Env ).
where the Envs would be some kind of structure containing the "writing
environment":
    Env = env( CurrentPositionOnLine, CurrentLeftEnv,
               MaxLineLength, LastTokenWritten
             )
and the declarative meaning of wr would be
    wr( Term+, Env0+, Env- ):
The effect of writing Term in writing environment Env is writing
environment Env1 (with a side-effect of actually writing Term to the
COS).
 
This is straightforward but tedious, because we need to insert the two
extra Env arguments for each call of wr. But we can adapt DCGs to do
this for us, just as they insert the two list arguments needed when
parsing. So, what the SDO translator does is to translate a clause of
the form
    l( tree(A,B,C) ) --> r1(A), r2(B), r3(C).
into one of the form
    l( tree(A,B,C), Env0, Env ) :-
        r1( A, Env0, Env1 ),
        r2( B, Env1, Env2 ),
        r3( C, Env2, Env ).
inserting two extra variables at the end of each head.
 
The translator also needs to insert code to write the tokens. As in DCG
rules, we specify these as list elements - "if", "then", "else" below:
    if( if(Cond,Then,Else) ) -->
        [if], statement(Cond), [then], nl,
        +(4), statement(Then), -(4), nl,
        else, nl,
        +(4), statement(Else), -(4), nl.
 
The translator replaces these lists by calls to
    sdo_output( List, Env0, Env )
where sdo_output is a predicate whose declarative meaning is "Env is the
writing environment resulting from output of List in writing environment
Env0 (with the side effect of outputting the elements of List)".
 
 
Reconsulting with purity
------------------------
 
There isn't much else to SDOs themselves. The implementation of
sdo_reconsult may be of some interest. As said in the specification
part, sdo_reconsult decides whether to retract existing clauses before
asserting a new one; it does this by knowing the functor and arity of
the head of the previous clause. Most implementations of "reconsult"
that I've seen (and which of course has to dothe same thing) work by
asserting this information into the database. This is quite unnecessary;
it can be done purely, as shown below.
 
The predicate
    process_sdo_term( Term+, Previous+, This- )
has declaratively speaking the meaning: "Previous is a characterisation
of the previous term in the file; This is the characterisation of the
current term, Term (with side-effect that Term is translated to a Prolog
clause and asserted; previous clauses for it are retracted if Previous
and This are different)". Previous and This are structures of the form
    head( Functor, Arity )
giving the head functor and arity of the previous and current term. This
is sufficient to decide whether or not to retract.
 
 
Token output
------------
 
This is defined in SDO_OUTPUT.PL.
 
 
Linking clauses
---------------
 
See module LIB for the use of add/del_linking_clause.
*/
 
 
:- needs
    append / 3,
    islist / 1,
    while / 2.
 
 
/*  THE SDO TRANSLATOR  */
 
 
/*  sdo_expand( Lhs0+, Rhs0+, Lhs-, Rhs- ):
        Rule Lhs0-->Rhs0 translates into Prolog clause Lhs:-Rhs.
*/
sdo_expand(Lhs0,Rhs0,Lhs,Rhs) :-
      sdo_lhs(Lhs0,In,Out,Lhs), sdo_rhs(Rhs0,In,Out,Q1),
      sdo_flatconj(Q1,Rhs).
 
 
/*  sdo_lhs( Lhs0+, In, Out, Lhs1- ):
        Lhs0 is the left hand side of a rule.
        Lhs1 will become the head of a corresponding clause.
        In and Out are new variables introduced by sdo_expand.
*/
sdo_lhs( (NT,Ts), In, Out, Lhs ) :-
    nonvar(NT),
    islist( Ts ),
    !,
    sdo_tag(NT,In,In1,Lhs),
    append(Ts,Out,In1).
 
sdo_lhs(NT,In,Out,Lhs) :-
    nonvar(NT),
    !,
    sdo_tag(NT,In,Out,Lhs).
 
 
/*  sdo_rhs( Rhs0+, In, Out, Rhs1- ):
        Rhs0 is the right hand side of a rule.
        Rhs1 will become the tail of a corresponding clause.
        In and Out are new variables introduced by sdo_expand.
*/
sdo_rhs((X1,X2),In,Out,Lhs) :-
    !,
    sdo_rhs(X1,In,In1,P1),
    sdo_rhs(X2,In1,Out,P2),
    sdo_and(P1,P2,Lhs).
 
sdo_rhs((X1->X2;X3),In,Out,(X1->P2;P3)) :-
    !,
    sdo_or(X2,In,Out,P2),
    sdo_or(X3,In,Out,P3).
 
sdo_rhs((X1;X2),In,Out,(P1;P2)) :-
    !,
    sdo_or(X1,In,Out,P1),
    sdo_or(X2,In,Out,P2).
 
sdo_rhs({Lhs},Out,Out,Lhs) :- !.
 
sdo_rhs(!,Out,Out,!) :- !.
 
sdo_rhs([H|T],In,Out,Goal) :-
    !,
    sdo_terminals( [H|T], In, Out, List ),
    Goal = sdo_output( List, In, Out ).
 
sdo_rhs( [], In, Out, (Out=In) ) :- !.
 
sdo_rhs( Special, In, Out, Lhs ) :-
    sdo_special( Special, Goal ),
    !,
    sdo_tag(Goal,In,Out,Lhs).
 
sdo_rhs(X,In,Out,Lhs) :-
        sdo_tag(X,In,Out,Lhs).
 
 
/*  sdo_or( X+, In, Out, P- ):
        X is part of a disjunction occuring inside the RHS of a rule.
        Expand into the corresponding part of a Prolog clause tail.
*/
sdo_or(X,In,Out,Lhs) :-
    sdo_rhs(X,Ina,Out,Pa),
    (
        var(Ina), Ina \== Out
    ->
        In=Ina, Lhs=Pa
    ;
        Lhs=(In=Ina,Pa)
    ).
 
 
sdo_terminals( [], In, Out, [] ) :- !.
 
sdo_terminals( [H|T], In, Out, [H1|T1] ) :-
    !,
    sdo_terminal( H, In, Out1, H1 ),
    sdo_terminals( T, Out1, Out, T1 ).
 
 
sdo_terminal( X, _, _, X ) :- !.
 
 
/*  sdo_tag( X+, In, Out, P- ):
        X is some atom or term occuring as a non-terminal in a rule.
        P will become the corresponding goal in the Prolog clause resulting,
        after the input and output variables have been added to its argument
        list.
*/
sdo_tag(X,In,Out,Lhs) :-
   X=..[F|A],
   append(A,[In,Out],AX),
   Lhs=..[F|AX].
 
 
/*  sdo_and( G1+, G2+, G3- ):
        G1 and G2 are goals.
        G3 will become their conjunction, after removing surplus 'true's.
*/
sdo_and(true,Lhs,Lhs) :- !.
sdo_and(Lhs,true,Lhs) :- !.
sdo_and(Lhs,Rhs,(Lhs,Rhs)).
 
 
/*  sdo_flatconj( C+, C1- ):
        C is a goal, or conjunction of goals. C1 will become a goal with
        the same effect, but with conjunctions as flat as possible.
 
        For example, (a,(b,c,(d,e))) becomes (a,b,c,d,e).
*/
sdo_flatconj(A,A) :-
    var(A), !.
sdo_flatconj((A,B),C) :-
    !,
    sdo_flatconj1(A,C,R),
    sdo_flatconj(B,R).
sdo_flatconj(A,A).
 
 
/*  sdo_flatconj1( C+, Result-, Ptr ):
        C is a conjunction of goals. Result will become the same
        conjunction, but with a final goal appended: this goal is the
        variable Ptr.
*/
sdo_flatconj1(A,(A,R),R) :-
    var(A),
    !.
 
sdo_flatconj1((A,B),C,R) :-
    !,
    sdo_flatconj1(A,C,R1),
    sdo_flatconj1(B,R1,R).
 
sdo_flatconj1(A,(A,R),R).
 
 
/*  sdo_special( Old+, New- ):
        Old is a special term, such as nl or +(N). New is the
        corresponding output goal, but without the two environment
        arguments. It has to be treated by sdo_tag.
*/
sdo_special( nl, sdo_newline ) :- !.
sdo_special( sp(N), sdo_spaces(N) ) :- !.
sdo_special( sp, sdo_spaces(1) ) :- !.
sdo_special( +(N), sdo_indent(N) ) :- !.
sdo_special( -(N), sdo_edent(N) ) :- !.
sdo_special( get_margin(N), sdo_get_margin(N) ) :- !.
sdo_special( set_margin(N), sdo_set_margin(N) ) :- !.
sdo_special( get_position(N), sdo_get_position(N) ) :- !.
sdo_special( set_position(N), sdo_set_position(N) ) :- !.
 
 
/*  SDO_CONSULT - TRANSLATING AND ASSERTING CLAUSES  */
 
 
sdo_reconsult( F ) :-
    seeing( CIS ),
    see( F ), seen,
    see( F ),
    sdo_reconsult,
    seen,
    see( CIS ).
 
 
sdo_reconsult :-
    sdo_reconsult_1( '$none' ).
 
 
sdo_reconsult_1( Previous ) :-
    read( Term ),
    (
        Term = end_of_file
    ->
        true
    ;
        process_sdo_term( Term, Previous, Next ),
        sdo_reconsult_1( Next )
    ).
 
 
process_sdo_term( ?-(Term), _, '$none' ) :-
    call( Term ) -> true ; true.
 
process_sdo_term( :-(Term), _, '$none' ) :-
    call( Term ) -> true ; true.
 
process_sdo_term( SDO_Rule, Previous, Next  ) :-
    SDO_Rule = (_ --> _),
    !,
    sdo_to_clause( SDO_Rule, Prolog ),
    process_sdo_term( Prolog, Previous, Next ).
 
process_sdo_term( (Head:-Tail), Previous, head(Functor,Arity) ) :-
    !,
    functor( Head, Functor, Arity ),
    (
        Previous \= head(Functor,Arity)
    ->
        abolish( Functor, Arity )
    ;
        true
    ),
    assert( (Head:-Tail) ).
 
process_sdo_term( Head, Previous, Next ) :-
    process_sdo_term( (Head:-true), Previous, Next ).
 
 
sdo_to_clause( (A-->B), (A0:-B0) ) :-
    !,
    sdo_expand( A, B, A0, B0 ).
 
sdo_to_clause( T, T ).
 
 
/*  SDO_REWRITE - REWRITING RULES AS CLAUSES  */
 
 
sdo_rewrite( Inf, Outf ) :-
    seeing( CIS ),
    see( Inf ), seen, see( Inf ),
    telling( COS ),
    tell( Outf ),
    write( '/*  ' ), write(Outf), write( '  */' ), nl, nl, nl,
    while(
            (read(Term), Term\=end_of_file)
         ,
            rewrite_term( Term )
         ),
    seen,
    see( CIS ),
    told,
    tell( COS ).
 
 
rewrite_term( ?-(C) ) :-
    !,
    write_out(?-(C)),
    ( call( C ) -> true ; true ).
    /*  Write C before calling it, in case the call changes C by binding
        its variables.
    */
 
rewrite_term( :-(C) ) :-
    !,
    write_out(:-(C)),
    ( call( C ) -> true ; true ).
 
rewrite_term( (Lhs-->Rhs) ) :-
    !,
    sdo_to_clause( (Lhs-->Rhs), Clause ),
    write_out( Clause ).
 
rewrite_term( Other ) :-
    write_out( Other ).
 
 
write_out( (H:-T) ) :-
    !,
    writeq( H ), write( ' :-' ), nl,
    write_out( 4, T ),
    write( '.' ), nl, nl.
 
write_out( Other ) :-
    writeq( Other ), write('.'), nl, nl.
 
 
write_out( N, (A,B) ) :-
    !,
    write_out( N, A ), write(','),
    nl,
    write_out( N, B ).   
 
write_out( N, A ) :-
    tab( N ),
    writeq( A ).
 
 
:- endmodule.
