/*  ATNCOMMON.PL  */



/*
Introduction.
-------------

This file defines the text representation of ATNs, and those predicates
that don't depend on the internal representation. For how ATNs are
used, see the documentation.


Exported predicates.
--------------------

This file exports these predicates:
    assert_atn( T+ )
    retractall_atn( Node+ )
    atn_reconsult( Filename+ )

'assert_atn(T)' takes the text representation of an ATN and asserts it.

'retractall_atn(Node+)' takes a node term, and retracts all nodes which
match it.

'atn_reconsult(F)' reads and asserts definitions from a file. The file can
also contain directives and Prolog clauses: see the documentation.
*/



/*
Syntax.
-------

Define the following operators to implement the syntax. These are for
PDP-11 compatible Prolog. YOU WILL NEED TO CHANGE THEM FOR DEC-10
COMPATIBLE VERSIONS.
*/


:- op( 255, xfx, :: ).
:- op( 254, xfx, to ).
:- op( 254, fx, to ).
:- op( 254, xfx, if ).



/*
Converting from text to expanded form.
--------------------------------------

See ATNC.PL for a description of expanded form. The main predicate defined
is 'expand( T+, E- ) which expands T (text form) into E (expanded form).
*/


expand( ::(A,B), atn(A,Command,Arcs) ) :-
    get_command_and_arcs( B, Command, Arcs ).


/*  get_command_and_arcs( Body+, Command-, Arcs- ):
        Expand Body into a Command and a list of arcs. These are
        the expanded representation of command and arcs as defined
        in ATNC.
*/
get_command_and_arcs( (to Arcs), true, Arcs_ ) :-
    !,
    get_arcs( Arcs, Arcs_ ).

get_command_and_arcs( to(Command,Arcs), Command, Arcs_ ) :-
    !,
    get_arcs( Arcs, Arcs_ ).

get_command_and_arcs( Command, Command, [] ).


get_arcs( if( Node, to( Cond, Rest ) ), [ Cond, Node | Rest_ ] ) :-
    !,
    get_arcs( Rest, Rest_ ).

get_arcs( if( Node, Cond ), [ Cond, Node, true, failure ] ) :- !.

get_arcs( Node, [ true, Node ] ).



/*
Loading files.
--------------

This section defines the predicate 'atn_reconsult(File)'.
*/


atn_reconsult( File ) :-
    seeing( CIS ),
    see( File ), seen,
    see( File ),
    atn_reconsult_1( '$none' ),
    seen,
    see( CIS ).


/*  atn_reconsult_1( Previous+ ):
        Previous is a representation of the previous term in the file.
        If there was none, or the term was a directive, Previous
        is '$none'.
        If the term was a clause, Previous is 'clause(F,A)' where F/A
        are the clause's head functor and arity.
        If the term was a node definition, Previous is 'atn(F,A)'
        where F/A are the node's functor and arity.

        Previous is used by 'process_term'. 'process_term' compares
        Previous against its first argument, Term. If they are not
        a node with the same functor and arity, or a clause with
        the same functor and arity, the old definitions will be
        deleted.
*/
atn_reconsult_1( Previous ) :-
    read( Term ),
    (
        Term = end_of_file
    ->
        true
    ;
        process_term( Term, Previous, Next ),
        atn_reconsult_1( Next )
    ).


process_term( ?-(Term), _, '$none' ) :-
    call( Term ) -> true ; true.

process_term( :-(Term), _, '$none' ) :-
    call( Term ) -> true ; true.

process_term( ::(Node,Body), Previous, atn(F,A) ) :-
    !,
    expand( ::(Node,Body), ATN ),
    functor( Node, F, A ),
    (
        Previous \= atn(F,A)
    ->
        functor( Template, F, A ),
        retractall_expanded_atn( Template )
        /*  Template is the same functor and arity as Node, but all its
            arguments are new variables. So retractall_expanded_atn will
            delete all nodes with that functor and arity.
        */                    
    ;
        true
    ),
    assert_expanded_atn( ATN ).

process_term( :-(Head,Tail), Previous, clause(Functor,Arity) ) :-
    !,
    functor( Head, Functor, Arity ),
    (
        Previous \= clause(Functor,Arity)
    ->
        abolish( Functor, Arity )
    ;
        true
    ),
    assert( (Head:-Tail) ).

process_term( Head, Previous, Next ) :-
    process_term( (Head:-true), Previous, Next ).


assert_atn( ::(A,B) ) :-
    expand( ::(A,B), ATN ),
    assert_expanded_atn( ATN ).


retractall_atn( ::(A,B) ) :-
    expand( ::(A,B), atn(Node,_,_) ),
    retractall_expanded_atn( Node ).