dwim.pl

View source with raw comments or as raw

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

$dwim_correct_goal(:Goal, +Bindings, -Corrected)

Correct a goal (normally typed by the user) in the `Do What I Mean' sense. Ask the user to confirm if a unique correction can be found.

Errors: - existence_error(procedure, PI) if the goal cannot be corrected.

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

no_context(+PI) is semidet: True if we should omit the DWIM message because messages.pl gives an additional explanation.

  131no_context((^)/2).
  132no_context((:-)/2).
  133no_context((:-)/1).
  134no_context((?-)/1).

correct_meta_arguments(:Goal, +Module, +Bindings, -Final) is det: Correct possible meta-arguments. This performs a recursive check on meta-arguments specified as `0' using :- meta_predicate/1. As a special exception, the arment of call/1 is not checked, so you can use call(X) as an escape from the DWIM system.

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

correct_literal(:Goal, +Bindings, +DWIMs, -Corrected) is semidet: Correct a single literal. DWIMs is a list of heads that can replace the head in Goal.

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

$find_predicate(:Spec, -PIs:list(pi)) is det

Unify `List' with a list of predicate indicators that match the specification `Spec'. `Spec' is a term Name/Arity, a ``Head'', or just an atom. The latter refers to all predicate of that name with arbitrary arity. `Do What I Mean' correction is done. If the requested module is `user' predicates residing in any module will be considered matching.

Errors: - existence_error(procedure, Spec) if no matching predicate can be found.

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

pack(+PIs, +Module, +Arity, +Context, -Packs): Pack the list of heads into packets, consisting of the corrected specification and a list of heads satisfying this specification.

  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.

name_arity(+Spec, -Name, -Arity): Obtain the name and arity of a predicate specification. Warn if this is not a legal specification.

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

principal_predicates(:Heads, +Context, -Principals): Get the principal predicate list from a list of heads (e.g., the module in which the predicate is defined).

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

strip_subsumed_heads(+Heads, -GenericOnes): Given a list of Heads, remove subsumed heads, while maintaining the order. The implementation is slow, but only used on small sets and only for toplevel related tasks.

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

dwim_predicate(:Head, -NewHead) is nondet

Find a head that is in a `Do What I Mean' sence the same as `Head'. backtracking produces more such predicates. If searches for:

predicates with a similar name in an import module
predicates in a similar module with the same name
predicates in any module with the same name

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

dwim_pred(:Head, -DWIM) is nondet: True if DWIM is a predicate with a similar name than Head in the module of Head or an import module thereof.

  472dwim_pred(Head, M:Dwim) :-
  473    strip_module(Head, Module, H),
  474    default_module(Module, M),
  475    '$dwim_predicate'(M:H, Dwim).

$similar_module(:Goal, -DWIMGoal) is nondet: True if DWIMGoal exists and is, except from a typo in the module specification, equivalent to Goal.

  482'$similar_module'(Module:Goal, DwimModule:Goal) :-
  483    current_module(DwimModule),
  484    dwim_match(Module, DwimModule),
  485    current_predicate(_, DwimModule:Goal)