sweep_predicate_location/2,
sweep_predicate_apropos/2,
sweep_predicates_collection/2,
- sweep_functor_arity_pi/2,
+ sweep_module_functor_arity_pi/2,
sweep_modules_collection/2,
sweep_packs_collection/2,
sweep_pack_install/2,
sweep_module_path_(Module, Path) :-
xref_module(Path, Module), !.
sweep_module_path_(Module, Path) :-
- '$autoload':library_index(_, Module, Path0), atom_concat(Path0, '.pl', Path).
+ '$autoload':library_index(_, Module, Path0), atom_concat(Path0, '.pl', Path), !.
+sweep_module_path_(user, _).
+
sweep_predicate_properties(P0, Props) :-
term_string(P, P0),
sweep_predicate_html_documentation(P0, D) :-
term_string(P1, P0),
- ( P1 = M:F/N
+ ( P1 = M:PI
-> true
- ; P1 = F/N, M = system
+ ; P1 = PI, M = system
),
( ( current_module(M)
; xref_module(_, M)
; '$autoload':library_index(_, M, Path),
xref_source(Path, [comments(store)])
),
- ( M == system
- -> pldoc_man:load_man_object(F/N, _, _, DOM)
- ; doc_comment(M:F/N, Pos, _, Comment),
- pldoc_html:pred_dom(M:F/N, [], Pos-Comment, DOM)
+ ( pldoc_man:load_man_object(M:PI, _, _, DOM)
+ ; pldoc_man:load_man_object(PI, _, _, DOM)
+ ; doc_comment(M:PI, Pos, _, Comment),
+ pldoc_html:pred_dom(M:PI, [], Pos-Comment, DOM)
),
phrase(pldoc_html:html(DOM), HTML),
with_output_to(string(D), html_write:print_html(HTML)).
sweep_module_description([M0|P], [M|[P]]) :- atom_string(M0, M).
sweep_predicate_references(MFN, Refs) :-
- term_string(M:F/N, MFN),
- pi_head(F/N, H),
- findall([B, Path, From, Len],
- (xref_called(Path0, H, B0, _, Line),
- pi_head(B1, B0),
- term_string(B1, B),
- atom_string(Path0, Path),
- reference_span(Path0, Line, H, From, Len)),
- Refs,
- Tail),
+ term_string(M:PI, MFN),
+ pi_head(PI, H),
findall([B, Path, From, Len],
- (xref_called(Path0, M:H, B0, _, Line),
+ (( xref_called(Path0, H, B0, _, Line)
+ ; xref_called(Path0, M:H, B0, _, Line)
+ ),
pi_head(B1, B0),
- term_string(B1, B),
+ ( B1 = M2:F/N
+ -> true
+ ; B1 = F/N,
+ sweep_module_path_(M2, Path0)
+ ),
+ sweep_module_functor_arity_pi_(M2, F, N, B2),
+ term_string(B2, B),
atom_string(Path0, Path),
reference_span(Path0, Line, H, From, Len)),
- Tail).
+ Refs).
:- dynamic current_reference_span/2.
reference_span_(_, _, _, _) :- true.
sweep_predicate_location(MFN, [Path|Line]) :-
- term_string(M:F/N, MFN),
+ term_string(M:PI, MFN),
!,
- pi_head(F/N, H),
+ pi_head(PI, H),
( sweep_predicate_location_(M, H, Path, Line)
-> true
; sweep_predicate_location_(H, Path, Line)
).
sweep_predicate_location(FN, [Path|Line]) :-
- term_string(F/N, FN),
- !,
- pi_head(F/N, H),
+ term_string(PI, FN),
+ pi_head(PI, H),
sweep_predicate_location_(H, Path, Line).
sweep_predicate_apropos(Query0, Matches) :-
atom_string(Query, Query0),
findall([S,Path|Line],
- (prolog_help:apropos(Query, M:F/N, _, P), P >= 0.3,
- format(string(S), '~W', [M:F/N, [quoted(true), character_escapes(true)]]),
- pi_head(F/N, Head),
+ (prolog_help:apropos(Query, M:PI, _, P), P >= 0.3,
+ format(string(S), '~W', [M:PI, [quoted(true), character_escapes(true)]]),
+ catch(pi_head(PI, Head), _, fail),
sweep_predicate_location_(M, Head, Path, Line)),
Matches, Tail),
findall([S,Path],
- (prolog_help:apropos(Query, F/N, _, P), P >= 0.3,
- format(string(S), '~W', [F/N, [quoted(true), character_escapes(true)]]),
- pi_head(F/N, Head),
+ (prolog_help:apropos(Query, PI, _, P), P >= 0.3,
+ format(string(S), '~W', [PI, [quoted(true), character_escapes(true)]]),
+ catch(pi_head(PI, Head), _, fail),
sweep_predicate_location_(Head, Path, Line)),
Tail).
\+ sub_string(String, _, _, _, ":'$").
sweep_predicate_description(M:F/N, [S|T]) :-
- sweep_predicate_description_(M, F, N, T),
+ sweep_module_functor_arity_pi_(M, F, N, MFA),
format(string(S),
'~W',
- [M:F/N, [quoted(true), character_escapes(true)]]).
+ [MFA, [quoted(true), character_escapes(true)]]),
+ sweep_predicate_description_(MFA, T).
-sweep_predicate_description_(M, F, N, [D]) :-
- doc_comment(M:F/N, _, D0, _), !, atom_string(D0, D).
-sweep_predicate_description_(_M, F, N, [D]) :-
- man_object_property(F/N, summary(D0)), !, atom_string(D0, D).
-sweep_predicate_description_(_, _, _, []).
+sweep_predicate_description_(MFA, [D]) :-
+ doc_comment(MFA, _, D0, _), !, atom_string(D0, D).
+sweep_predicate_description_(MFA, [D]) :-
+ man_object_property(MFA, summary(D0)), !, atom_string(D0, D).
+sweep_predicate_description_(_:FA, [D]) :-
+ man_object_property(FA, summary(D0)), !, atom_string(D0, D).
+sweep_predicate_description_(_, []).
sweep_packs_collection(SearchString, Packs) :-
prolog_pack:query_pack_server(search(SearchString), true(Packs0), []),
solutions(all),
extensions(['', '.pl'])]).
-sweep_path_module([], "user") :- !.
sweep_path_module(Path0, Module) :-
atom_string(Path, Path0),
- xref_module(Path, Module0),
+ sweep_module_path_(Module0, Path),
atom_string(Module0, Module).
strip_det(//(Mode), Mode) :- !.
strip_det(Mode, Mode).
-sweep_functor_arity_pi([M,F0,A|_], PI) :-
- !, atom_string(F, F0), term_string(M:F/A, PI).
-sweep_functor_arity_pi([F0,A|Path0], PI) :-
+sweep_module_functor_arity_pi([M0,F0,A], PI) :-
+ atom_string(M, M0),
atom_string(F, F0),
- pi_head(F/A, Head),
- sweep_current_module(M0),
- ( @(predicate_property(M:Head, visible), M0),
- \+ @(predicate_property(M:Head, imported_from(_)), M0)
- -> T = M:F/A
- ; xref_defined(_, Head, imported(Other)), xref_module(Other, M)
- -> T = M:F/A
- ; string(Path0),
- atom_string(Path, Path0),
- xref_defined(Path, Head, _)
- -> T = M0:F/A
- ; T = F/A
- ),
- term_string(T, PI).
+ sweep_module_functor_arity_pi_(M, F, A, PI0),
+ term_string(PI0, PI).
+
+sweep_module_functor_arity_pi_(M, F, A, M:F//B) :-
+ sweep_grammar_rule(M, F, A),
+ !,
+ B is A - 2.
+sweep_module_functor_arity_pi_(M, F, A, M:F/A).
+
+sweep_grammar_rule(M, F, A) :-
+ xref_module(Source, M),
+ pi_head(F/A, H),
+ xref_defined(Source, H, dcg).
+sweep_grammar_rule(M, F, A) :-
+ pi_head(M:F/A, H),
+ predicate_property(H, non_terminal).
sweep_current_module(Module) :-
sweep_main_thread,
user:sweep_funcall("buffer-file-name", String),
- string(String),
- atom_string(Path, String),
- sweep_module_path_(Module, Path).
-sweep_current_module(user).
+ ( string(String)
+ -> atom_string(Path, String),
+ sweep_module_path_(Module, Path)
+ ; Module = user
+ ).
+
sweep_beginning_of_last_predicate(Start, Next) :-
sweep_source_id(Path),
(`(compound "/"
(atom . ,functor)
,arity)
- (cons functor arity))))
+ (cons functor arity))
+ (`(compound ":"
+ (atom . ,_)
+ (compound "//"
+ (atom . ,functor)
+ ,arity))
+ (cons functor (+ arity 2)))
+ (`(compound "//"
+ (atom . ,functor)
+ ,arity)
+ (cons functor (+ arity 2)))))
(defun sweeprolog--swipl-source-directory ()
(when sweeprolog-swipl-sources
(cons start (point))))))))
;;;###autoload
-(defun sweeprolog-find-predicate (mfn)
- "Jump to the definition of the Prolog predicate MFN.
-MFN must be a string of the form \"M:F/N\" where M is a Prolog
-module name, F is a functor name and N is its arity."
+(defun sweeprolog-find-predicate (mfa)
+ "Jump to the definition of the Prolog predicate MFA.
+MFA should be a string of the form \"M:F/A\" or \"M:F//A\", where
+M is a Prolog module name, F is a functor and A is its arity."
(interactive (list (sweeprolog-read-predicate)))
- (if-let ((loc (sweeprolog-predicate-location mfn)))
+ (if-let ((loc (sweeprolog-predicate-location mfa)))
(let ((path (car loc))
(line (or (cdr loc) 1)))
(find-file path)
(goto-char (point-min))
(forward-line (1- line)))
- (user-error "Unable to locate predicate %s" mfn)))
+ (user-error "Unable to locate predicate %s" mfa)))
+
+(defun sweeprolog--fragment-to-mfa (fragment buffer-module)
+ (pcase fragment
+ ((or `("head_term" ,kind ,functor ,arity)
+ `("head" ,kind ,functor ,arity))
+ (pcase kind
+ ((or "unreferenced"
+ "meta"
+ "exported"
+ "hook"
+ "public"
+ "dynamic"
+ "multifile"
+ "local")
+ (list buffer-module functor arity))
+ ((or "def_iso"
+ "def_swi"
+ "iso"
+ "built_in")
+ (list "system" functor arity))
+ (`("imported" . ,file)
+ (list (sweeprolog-path-module file) functor arity))
+ (`("extern" ,module . ,_)
+ (list module functor arity))))
+ ((or `("goal_term" ,kind ,functor ,arity)
+ `("goal" ,kind ,functor ,arity))
+ (pcase kind
+ ((or "meta"
+ "hook"
+ "dynamic"
+ "multifile"
+ "local"
+ "undefined"
+ "thread_local"
+ "expanded"
+ "recursion")
+ (list buffer-module functor arity))
+ ((or "def_iso"
+ "def_swi"
+ "iso"
+ "built_in"
+ "foreign")
+ (list "system" functor arity))
+ (`(,(or "imported" "autoload") . ,file)
+ (list (sweeprolog-path-module file) functor arity))
+ (`("extern" ,module . ,_)
+ (list module functor arity))
+ ((or "global"
+ `("global" . ,_))
+ (list "user" functor arity))))))
+
+(defun sweeprolog--mfa-to-pi (module functor arity)
+ (unless (eq functor 'variable)
+ (sweeprolog--query-once "sweep" "sweep_module_functor_arity_pi"
+ (list module functor arity))))
+
+(defun sweeprolog-path-module (file)
+ (sweeprolog--query-once "sweep" "sweep_path_module" file))
+
+(defun sweeprolog-buffer-module (&optional buffer)
+ (sweeprolog-path-module (buffer-file-name buffer)))
(defun sweeprolog-identifier-at-point (&optional point)
(when (derived-mode-p 'sweeprolog-mode 'sweeprolog-top-level-mode)
(setq point (or point (point)))
(save-excursion
(goto-char point)
- (let ((id-at-point nil))
+ (let ((id-at-point nil)
+ (buffer-module (sweeprolog-buffer-module)))
(sweeprolog-analyze-term-at-point
(lambda (beg end arg)
(when (<= beg point end)
- (pcase arg
- ((or `("head_term" ,_ ,f ,a)
- `("goal_term" ,_ ,f ,a)
- `("head" ,_ ,f ,a)
- `("goal" ,_ ,f ,a))
- (setq id-at-point (list f a)))))))
- (when (and id-at-point
- (not (eq (car id-at-point) 'variable)))
- (sweeprolog--query-once "sweep" "sweep_functor_arity_pi"
- (append id-at-point (buffer-file-name))))))))
+ (when-let ((mfa (sweeprolog--fragment-to-mfa arg buffer-module)))
+ (setq id-at-point mfa)))))
+ (when id-at-point
+ (apply #'sweeprolog--mfa-to-pi id-at-point))))))
;;;; Modules
(defun sweeprolog-context-menu-for-predicate (menu tok _beg _end _point)
"Extend MENU with predicate-related commands if TOK describes one."
- (pcase tok
- ((or `("head" ,_ ,f ,a)
- `("goal" ,_ ,f ,a))
- (let ((pred (sweeprolog--query-once "sweep" "sweep_functor_arity_pi"
- (append (list f a)
- (buffer-file-name)))))
- (setq sweeprolog-context-menu-predicate-at-click pred)
- (define-key menu [sweeprolog-describe-predicate]
- `(menu-item "Describe This Predicate"
- sweeprolog-context-menu-describe-predicate
- :help ,(format "Describe predicate %s" pred)
- :keys "\\[sweeprolog-describe-predicate]"))))))
+ (when-let ((mfa (sweeprolog--fragment-to-mfa tok (sweeprolog-buffer-module)))
+ (pred (apply #'sweeprolog--mfa-to-pi mfa)))
+ (setq sweeprolog-context-menu-predicate-at-click pred)
+ (define-key menu [sweeprolog-describe-predicate]
+ `(menu-item "Describe This Predicate"
+ sweeprolog-context-menu-describe-predicate
+ :help ,(format "Describe predicate %s" pred)
+ :keys "\\[sweeprolog-describe-predicate]"))))
(defun sweeprolog-context-menu-for-module (menu tok _beg _end _point)
"Extend MENU with module-related commands if TOK describes one."
projects / sweep.git / commitdiff