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