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, []).

 scasp_portray_program(:Options)

Output pretty print of the program + dual rules + nmr-checks. Options:

human(Boolean)

If true, write in human format.

query(Boolean)

Print the query (default true)

user(Boolean)

Print the user program (default true)

duals(Boolean)

Print the duals (default false)

constraints(Boolean)

Print the global constraints (default false)

dcc(Boolean)

Print the DCC rules (default false)

write_program(+Detail)

Set defaults for the above to handle the --code commandline option.

source_module(+Module)

Module used for unqualifying terms, Note that scasp_show/2 prepares a temporary module that is our context module. We want the original module to report to.

code_file(+Name)

Dump code to file Name instead of current output

   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    ).

 filter(+Rules, -UserRules, -DualRules, -NMRChecks) is det

  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    !.

 rules_to_prolog(+Options, +SecRulePairs, -Predicates)

Translate the internal representation into a list of Predicates, each consisting of a list of clauses.

  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).

 print_program(+Section, +Rules, ?Printed, +Options)

  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(_, _, _, _).

 scasp_code_section_title(+Section, -Default, -Title)

  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).

 rule_eq(+Rule1, +Rule2) is semidet

True when Rule1 and Rule2 belong to the same predicate. Used to add a blank line between two rule sets.

  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).

 dual_reverse(A, B) is det

Auxiliary predicate to sort the DUAL rules

  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).

 remove_nmr_checks(+NMRChecks0, +UserRules0, -NMRChecks, -UserRules)

  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.

 nmr_reverse(+NMRChecks, -RevNNMRChecks)

Auxiliary predicate to sort the NMR checks

  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)