home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / p / plbin.zip / pl / boot / dwim.pl < prev    next >
Text File  |  1992-05-26  |  8KB  |  271 lines
  1. /*  dwim.pl,v 1.1.1.1 1992/05/26 11:51:21 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     jan@swi.psy.uva.nl
  5.  
  6.     Purpose: Introduce `Do What I Mean' (DWIM) correction
  7. */
  8.  
  9. :- module($dwim,
  10.     [ dwim_predicate/2
  11.     , $dwim_correct_goal/3
  12.     , $find_predicate/2
  13.     , $similar_module/2
  14.     ]).
  15.  
  16. :- module_transparent
  17.     $dwim_correct_goal/3, 
  18.     correct_goal/4.
  19.  
  20. %    $dwim_correct_goal(+Goal, +Bindings, -Corrected)
  21. %    Correct a goal (normally typed by the user) in the `Do What I Mean'
  22. %    sence. Ask the user to confirm if the a unique correction can be
  23. %    found. Otherwise warn that the predicate does not exist and fail.
  24.  
  25. $dwim_correct_goal(Goal, _, Goal) :-        % Not instantiated. Hope it
  26.     var(Goal), !.                % will be in time
  27. $dwim_correct_goal((A,B), Bindings, (NA,NB)) :- !,
  28.     $dwim_correct_goal(A, Bindings, NA),
  29.     $dwim_correct_goal(B, Bindings, NB).
  30. $dwim_correct_goal((A;B), Bindings, (NA;NB)) :- !,
  31.     $dwim_correct_goal(A, Bindings, NA),
  32.     $dwim_correct_goal(B, Bindings, NB).
  33. $dwim_correct_goal(Module:Goal, _, Module:Goal) :-
  34.     (var(Module) ; var(Goal)), !.
  35. $dwim_correct_goal(Goal, _, Goal) :-        % is defined
  36.     current_predicate(_, Goal), !.
  37. $dwim_correct_goal(Goal, Bindings, NewGoal) :-    % correct the goal
  38.     dwim_predicate_list(Goal, DWIMs), !,
  39.     correct_goal(Goal, Bindings, DWIMs, NewGoal).
  40. $dwim_correct_goal(Goal, _, _) :-        % can't be corrected
  41.     $break($warn_undefined(Goal, [])),
  42.     fail.
  43.  
  44. correct_goal(Goal, Bindings, [Dwim], DwimGoal) :-
  45.     $strip_module(Goal, _, G1), 
  46.     $strip_module(Dwim, DM, G2), 
  47.     functor(G1, _, Arity), 
  48.     functor(G2, Name, Arity), !, 
  49.     G1 =.. [_|Arguments], 
  50.     G2 =.. [Name|Arguments], 
  51.     context_module(Context),
  52.     $prefix_module(DM, Context, G2, DwimGoal),
  53.     goal_name(DwimGoal, Bindings, String),
  54.     $confirm('Correct to: `~w''', [String]).
  55. correct_goal(Goal, Bindings, Dwims, NewGoal) :-
  56.     $strip_module(Goal, _, G1), 
  57.     functor(G1, _, Arity), 
  58.     sublist($dwim:has_arity(Arity), Dwims, [Dwim]), !,
  59.     correct_goal(Goal, Bindings, [Dwim], NewGoal).
  60. correct_goal(Goal, _, Dwims, _) :-
  61.     $break($warn_undefined(Goal, Dwims)), 
  62.     fail.
  63.  
  64. has_arity(A, G) :-
  65.     $strip_module(G, _, G1), 
  66.     functor(G1, _, A).
  67.  
  68. %    goal_name(+Goal, +Bindings, -Name)
  69. %    Transform Goal into a readable format.
  70.  
  71. goal_name(Goal, Bindings, String) :-
  72.     checklist(call, Bindings),        % Bind the variables
  73.     goal_name_(Goal, String),
  74.     recorda($goal_name, String),
  75.     fail.
  76. goal_name(_, _, String) :-
  77.     recorded($goal_name, String, Ref), !,
  78.     erase(Ref).
  79.  
  80. goal_name_('_', '_') :- !.            % catch anonemous variable
  81. goal_name_(Module:Name/Arity, String) :- !,
  82.     sformat(String, '~q:~q/~q', [Module, Name, Arity]).
  83. goal_name_(Name/Arity, String) :- !,
  84.     sformat(String, '~q/~q', [Name, Arity]).
  85. goal_name_(Module:Term, String) :- !,
  86.     sformat(String, '~q:~w', [Module, Term]).
  87. goal_name_(Goal, String) :-
  88.     sformat(String, '~w', [Goal]).
  89.  
  90.  
  91. %    $find_predicate(+Spec, -List)
  92. %
  93. %    Unify `List' with a list  of  predicate  heads  that  match  the
  94. %    specification  `Spec'.  `Spec' is a term Name/Arity, a ``Head'', 
  95. %    or just an atom.  The latter refers to  all  predicate  of  that
  96. %    name with arbitrary arity.  `Do What I Mean' correction is done.
  97. %    If the requested module is `user' predicates residing in any
  98. %    module will be considered matching.
  99. %    If  no predicates can be found or more than one `Do What I Mean'
  100. %    solution exists an error message is displayed.
  101.  
  102. :- module_transparent
  103.     $find_predicate/2.
  104.  
  105. $find_predicate(Spec, List) :-
  106.     $strip_module(Spec, M, S),
  107.     name_arity(S, Name, Arity),
  108.     context_module(C),
  109.     (   M == user
  110.     ;   Module = M
  111.     ) ->
  112.     find_predicate(Module, C, Name, Arity, L0), !,
  113.     sort(L0, L1),
  114.     principal_predicates(C, L1, List).
  115. $find_predicate(Spec, _) :-
  116.     $break($warning('No predicates for `~w''', [Spec])),
  117.     fail.
  118.     
  119. find_predicate(Module, C, Name, Arity, VList) :-
  120.     findall(Head, find_predicate_(Module, C, Name, Arity, Head), VList),
  121.     VList \== [], !.
  122. find_predicate(Module, C, Name, Arity, Pack) :-
  123.     findall(Head, find_sim_pred(Module, Name, Arity, Head), List),
  124.     pack(List, Module, Arity, C, Packs),
  125.     member(Dwim-Pack, Packs),
  126.     print_pack_name(C, Dwim, PredName),
  127.     $confirm('Correct to `~w''', PredName), !.
  128.  
  129. print_pack_name(C, C:Name/Arity, P) :- !, concat_atom([Name, /, Arity], P).
  130. print_pack_name(_, M:Name/Arity, P) :- !, concat_atom([M, :, Name, /, Arity], P).
  131. print_pack_name(C, C:Name, Name)    :- !.
  132. print_pack_name(_, M:Name, P)       :- !, concat_atom([M, :, Name], P).
  133. print_pack_name(_, Name,   Name).
  134.  
  135.  
  136. %    pack(+Heads, +Context, -Packs)
  137. %    Pack the list of heads into packets, consisting of the corrected
  138. %    specification and a list of heads meeting this specification.
  139.  
  140. pack([], _, _, _, []) :- !.
  141. pack([M:T|Rest], Module, Arity, C, [Name-[H|R]|Packs]) :-
  142.     $prefix_module(M, C, T, H),
  143.     pack_name(M:T, Module, Arity, Name),
  144.     pack_(Module, Arity, Name, C, Rest, R, NewRest),
  145.     pack(NewRest, Module, Arity, C, Packs).
  146.  
  147. pack_(Module, Arity, Name, C, List, [H|R], Rest) :-
  148.     select(List, M:T, R0),
  149.     pack_name(M:T, Module, Arity, Name), !,
  150.     $prefix_module(M, C, T, H),
  151.     pack_(Module, Arity, Name, C, R0, R, Rest).
  152. pack_(_, _, _, _, Rest, [], Rest).
  153.  
  154. pack_name(_:T, V1, V2,   Name)   :- var(V1), var(V2), !, functor(T, Name, _).
  155. pack_name(M:T,  _, V2, M:Name)   :-          var(V2), !, functor(T, Name, _).
  156. pack_name(_:T, V1,  _, Name/A)   :- var(V1),          !, functor(T, Name, A).
  157. pack_name(M:T,  _,  _, M:Name/A) :-                      functor(T, Name, A).
  158.  
  159.  
  160. find_predicate_(M, C, Name, Arity, Head) :-
  161.     same_module(M, Module),
  162.     current_predicate(Name, Module:Term),
  163.     functor(Term, Name, A),
  164.     same_arity(Arity, A),
  165.     $prefix_module(Module, C, Term, Head).
  166.  
  167. same_module(M, Module) :-
  168.     var(M), !,
  169.     current_module(Module).
  170. same_module(M, M) :-
  171.     current_module(M).
  172.  
  173. same_arity(A, _) :- var(A), !.
  174. same_arity(A, A).
  175.  
  176. find_sim_pred(M, Name, Arity, Module:Term) :-
  177.     sim_module(M, Module),
  178.     $dwim_predicate(Module:Name, Term),
  179.     functor(Term, _, DArity),
  180.     sim_arity(Arity, DArity).
  181.     
  182. sim_module(M, Module) :-
  183.     var(M), !,
  184.     current_module(Module).
  185. sim_module(M, M) :-
  186.     current_module(M), !.
  187. sim_module(M, Module) :-
  188.     current_module(Module),
  189.     dwim_match(M, Module).
  190.  
  191. sim_arity(A, _) :- var(A), !.
  192. sim_arity(A, D) :- abs(A-D) < 2.
  193.  
  194. %    name_arity(+Spec, -Name, -Arity)
  195. %    Obtain the name and arity of a predicate specification. Warn if
  196. %    this is not a legal specification.
  197.  
  198. name_arity(Atom, Atom, _) :-
  199.     atom(Atom), !.
  200. name_arity(Name/Arity, Name, Arity) :- !.
  201. name_arity(Term, Name, Arity) :-
  202.     functor(Term, Name, Arity), !.
  203. name_arity(Spec, _, _) :-
  204.     $warning('Illegal predicate specification: `~w''', [Spec]),
  205.     fail.
  206.  
  207.  
  208. %    principal_predicates(+Context, +Heads, -Principals)
  209. %    Get the principal predicate list from a list of heads (e.g. the
  210. %    module in which the predicate is defined).
  211.  
  212. principal_predicates(C, Heads, Principals) :-
  213.     maplist(find_definition(C), Heads, P0),
  214.     (   C == user
  215.     ->  maplist(find_public, P0, P1),
  216.         delete_defaults(P1, P1, P2)
  217.     ;   P2 = P0
  218.     ),    
  219.     list_to_set(P2, Principals).
  220.     
  221. delete_defaults([], _, []) :- !.
  222. delete_defaults([system:Head|T], L, R) :-
  223.     memberchk(Head, L), !,
  224.     delete_defaults(T, L, R).
  225. delete_defaults([H|T], L, [H|R]) :-
  226.     delete_defaults(T, L, R).
  227.  
  228. find_public(Head, user:Term) :-
  229.     $strip_module(Head, M, Term),
  230.     current_predicate(_, user:Term),
  231.     $predicate_property(user:Term, imported_from(M)), !.
  232. find_public(Head, Head).
  233.  
  234. find_definition(C, Head, Principal) :-
  235.     $predicate_property(C:Head, imported_from(Module)), !,
  236.     $strip_module(Head, _, Term),
  237.     $prefix_module(Module, C, Term, P0),
  238.     find_definition(C, P0, Principal).
  239. find_definition(_, Head, Head).
  240.  
  241.  
  242. %    dwim_predicate(+Head, -NewHead)
  243. %    Find a head that is in a `Do What I Mean' sence the same as `Head'.
  244. %    backtracking produces more such predicates.
  245.  
  246. :- module_transparent
  247.     dwim_predicate/2, 
  248.     dwim_predicate_list/2.
  249.  
  250. dwim_predicate(Head, DWIM) :-
  251.     dwim_predicate_list(Head, DWIMs),
  252.     member(DWIM, DWIMs).
  253.  
  254. dwim_predicate_list(Head, [Head]) :-
  255.     current_predicate(_, Head), !.
  256. dwim_predicate_list(Head, DWIMs) :-
  257.     setof(DWIM, $dwim_predicate(Head, DWIM), DWIMs), !.
  258. dwim_predicate_list(Head, DWIMs) :-
  259.     setof(DWIM, $similar_module(Head, DWIM), DWIMs), !.
  260. dwim_predicate_list(Head, DWIMs) :-
  261.     $strip_module(Head, _, Goal),
  262.     setof(Module:Goal, ( current_module(Module),
  263.                  current_predicate(_, Module:Goal)
  264.                ), DWIMs).
  265.  
  266. $similar_module(Head, DwimModule:Goal) :-
  267.     $strip_module(Head, Module, Goal),
  268.     current_module(DwimModule),
  269.     dwim_match(Module, DwimModule),
  270.     current_predicate(_, DwimModule:Goal).
  271.