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        \+ module_property(M, class(temporary))
  257    ->  true
  258    ;   Module = M
  259    ),
  260    find_predicate(Module, Name, Arity, L0),
  261    !,
  262    sort(L0, L1),
  263    principal_pis(L1, Module, List).
  264'$find_predicate'(_:S, List) :-
  265    name_arity(S, Name, Arity),
  266    findall(Name/Arity,
  267            '$in_library'(Name, Arity, _Path), List),
  268    List \== [],
  269    !.
  270'$find_predicate'(Spec, _) :-
  271    existence_error(Spec),
  272    fail.
  273
  274find_predicate(Module, Name, Arity, VList) :-
  275    findall(Head, find_predicate_(Module, Name, Arity, Head), VList),
  276    VList \== [],
  277    !.
  278find_predicate(Module, Name, Arity, Pack) :-
  279    findall(PI, find_sim_pred(Module, Name, Arity, PI), List),
  280    pack(List, Module, Arity, Packs),
  281    '$member'(Dwim-Pack, Packs),
  282    '$confirm'(dwim_correct(Dwim)),
  283    !.
  284
  285unqualify_if_context(_, X, X) :-
  286    var(X),
  287    !.
  288unqualify_if_context(C, C2:X, X) :-
  289    C == C2,
  290    !.
  291unqualify_if_context(_, X, X) :- !.
  292
  293%!  pack(+PIs, +Module, +Arity, +Context, -Packs)
  294%
  295%   Pack the list of heads into packets, consisting of the corrected
  296%   specification and a list of heads satisfying this specification.
  297
  298pack([], _, _, []) :- !.
  299pack([M:T|Rest], Module, Arity, [Name-[M:T|R]|Packs]) :-
  300    pack_name(M:T, Module, Arity, Name),
  301    pack_(Module, Arity, Name, Rest, R, NewRest),
  302    pack(NewRest, Module, Arity, Packs).
  303
  304pack_(Module, Arity, Name, List, [H|R], Rest) :-
  305    '$select'(M:PI, List, R0),
  306    pack_name(M:PI, Module, Arity, Name),
  307    !,
  308    '$prefix_module'(M, C, PI, H),
  309    pack_(Module, Arity, Name, C, R0, R, Rest).
  310pack_(_, _, _, _, Rest, [], Rest).
  311
  312pack_name(_:Name/_, M, A,   Name) :-
  313    var(M), var(A),
  314    !.
  315pack_name(M:Name/_, _, A, M:Name) :-
  316    var(A),
  317    !.
  318pack_name(_:PI, M, _, PI)   :-
  319    var(M),
  320    !.
  321pack_name(QPI, _, _, QPI).
  322
  323
  324find_predicate_(Module, Name, Arity, Module:Name/Arity) :-
  325    current_module(Module),
  326    current_predicate(Name, Module:Term),
  327    functor(Term, Name, Arity).
  328
  329find_sim_pred(M, Name, Arity, Module:DName/DArity) :-
  330    sim_module(M, Module),
  331    '$dwim_predicate'(Module:Name, Term),
  332    functor(Term, DName, DArity),
  333    sim_arity(Arity, DArity).
  334
  335sim_module(M, Module) :-
  336    var(M),
  337    !,
  338    current_module(Module).
  339sim_module(M, M) :-
  340    current_module(M),
  341    !.
  342sim_module(M, Module) :-
  343    current_module(Module),
  344    dwim_match(M, Module).
  345
  346sim_arity(A, _) :- var(A), !.
  347sim_arity(A, D) :- abs(A-D) < 2.
  348
  349%!  name_arity(+Spec, -Name, -Arity)
  350%
  351%   Obtain the name and arity of a predicate specification. Warn if
  352%   this is not a legal specification.
  353
  354name_arity(Atom, Atom, _) :-
  355    atom(Atom),
  356    !.
  357name_arity(Name/Arity, Name, Arity) :- !.
  358name_arity(Name//DCGArity, Name, Arity) :-
  359    (   var(DCGArity)
  360    ->  true
  361    ;   Arity is DCGArity+2
  362    ).
  363name_arity(Term, Name, Arity) :-
  364    callable(Term),
  365    !,
  366    functor(Term, Name, Arity).
  367name_arity(Spec, _, _) :-
  368    throw(error(type_error(predicate_indicator, Spec), _)).
  369
  370
  371principal_pis(PIS, M, Principals) :-
  372    map_pi_heads(PIS, Heads),
  373    principal_predicates(Heads, M, Heads2),
  374    map_pi_heads(Principals, Heads2).
  375
  376map_pi_heads([], []) :- !.
  377map_pi_heads([PI0|T0], [H0|T]) :-
  378    map_pi_head(PI0, H0),
  379    map_pi_heads(T0, T).
  380
  381map_pi_head(M:PI, M:Head) :-
  382    nonvar(M),
  383    !,
  384    map_pi_head(PI, Head).
  385map_pi_head(Name/Arity, Term) :-
  386    functor(Term, Name, Arity).
  387
  388%!  principal_predicates(:Heads, +Context, -Principals)
  389%
  390%   Get the principal predicate list from a list of heads (e.g., the
  391%   module in which the predicate is defined).
  392
  393principal_predicates(Heads, M, Principals) :-
  394    find_definitions(Heads, M, Heads2),
  395    strip_subsumed_heads(Heads2, Principals).
  396
  397find_definitions([], _, []).
  398find_definitions([H0|T0], M, [H|T]) :-
  399    find_definition(H0, M, H),
  400    find_definitions(T0, M, T).
  401
  402find_definition(Head, _, Def) :-
  403    strip_module(Head, _, Plain),
  404    callable(Plain),
  405    (   predicate_property(Head, imported_from(Module))
  406    ->  (   predicate_property(system:Plain, imported_from(Module)),
  407            sub_atom(Module, 0, _, _, $)
  408        ->  Def = system:Plain
  409        ;   Def = Module:Plain
  410        )
  411    ;   Def = Head
  412    ).
  413
  414%!  strip_subsumed_heads(+Heads, -GenericOnes)
  415%
  416%   Given a list of Heads, remove  subsumed heads, while maintaining
  417%   the order. The implementation is slow,   but  only used on small
  418%   sets and only for toplevel related tasks.
  419
  420strip_subsumed_heads([], []).
  421strip_subsumed_heads([H|T0], T) :-
  422    '$member'(H2, T0),
  423    subsumes_term(H2, H),
  424    \+ subsumes_term(H, H2),
  425    !,
  426    strip_subsumed_heads(T0, T).
  427strip_subsumed_heads([H|T0], [H|T]) :-
  428    strip_subsumed(T0, H, T1),
  429    strip_subsumed_heads(T1, T).
  430
  431strip_subsumed([], _, []).
  432strip_subsumed([H|T0], G, T) :-
  433    subsumes_term(G, H),
  434    !,
  435    strip_subsumed(T0, G, T).
  436strip_subsumed([H|T0], G, [H|T]) :-
  437    strip_subsumed(T0, G, T).
  438
  439
  440%!  dwim_predicate(:Head, -NewHead) is nondet.
  441%
  442%   Find a head that is in a `Do What I Mean' sence the same as `Head'.
  443%   backtracking produces more such predicates.  If searches for:
  444%
  445%       * predicates with a similar name in an import module
  446%       * predicates in a similar module with the same name
  447%       * predicates in any module with the same name
  448
  449dwim_predicate(Head, DWIM) :-
  450    dwim_predicate_list(Head, DWIMs),
  451    '$member'(DWIM, DWIMs).
  452
  453dwim_predicate_list(Head, [Head]) :-
  454    current_predicate(_, Head),
  455    !.
  456dwim_predicate_list(M:Head, DWIMs) :-
  457    setof(DWIM, dwim_pred(M:Head, DWIM), DWIMs),
  458    !.
  459dwim_predicate_list(Head, DWIMs) :-
  460    setof(DWIM, '$similar_module'(Head, DWIM), DWIMs),
  461    !.
  462dwim_predicate_list(_:Goal, DWIMs) :-
  463    setof(Module:Goal,
  464          current_predicate(_, Module:Goal),
  465          DWIMs).
  466
  467%!  dwim_pred(:Head, -DWIM) is nondet.
  468%
  469%   True if DWIM is a predicate with a similar name than Head in the
  470%   module of Head or an import module thereof.
  471
  472dwim_pred(Head, M:Dwim) :-
  473    strip_module(Head, Module, H),
  474    default_module(Module, M),
  475    '$dwim_predicate'(M:H, Dwim).
  476
  477%!  '$similar_module'(:Goal, -DWIMGoal) is nondet.
  478%
  479%   True if DWIMGoal exists and is, except from a typo in the
  480%   module specification, equivalent to Goal.
  481
  482'$similar_module'(Module:Goal, DwimModule:Goal) :-
  483    current_module(DwimModule),
  484    dwim_match(Module, DwimModule),
  485    current_predicate(_, DwimModule:Goal)