1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  1985-2009, University of Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   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'(:, -).   47
   48%!  '$dwim_correct_goal'(:Goal, +Bindings, -Corrected)
   49%
   50%   Correct a goal (normally typed by the   user)  in the `Do What I
   51%   Mean' sense. Ask the user to confirm  if a unique correction can
   52%   be found.
   53%
   54%   @error  existence_error(procedure, PI) if the goal cannot be
   55%           corrected.
   56
   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) :-   % setof/bagof
   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) :-     % is defined
   76    current_predicate(_, M:Goal0),
   77    !,
   78    correct_meta_arguments(Goal0, M, Bindings, Goal).
   79correct_goal(Goal0, M, Bindings, Goal) :-       % correct the 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) :-       % try to autoload
   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    ).
  125
  126%!  no_context(+PI) is semidet.
  127%
  128%   True if we should omit the DWIM message because messages.pl
  129%   gives an additional explanation.
  130
  131no_context((^)/2).
  132no_context((:-)/2).
  133no_context((:-)/1).
  134no_context((?-)/1).
  135
  136
  137%!  correct_meta_arguments(:Goal, +Module, +Bindings, -Final) is det.
  138%
  139%   Correct possible meta-arguments. This performs a recursive check
  140%   on meta-arguments specified as `0' using :- meta_predicate/1. As
  141%   a special exception, the arment of call/1 is not checked, so you
  142%   can use call(X) as an escape from the DWIM system.
  143
  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).
  164
  165
  166%!  correct_literal(:Goal, +Bindings, +DWIMs, -Corrected) is semidet.
  167%
  168%   Correct a single literal.  DWIMs is a list of heads that can
  169%   replace the head in Goal.
  170
  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),   % same arity: we can replace arguments
  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
  217%       goal_name(+Goal, +Bindings, -Name)
  218%
  219%       Transform Goal into a readable format by binding its variables.
  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),             % portray prints Name
  234    !,
  235    bind_vars(T).
  236bind_vars([_|T]) :-
  237    bind_vars(T).
  238
  239
  240%!  '$find_predicate'(:Spec, -PIs:list(pi)) is det.
  241%
  242%   Unify `List' with a list of  predicate indicators that match the
  243%   specification `Spec'. `Spec' is a   term Name/Arity, a ``Head'',
  244%   or just an atom. The latter refers to all predicate of that name
  245%   with arbitrary arity. `Do What I   Mean'  correction is done. If
  246%   the requested module is `user' predicates residing in any module
  247%   will be considered matching.
  248%
  249%   @error  existence_error(procedure, Spec) if no matching predicate
  250%           can be found.
  251
  252'$find_predicate'(M:S, List) :-
  253    name_arity(S, Name, Arity),
  254    '$current_typein_module'(TypeIn),
  255    (   M == TypeIn                 % I.e. unspecified default module
  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) :- !.
  291
  292%!  pack(+PIs, +Module, +Arity, +Context, -Packs)
  293%
  294%   Pack the list of heads into packets, consisting of the corrected
  295%   specification and a list of heads satisfying this specification.
  296
  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.
  347
  348%!  name_arity(+Spec, -Name, -Arity)
  349%
  350%   Obtain the name and arity of a predicate specification. Warn if
  351%   this is not a legal specification.
  352
  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).
  386
  387%!  principal_predicates(:Heads, +Context, -Principals)
  388%
  389%   Get the principal predicate list from a list of heads (e.g., the
  390%   module in which the predicate is defined).
  391
  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    ).
  412
  413%!  strip_subsumed_heads(+Heads, -GenericOnes)
  414%
  415%   Given a list of Heads, remove  subsumed heads, while maintaining
  416%   the order. The implementation is slow,   but  only used on small
  417%   sets and only for toplevel related tasks.
  418
  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).
  437
  438
  439%!  dwim_predicate(:Head, -NewHead) is nondet.
  440%
  441%   Find a head that is in a `Do What I Mean' sence the same as `Head'.
  442%   backtracking produces more such predicates.  If searches for:
  443%
  444%       * predicates with a similar name in an import module
  445%       * predicates in a similar module with the same name
  446%       * predicates in any module with the same name
  447
  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).
  465
  466%!  dwim_pred(:Head, -DWIM) is nondet.
  467%
  468%   True if DWIM is a predicate with a similar name than Head in the
  469%   module of Head or an import module thereof.
  470
  471dwim_pred(Head, M:Dwim) :-
  472    strip_module(Head, Module, H),
  473    default_module(Module, M),
  474    '$dwim_predicate'(M:H, Dwim).
  475
  476%!  '$similar_module'(:Goal, -DWIMGoal) is nondet.
  477%
  478%   True if DWIMGoal exists and is, except from a typo in the
  479%   module specification, equivalent to Goal.
  480
  481'$similar_module'(Module:Goal, DwimModule:Goal) :-
  482    current_module(DwimModule),
  483    dwim_match(Module, DwimModule),
  484    current_predicate(_, DwimModule:Goal)