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    ->  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) :- !.
 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.
  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.
 name_arity(+Spec, -Name, -Arity)
Obtain the name and arity of a predicate specification. Warn if this is not a legal specification.
  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).
 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).
  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    ).
 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.
  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).
 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:
  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).
 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.
  471dwim_pred(Head, M:Dwim) :-
  472    strip_module(Head, Module, H),
  473    default_module(Module, M),
  474    '$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.
  481'$similar_module'(Module:Goal, DwimModule:Goal) :-
  482    current_module(DwimModule),
  483    dwim_match(Module, DwimModule),
  484    current_predicate(_, DwimModule:Goal)