34
   35:- module('$dwim',
   36        [ dwim_predicate/2,
   37          '$dwim_correct_goal'/3,
   38          '$find_predicate'/2,
   39          '$similar_module'/2
   40        ]).   41
   42:- meta_predicate
   43    dwim_predicate(:, -),
   44    '$dwim_correct_goal'(:, +, -),
   45    '$similar_module'(:, -),
   46    '$find_predicate'(:, -).
   57'$dwim_correct_goal'(M:Goal, Bindings, Corrected) :-
   58    correct_goal(Goal, M, Bindings, Corrected).
   59
   60correct_goal(Goal, M, _, M:Goal) :-
   61    var(Goal),
   62    !.
   63correct_goal(Module:Goal, _, _, Module:Goal) :-
   64    (   var(Module)
   65    ;   var(Goal)
   66    ),
   67    !.
   68correct_goal(Vars^Goal0, M, Bindings, Vars^Goal) :-      69    !,
   70    correct_goal(Goal0, M, Bindings, Goal).
   71correct_goal(Module:Goal0, _, Bindings, Module:Goal) :-
   72    current_predicate(_, Module:Goal0),
   73    !,
   74    correct_meta_arguments(Goal0, Module, Bindings, Goal).
   75correct_goal(Goal0, M, Bindings, M:Goal) :-        76    current_predicate(_, M:Goal0),
   77    !,
   78    correct_meta_arguments(Goal0, M, Bindings, Goal).
   79correct_goal(Goal0, M, Bindings, Goal) :-          80    dwim_predicate_list(M:Goal0, DWIMs0),
   81    !,
   82    principal_predicates(DWIMs0, M, DWIMs),
   83    correct_literal(M:Goal0, Bindings, DWIMs, Goal1),
   84    correct_meta_arguments(Goal1, M, Bindings, Goal).
   85correct_goal(Goal, Module, _, NewGoal) :-          86    \+ current_prolog_flag(Module:unknown, fail),
   87    callable(Goal),
   88    !,
   89    callable_name_arity(Goal, Name, Arity),
   90    '$undefined_procedure'(Module, Name, Arity, Action),
   91    (   Action == error
   92    ->  existence_error(Module:Name/Arity),
   93        NewGoal = fail
   94    ;   Action == retry
   95    ->  NewGoal = Goal
   96    ;   NewGoal = fail
   97    ).
   98correct_goal(Goal, M, _, M:Goal).
   99
  100callable_name_arity(Goal, Name, Arity) :-
  101    compound(Goal),
  102    !,
  103    compound_name_arity(Goal, Name, Arity).
  104callable_name_arity(Goal, Goal, 0) :-
  105    atom(Goal).
  106
  107existence_error(PredSpec) :-
  108    strip_module(PredSpec, M, _),
  109    current_prolog_flag(M:unknown, Unknown),
  110    dwim_existence_error(Unknown, PredSpec).
  111
  112dwim_existence_error(fail, _) :- !.
  113dwim_existence_error(Unknown, PredSpec) :-
  114    '$current_typein_module'(TypeIn),
  115    unqualify_if_context(TypeIn, PredSpec, Spec),
  116    (   no_context(Spec)
  117    ->  true
  118    ;   Context = context(toplevel, 'DWIM could not correct goal')
  119    ),
  120    Error = error(existence_error(procedure, Spec), Context),
  121    (   Unknown == error
  122    ->  throw(Error)
  123    ;   print_message(warning, Error)
  124    ).
  131no_context((^)/2).
  132no_context((:-)/2).
  133no_context((:-)/1).
  134no_context((?-)/1).
  144correct_meta_arguments(call(Goal), _, _, call(Goal)) :- !.
  145correct_meta_arguments(Goal0, M, Bindings, Goal) :-
  146    predicate_property(M:Goal0, meta_predicate(MHead)),
  147    !,
  148    functor(Goal0, Name, Arity),
  149    functor(Goal, Name, Arity),
  150    correct_margs(0, Arity, MHead, Goal0, Goal, M, Bindings).
  151correct_meta_arguments(Goal, _, _, Goal).
  152
  153correct_margs(Arity, Arity, _, _, _, _, _) :- !.
  154correct_margs(A, Arity, MHead, GoalIn, GoalOut, M, Bindings) :-
  155    I is A+1,
  156    arg(I, GoalIn, Ain),
  157    arg(I, GoalOut, AOut),
  158    (   arg(I, MHead, 0)
  159    ->  correct_goal(Ain, M, Bindings, AOut0),
  160        unqualify_if_context(M, AOut0, AOut)
  161    ;   AOut = Ain
  162    ),
  163    correct_margs(I, Arity, MHead, GoalIn, GoalOut, M, Bindings).
  171correct_literal(Goal, Bindings, [Dwim], DwimGoal) :-
  172    strip_module(Goal, CM, G1),
  173    strip_module(Dwim, DM, G2),
  174    callable_name_arity(G1, _, Arity),
  175    callable_name_arity(G2, Name, Arity),     176    !,
  177    change_functor_name(G1, Name, G2),
  178    (   (   current_predicate(CM:Name/Arity)
  179        ->  ConfirmGoal = G2,
  180            DwimGoal = CM:G2
  181        ;   '$prefix_module'(DM, CM, G2, ConfirmGoal),
  182            DwimGoal = ConfirmGoal
  183        ),
  184        goal_name(ConfirmGoal, Bindings, String),
  185        '$confirm'(dwim_correct(String))
  186    ->  true
  187    ;   DwimGoal = Goal
  188    ).
  189correct_literal(Goal, Bindings, Dwims, NewGoal) :-
  190    strip_module(Goal, _, G1),
  191    callable_name_arity(G1, _, Arity),
  192    include_arity(Dwims, Arity, [Dwim]),
  193    !,
  194    correct_literal(Goal, Bindings, [Dwim], NewGoal).
  195correct_literal(Goal, _, Dwims, _) :-
  196    print_message(error, dwim_undefined(Goal, Dwims)),
  197    fail.
  198
  199change_functor_name(Term1, Name2, Term2) :-
  200    compound(Term1),
  201    !,
  202    compound_name_arguments(Term1, _, Arguments),
  203    compound_name_arguments(Term2, Name2, Arguments).
  204change_functor_name(Term1, Name2, Name2) :-
  205    atom(Term1).
  206
  207include_arity([], _, []).
  208include_arity([H|T0], Arity, [H|T]) :-
  209    strip_module(H, _, G),
  210    functor(G, _, Arity),
  211    !,
  212    include_arity(T0, Arity, T).
  213include_arity([_|T0], Arity, T) :-
  214    include_arity(T0, Arity, T).
  215
  216
  220
  221goal_name(Goal, Bindings, String) :-
  222    State = s(_),
  223    (   bind_vars(Bindings),
  224        numbervars(Goal, 0, _, [singletons(true), attvar(skip)]),
  225        format(string(S), '~q', [Goal]),
  226        nb_setarg(1, State, S),
  227        fail
  228    ;   arg(1, State, String)
  229    ).
  230
  231bind_vars([]).
  232bind_vars([Name=Var|T]) :-
  233    Var = '$VAR'(Name),               234    !,
  235    bind_vars(T).
  236bind_vars([_|T]) :-
  237    bind_vars(T).
  252'$find_predicate'(M:S, List) :-
  253    name_arity(S, Name, Arity),
  254    '$current_typein_module'(TypeIn),
  255    (   M == TypeIn                   256    ->  true
  257    ;   Module = M
  258    ),
  259    find_predicate(Module, Name, Arity, L0),
  260    !,
  261    sort(L0, L1),
  262    principal_pis(L1, Module, List).
  263'$find_predicate'(_:S, List) :-
  264    name_arity(S, Name, Arity),
  265    findall(Name/Arity,
  266            '$in_library'(Name, Arity, _Path), List),
  267    List \== [],
  268    !.
  269'$find_predicate'(Spec, _) :-
  270    existence_error(Spec),
  271    fail.
  272
  273find_predicate(Module, Name, Arity, VList) :-
  274    findall(Head, find_predicate_(Module, Name, Arity, Head), VList),
  275    VList \== [],
  276    !.
  277find_predicate(Module, Name, Arity, Pack) :-
  278    findall(PI, find_sim_pred(Module, Name, Arity, PI), List),
  279    pack(List, Module, Arity, Packs),
  280    '$member'(Dwim-Pack, Packs),
  281    '$confirm'(dwim_correct(Dwim)),
  282    !.
  283
  284unqualify_if_context(_, X, X) :-
  285    var(X),
  286    !.
  287unqualify_if_context(C, C2:X, X) :-
  288    C == C2,
  289    !.
  290unqualify_if_context(_, X, X) :- !.
  297pack([], _, _, []) :- !.
  298pack([M:T|Rest], Module, Arity, [Name-[M:T|R]|Packs]) :-
  299    pack_name(M:T, Module, Arity, Name),
  300    pack_(Module, Arity, Name, Rest, R, NewRest),
  301    pack(NewRest, Module, Arity, Packs).
  302
  303pack_(Module, Arity, Name, List, [H|R], Rest) :-
  304    '$select'(M:PI, List, R0),
  305    pack_name(M:PI, Module, Arity, Name),
  306    !,
  307    '$prefix_module'(M, C, PI, H),
  308    pack_(Module, Arity, Name, C, R0, R, Rest).
  309pack_(_, _, _, _, Rest, [], Rest).
  310
  311pack_name(_:Name/_, M, A,   Name) :-
  312    var(M), var(A),
  313    !.
  314pack_name(M:Name/_, _, A, M:Name) :-
  315    var(A),
  316    !.
  317pack_name(_:PI, M, _, PI)   :-
  318    var(M),
  319    !.
  320pack_name(QPI, _, _, QPI).
  321
  322
  323find_predicate_(Module, Name, Arity, Module:Name/Arity) :-
  324    current_module(Module),
  325    current_predicate(Name, Module:Term),
  326    functor(Term, Name, Arity).
  327
  328find_sim_pred(M, Name, Arity, Module:DName/DArity) :-
  329    sim_module(M, Module),
  330    '$dwim_predicate'(Module:Name, Term),
  331    functor(Term, DName, DArity),
  332    sim_arity(Arity, DArity).
  333
  334sim_module(M, Module) :-
  335    var(M),
  336    !,
  337    current_module(Module).
  338sim_module(M, M) :-
  339    current_module(M),
  340    !.
  341sim_module(M, Module) :-
  342    current_module(Module),
  343    dwim_match(M, Module).
  344
  345sim_arity(A, _) :- var(A), !.
  346sim_arity(A, D) :- abs(A-D) < 2.
  353name_arity(Atom, Atom, _) :-
  354    atom(Atom),
  355    !.
  356name_arity(Name/Arity, Name, Arity) :- !.
  357name_arity(Name//DCGArity, Name, Arity) :-
  358    (   var(DCGArity)
  359    ->  true
  360    ;   Arity is DCGArity+2
  361    ).
  362name_arity(Term, Name, Arity) :-
  363    callable(Term),
  364    !,
  365    functor(Term, Name, Arity).
  366name_arity(Spec, _, _) :-
  367    throw(error(type_error(predicate_indicator, Spec), _)).
  368
  369
  370principal_pis(PIS, M, Principals) :-
  371    map_pi_heads(PIS, Heads),
  372    principal_predicates(Heads, M, Heads2),
  373    map_pi_heads(Principals, Heads2).
  374
  375map_pi_heads([], []) :- !.
  376map_pi_heads([PI0|T0], [H0|T]) :-
  377    map_pi_head(PI0, H0),
  378    map_pi_heads(T0, T).
  379
  380map_pi_head(M:PI, M:Head) :-
  381    nonvar(M),
  382    !,
  383    map_pi_head(PI, Head).
  384map_pi_head(Name/Arity, Term) :-
  385    functor(Term, Name, Arity).
  392principal_predicates(Heads, M, Principals) :-
  393    find_definitions(Heads, M, Heads2),
  394    strip_subsumed_heads(Heads2, Principals).
  395
  396find_definitions([], _, []).
  397find_definitions([H0|T0], M, [H|T]) :-
  398    find_definition(H0, M, H),
  399    find_definitions(T0, M, T).
  400
  401find_definition(Head, _, Def) :-
  402    strip_module(Head, _, Plain),
  403    callable(Plain),
  404    (   predicate_property(Head, imported_from(Module))
  405    ->  (   predicate_property(system:Plain, imported_from(Module)),
  406            sub_atom(Module, 0, _, _, $)
  407        ->  Def = system:Plain
  408        ;   Def = Module:Plain
  409        )
  410    ;   Def = Head
  411    ).
  419strip_subsumed_heads([], []).
  420strip_subsumed_heads([H|T0], T) :-
  421    '$member'(H2, T0),
  422    subsumes_term(H2, H),
  423    \+ subsumes_term(H, H2),
  424    !,
  425    strip_subsumed_heads(T0, T).
  426strip_subsumed_heads([H|T0], [H|T]) :-
  427    strip_subsumed(T0, H, T1),
  428    strip_subsumed_heads(T1, T).
  429
  430strip_subsumed([], _, []).
  431strip_subsumed([H|T0], G, T) :-
  432    subsumes_term(G, H),
  433    !,
  434    strip_subsumed(T0, G, T).
  435strip_subsumed([H|T0], G, [H|T]) :-
  436    strip_subsumed(T0, G, T).
  448dwim_predicate(Head, DWIM) :-
  449    dwim_predicate_list(Head, DWIMs),
  450    '$member'(DWIM, DWIMs).
  451
  452dwim_predicate_list(Head, [Head]) :-
  453    current_predicate(_, Head),
  454    !.
  455dwim_predicate_list(M:Head, DWIMs) :-
  456    setof(DWIM, dwim_pred(M:Head, DWIM), DWIMs),
  457    !.
  458dwim_predicate_list(Head, DWIMs) :-
  459    setof(DWIM, '$similar_module'(Head, DWIM), DWIMs),
  460    !.
  461dwim_predicate_list(_:Goal, DWIMs) :-
  462    setof(Module:Goal,
  463          current_predicate(_, Module:Goal),
  464          DWIMs).
  471dwim_pred(Head, M:Dwim) :-
  472    strip_module(Head, Module, H),
  473    default_module(Module, M),
  474    '$dwim_predicate'(M:H, Dwim).
  481'$similar_module'(Module:Goal, DwimModule:Goal) :-
  482    current_module(DwimModule),
  483    dwim_match(Module, DwimModule),
  484    current_predicate(_, DwimModule:Goal)