/*  LINT.PL  */
 
 
:- needs
   bug / 2,
   call_without_failure / 1,
   clause_vs_head_tail_pred_arity / 5,
   output / 1,
   while / 2.
 
 
dynamic
    singleton_found / 0.
 
 
/*  lint( InputFileName+, OutputFileName+ ):
        Check each clause in InputFileName to see whether it contains
        occurrences of singleton variables; if so, give a warning
        to OutputFileName.
*/
lint( InputFileName, OutputFileName ) :-
    seeing( CIS ),
    see( InputFileName ), seen,
    see( InputFileName ),
    telling( COS ),
    tell( OutputFileName ),
    retractall( singleton_found ),
    lint,
    seen,
    see( CIS ),
    (
        singleton_found
    ->
        true
    ;
        output( 'All clauses seem OK'~ )
    ),
    told,
    tell( COS ),
    retractall( singleton_found ).
 
 
/*  lint:
        Perform the lint check on the CIS, writing to the COS.
*/
lint :-
    while(
            (read(X,V), X\==end_of_file)
         ,
            (varnamepairs_vs_var_and_name_list(V,V1), lint_one_clause(X,V1))
         ).
 
 
/*  lint_one_clause( Term+, Vars+ ):
        Term is either a directive or a clause; Vars is its variable
        name list. If a directive, obey it and succeed. If a clause,
        check for singleton variables.
*/
lint_one_clause( :-(G), _ ) :-
    call_without_failure(G).
 
lint_one_clause( ?-(G), _ ) :-
    call_without_failure(G).
 
lint_one_clause( Clause, Vars ) :-
    count_vars( Clause, Vars, Counts ),
    check_var_counts( Counts, Clause ).
 
 
/*  count_vars( Term+, VarNames+, VarCounts- ):
        VarNames is a variable name list. VarCounts will become a
        corresponding list whose elements are
            var( Var, Name, Count )
        where Count is the number of times variable Var occurs in Term.
 
        It is assumed that each variable occurs at least once.
*/
count_vars( X, Counts, Counts ) :-
    atomic(X),
    !.
 
count_vars( V, Counts0, Counts1 ) :-
    var(V),
    !,
    add_a_var( V, Counts0, Counts1 ).
 
count_vars( X, Counts0, Counts ) :-
    X =.. [ _ | Args ],
    count_vars_l( Args, Counts0, Counts ).
 
 
count_vars_l( [], Counts0, Counts0 ).
 
count_vars_l( [H|T], Counts0, Counts ) :-
    count_vars( H, Counts0, Counts1 ),
    count_vars_l( T, Counts1, Counts ).
 
 
/*  add_a_var( Var, Counts0+, Counts1- ):
        Counts1 is Counts0 but recording one extra occurrence of Var.
*/
add_a_var( V, [var(V_,Name)|T], L ) :-
    V == V_,
    !,
    add_a_var( V, [var(V_,Name,0)|T], L ).
 
add_a_var( V, [var(V_,Name,N)|T], [var(V_,Name,N_)|T] ) :-
    V == V_,
    !,
    N_ is N+1.
 
add_a_var( V, [H|T], [H|T_] ) :-
    /*  V not in H  */
    !,
    add_a_var( V, T, T_ ).
 
add_a_var( _, [], [] ).
 
 
/*  check_var_counts( Counts0+, Clause+ ):
        Give a warning for each singleton variable in Counts0.
*/
check_var_counts( Counts0, Clause ) :-
    remove_non_singletons( Counts0, Counts1 ),
    (
        Counts1 = []
    ->
        true
    ;
        warn( Counts1, Clause )
 
    ).
 
 
/*  remove_non_singletons( Counts0+, Counts1- ):
        Counts1 is Counts0 with all non-singleton variables removed,
        and with all 'var' structures replaced just by the variable
        names.
*/
remove_non_singletons( [], [] ) :- !.
 
remove_non_singletons( [var(_,Name)|T], T_ ) :-
    !,
    bug('remove_non_singletons: zero-count variable', Name ).
 
remove_non_singletons( [var(_,Name,1)|T], [Name|T_] ) :-
    !,
    remove_non_singletons( T, T_ ).
 
remove_non_singletons( [_|T], T_ ) :-
    remove_non_singletons( T, T_ ).
 
 
/*  warn( Singles+, Clause+ ):
        Singles is a list of singleton variable names. Warn about
        their occurrence in Clause.
*/
warn( Singles, Clause ) :-
    (
        singleton_found
    ->
        true
    ;
        assert(singleton_found)
    ),
    clause_vs_head_tail_pred_arity( Clause, Head, _, Pred, Arity ),
    output( Pred<>'/'<>Arity...'has singleton variables:'~ ),
    output( seplist_(Singles,' ')~~ ).
 
 
varnamepairs_vs_var_and_name_list( [], [] ) :- !.
 
varnamepairs_vs_var_and_name_list( ['_'(_)|T], T_ ) :-
    !,
    varnamepairs_vs_var_and_name_list( T, T_ ).
 
varnamepairs_vs_var_and_name_list( [VN|T], [var(Var,Name)|T_] ) :-
    functor( VN, Name, 1 ),
    arg( 1, VN, Var ),
    varnamepairs_vs_var_and_name_list( T, T_ ).
