1:- module(scasp_listing,
    2          [ scasp_portray_program/1,   % :Options
    3            scasp_code_section_title/3 % +Section, -Default, -Title
    4          ]).    5:- use_module(human).    6:- use_module(compile).    7:- use_module(output).    8:- use_module(modules).    9:- use_module(html).   10
   11:- autoload(library(listing), [portray_clause/1]).   12:- autoload(library(ansi_term), [ansi_format/3]).   13:- autoload(library(apply), [maplist/2, maplist/3]).   14:- autoload(library(lists), [delete/3, append/3]).   15:- autoload(library(option), [option/2, merge_options/3, option/3]).   16:- autoload(library(prolog_code), [comma_list/2]).   17:- autoload(library(terms), [same_functor/2]).   18
   19:- meta_predicate
   20    scasp_portray_program(:).   21
   22:- create_prolog_flag(scasp_list_raw, false, []).   23
   24
   25%!  scasp_portray_program(:Options)
   26%
   27%   Output pretty print of  the  program   +  dual  rules  + nmr-checks.
   28%   Options:
   29%
   30%     - human(Boolean)
   31%       If `true`, write in _human_ format.
   32%     - query(Boolean)
   33%       Print the query (default `true`)
   34%     - user(Boolean)
   35%       Print the user program (default `true`)
   36%     - duals(Boolean)
   37%       Print the duals (default `false`)
   38%     - constraints(Boolean)
   39%       Print the global constraints (default `false`)
   40%     - dcc(Boolean)
   41%       Print the DCC rules (default `false`)
   42%     - write_program(+Detail)
   43%       Set defaults for the above to handle the ``--code`` commandline
   44%       option.
   45%     - source_module(+Module)
   46%       Module used for unqualifying terms, Note that scasp_show/2
   47%       prepares a temporary module that is our context module. We want
   48%       the original module to report to.
   49%     - code_file(+Name)
   50%       Dump code to file Name instead of current output
   51
   52:- det(scasp_portray_program/1).   53scasp_portray_program(M:Options) :-
   54    (   option(write_program(Detail), Options)
   55    ->  program_details(Detail, DetailOptions),
   56        merge_options(Options, DetailOptions, WriteOptons)
   57    ;   WriteOptons = Options
   58    ),
   59    (   option(code_file(File), Options)
   60    ->  setup_call_cleanup(
   61            open(File, write, Out),
   62            with_output_to(Out,
   63                           scasp_portray_program(M, WriteOptons)),
   64            close(Out))
   65    ;   scasp_portray_program(M, WriteOptons)
   66    ).
   67
   68:- det(program_details/2).   69program_details(short, [query(true), user(true)]).
   70program_details(mid,   [query(true), user(true), duals(true)]).
   71program_details(long,  [query(true), user(true), duals(true),
   72                        constraints(true), dcc(true)]).
   73
   74scasp_portray_program(M, Options) :-
   75    catch(scasp_query(M:Query, Bindings, Options),
   76          error(existence_error(scasp_query, _),_),
   77          Query = []),
   78    MOptions = [module(M)|Options],
   79    VOptions = [variable_names(Bindings)|MOptions],
   80    findall(rule(Head,Body), M:pr_rule(Head, Body, _Origin), Rules),
   81    filter(Rules, UserRules0, DualRules1, NMRChecks0),
   82    remove_nmr_checks(NMRChecks0, UserRules0, NMRChecks1, UserRules1),
   83    findall(rule(DccH,DccB), M:pr_dcc_predicate(DccH,DccB),DCCs1),
   84    maplist(rules_to_prolog(Options),
   85            [ user-UserRules1, duals-DualRules1,
   86              constraints-NMRChecks1, dcc-DCCs1 ],
   87            [ UserRules, DualRules, NMRChecks, DCCs ]),
   88    (   option(html(true), Options)
   89    ->  html_program(#{ query:Query,
   90                        user:UserRules,
   91                        duals:DualRules,
   92                        constraints:NMRChecks,
   93                        dcc:DCCs,
   94                        options:MOptions,
   95                        variable_names:Bindings
   96                      })
   97    ;   print_program(query,       Query,       Printed, VOptions),
   98        print_program(user,        UserRules,   Printed, MOptions),
   99        print_program(duals,       DualRules,   Printed, MOptions),
  100        print_program(constraints, NMRChecks,   Printed, MOptions),
  101        print_program(dcc,	   DCCs,        Printed, MOptions)
  102    ).
  103
  104%!  filter(+Rules, -UserRules, -DualRules, -NMRChecks) is det.
  105
  106filter([],[],[],[]).
  107filter([R|Rs], Us, Ds, [R|Ns]) :-
  108    R = rule(not(Head),_),
  109    chk_pred(Head),
  110    !,
  111    filter(Rs,Us,Ds,Ns).
  112filter([R|Rs], Us, Ds, [R|Ns]) :-
  113    R = rule(o_nmr_check,_), !,
  114    filter(Rs,Us,Ds,Ns).
  115filter([R|Rs], Us, Ds, Ns) :-
  116    R = rule(global_constraint,_), !,
  117    filter(Rs,Us,Ds,Ns).
  118filter([R|Rs], Us, [R|Ds], Ns) :-
  119    R = rule(not(_),_), !,
  120    filter(Rs,Us,Ds,Ns).
  121filter([R|Rs], [R|Us], Ds, Ns) :-
  122    filter(Rs,Us,Ds,Ns).
  123
  124chk_pred(Pred) :-
  125    functor(Pred, Name, _),
  126    (   sub_atom(Name, 0, _, _, o_chk)
  127    ;   sub_atom(Name, 0, _, _, o__chk)
  128    ),
  129    !.
  130
  131%!  rules_to_prolog(+Options, +SecRulePairs, -Predicates)
  132%
  133%   Translate the internal representation  into   a  list of Predicates,
  134%   each consisting of a list of clauses.
  135
  136:- det(rules_to_prolog/3).  137rules_to_prolog(Options, Section-Rules, Predicates) :-
  138    order_rules(Section, Rules, Rules1),
  139    split_predicates(Rules1, PredRules),
  140    maplist(predicate_clauses(Options), PredRules, Predicates).
  141
  142predicate_clauses(Options, Rules, Clauses) :-
  143    option(module(DefM), Options, user),
  144    option(source_module(M), Options, DefM),
  145    maplist(prolog_rule(M), Rules, Clauses).
  146
  147%!  print_program(+Section, +Rules, ?Printed, +Options)
  148
  149:- det(print_program/4).  150print_program(_, [], _, _) :-
  151    !.
  152print_program(Section, Content, Printed, Options) :-
  153    scasp_code_section_title(Section, Default, Title),
  154    Opt =.. [Section,true],
  155    option(Opt, Options, Default),
  156    !,
  157    sep_line(Printed),
  158    ansi_format(comment, "% ~w\n", [Title]),
  159    (   Section == query
  160    ->  print_query(Content, Options)
  161    ;   maplist(print_predicate(Options, Printed), Content)
  162    ).
  163print_program(_, _, _, _).
  164
  165%!  scasp_code_section_title(+Section, -Default, -Title)
  166
  167scasp_code_section_title(query,       true,  'Query').
  168scasp_code_section_title(user,        true,  'User Predicates').
  169scasp_code_section_title(duals,       false, 'Dual Rules').
  170scasp_code_section_title(constraints, false, 'Integrity Constraints').
  171scasp_code_section_title(dcc,         false, 'Dynamic consistency checks').
  172
  173order_rules(duals, DualRules, R_DualRules) :-
  174    !,
  175    dual_reverse(DualRules,[_|R_DualRules]).
  176order_rules(constraints, NMRRules, R_NMRRules) :-
  177    !,
  178    nmr_reverse(NMRRules, R_NMRRules).
  179order_rules(_, Rules, Rules).
  180
  181print_predicate(Options, Printed, Clauses) :-
  182    (   option(human(true), Options)
  183    ->  human_predicate(Clauses, Options)
  184    ;   sep_line(Printed),
  185        maplist(portray_clause, Clauses)
  186    ).
  187
  188sep_line(true) =>
  189    nl.
  190sep_line(Printed) =>
  191    Printed = true.
  192
  193prolog_rule(M, rule(H, []), Rule) =>
  194    unqualify_model_term(M, H, Rule).
  195prolog_rule(M, rule(H, B), Rule) =>
  196    unqualify_model_term(M, H, Head),
  197    maplist(unqualify_model_term(M), B, B1),
  198    comma_list(Body, B1),
  199    Rule = (Head :- Body).
  200
  201prolog_query([not(o_false)], _) =>
  202    fail.
  203prolog_query(List, Query), is_list(List) =>
  204    delete(List, o_nmr_check, List1),
  205    delete(List1, true, List2),
  206    (   List2 == []
  207    ->  Query = true
  208    ;   comma_list(Query, List2)
  209    ).
  210
  211print_query(Query, Options) :-
  212    option(human(true), Options),
  213    !,
  214    option(variable_names(Bindings), Options, []),
  215    ovar_set_bindings(Bindings),
  216    human_query(Query, Options).
  217print_query(Query, _Options) :-
  218    prolog_query(Query, Prolog),
  219    portray_clause(Prolog).
  220
  221split_predicates([], []).
  222split_predicates([H|T0], [[H|P]|T]) :-
  223    rules_same_pred(T0, H, P, T1),
  224    split_predicates(T1, T).
  225
  226rules_same_pred([H|T0], P, [H|T], R) :-
  227    rule_eq(H, P),
  228    !,
  229    rules_same_pred(T0, P, T, R).
  230rules_same_pred(L, _, [], L).
  231
  232
  233%!  rule_eq(+Rule1, +Rule2) is semidet.
  234%
  235%   True when Rule1 and Rule2 belong to  the same predicate. Used to add
  236%   a blank line between two rule sets.
  237
  238rule_eq(rule(H,_),rule(H1,_)) :-
  239    \+ H \= H1,
  240    !.
  241rule_eq(rule(not(H),_),rule(not(H1),_)) :- !, rule_eq_(H,H1).
  242rule_eq(rule(-H,_),rule(-H1,_)) :- !, rule_eq_(H,H1).
  243rule_eq(rule(H,_),rule(H1,_)) :- !, rule_eq_(H,H1).
  244
  245rule_eq_(H, H1) :-
  246    same_functor(H, H1).
  247
  248%!  dual_reverse(A, B) is det.
  249%
  250%   Auxiliary predicate to sort the DUAL rules
  251
  252:- det(dual_reverse/2).  253dual_reverse(L,[_|L]) :-
  254    current_prolog_flag(scasp_list_raw, true),
  255    !.
  256dual_reverse(L,R):-
  257    dual_reverse_(L,[],R).
  258
  259dual_reverse_([], Ac, Ac).
  260dual_reverse_([A|As], Ac0, Ac) :-
  261    dual_pred(A, _), !,
  262    dual_eq([A|As], [], Eq, Rest),
  263    append(Eq, Ac0, Ac1),
  264    dual_reverse_(Rest, Ac1, Ac).
  265dual_reverse_([A|Rs], Ac0, Ac1) :-
  266    dual_reverse_(Rs, [A|Ac0], Ac1).
  267
  268dual_pred(rule(not(-(o_, A)), _), L) :-
  269    functor(A, _, L).
  270dual_pred(rule(not(A), _), L) :-
  271    functor(A, Name, L),
  272    atom_chars(Name, ['o', '_'|_]).
  273
  274dual_eq([A,B|As], Eq0, Eq, Rest) :-
  275    dual_pred(A, La),
  276    dual_pred(B, Lb), !,
  277    (   La =:= Lb
  278    ->  append(Eq0,[A],Eq1),
  279        dual_eq([B|As], Eq1, Eq, Rest)
  280    ;   La > Lb                         % B is forall del paquete Eq0 se pone primero
  281    ->  dual_eq(As, [], Eq1, Rest),
  282        append([B|Eq0], [A], Eqm),
  283        append(Eqm, Eq1, Eq)
  284    ;                                   % Hay que hace un paquete para el proximo forall
  285        forall_eq([B|As], Forall, [F|RestForall]),
  286        append(Eq0,[A],Eq1),
  287        append(Eq1, [F|Forall], Eq2),
  288        dual_eq(RestForall, [], Eq3, Rest),
  289        append(Eq2,Eq3,Eq)
  290    ).
  291dual_eq([A|As], Eq0, Eq, As) :-
  292    append(Eq0,[A],Eq),
  293    dual_pred(A, _), !.
  294dual_eq(As, Eq, Eq, As).
  295
  296forall_eq([A,B|As],[A|Eq],Rest) :-
  297    dual_pred(A,L),
  298    dual_pred(B,L),!,
  299    forall_eq([B|As],Eq,Rest).
  300forall_eq([B|As],[B],As).
  301
  302
  303%!  remove_nmr_checks(+NMRChecks0, +UserRules0, -NMRChecks, -UserRules)
  304
  305remove_nmr_checks([rule(o_nmr_check,[])], UserRules0, NMRChecks, UserRules) =>
  306    NMRChecks = [],
  307    delete(UserRules0, rule(global_constraints,[o_nmr_check]), UserRules).
  308remove_nmr_checks(NMRChecks0, UserRules0, NMRChecks, UserRules) =>
  309    NMRChecks = NMRChecks0,
  310    UserRules = UserRules0.
  311
  312
  313%!  nmr_reverse(+NMRChecks, -RevNNMRChecks)
  314%
  315%   Auxiliary predicate to sort the NMR checks
  316
  317:- det(nmr_reverse/2).  318
  319nmr_reverse([], []) :-
  320    !.
  321nmr_reverse(L,L) :-
  322    current_prolog_flag(scasp_list_raw, true),
  323    !.
  324nmr_reverse(L,[A|Rs]) :-
  325    nmr_check(A),
  326    once(append(Chks,[A],L)),
  327    nmr_reverse_(Chks,[],Rs).
  328
  329nmr_reverse_([],[],[]).
  330nmr_reverse_([A|As],Ac0,Ac) :-
  331    nmr_chk(A), !,
  332    nmr_eq([A|As],Eq,Rest),
  333    append(Eq,Ac0,Ac1),
  334    nmr_reverse_(Rest,Ac1,Ac).
  335nmr_reverse_([A|Rs],Ac0,Ac1) :-
  336    nmr_reverse_(Rs,[],AcRs),
  337    append([A|Ac0],AcRs,Ac1).
  338
  339nmr_check(rule(o_nmr_check,_)).
  340
  341nmr_chk(rule(not(A),_)) :-
  342    functor(A, Name, _),
  343    \+ atom_concat(o_chk,_,Name).
  344%   Using chk_pred(A) causes this to fail.
  345
  346nmr_eq([A,B|As],[A|Eq],Rest) :-
  347    \+ A \= B, !,
  348    nmr_eq([B|As],Eq,Rest).
  349nmr_eq([A|As],[A],As)