Optimize predicate completion at point

* sweep.pl (sweep_heads_collection/2): Optimize for speed.  Also
report functor length and arity for each candidate to facilitate
faster sorting.
* sweeprolog.el (sweeprolog-init-args): Add '-O'.
(sweeprolog-predicate-completion-candidates): Improve sorting.

diff --git a/sweep.pl b/sweep.pl
index b13dbbdb504762251a346ed57f74a62cfac8c4b0..60273bc4877197bdec6f8d31f2fc4552f77f1814 100644 (file)
--- a/sweep.pl
+++ b/sweep.pl
@@ -457,10 +457,7 @@ sweep_short_documentation_finalize(M, PI, Index, PIString, Doc, ArgSpan) :-
     format(string(Doc), '~w is ~w.~n    ~w~n', [S, Det, OneLiner]),
     term_string(M:PI, PIString).
 sweep_short_documentation_finalize(M, PI, Index, PIString, Doc, ArgSpan) :-
-    (   pldoc_man:load_man_object(M:PI, _, _, Dom)
-    ->  true
-    ;   pldoc_man:load_man_object(PI, _, _, Dom)
-    ),
+    man_dom(M, PI, Dom),
     memberchk(element(dt, _, SubDom0), Dom),
     memberchk(element(a, Att, SubDom), SubDom0),
     with_output_to(string(S), html_text(element(dt, Att, SubDom))),
@@ -491,6 +488,19 @@ sweep_short_documentation_finalize(M, PI, Index, PIString, Doc, ArgSpan) :-
     term_string(M:PI, PIString).
 
 
+:- dynamic man_dom_cache/3.
+
+man_dom(M, PI, Dom) :-
+    man_dom_cache(M, PI, Dom),
+    !.
+man_dom(M, PI, Dom) :-
+    (   pldoc_man:load_man_object(M:PI, _, _, Dom)
+    ->  true
+    ;   pldoc_man:load_man_object(PI, _, _, Dom)
+    ),
+    asserta(man_dom_cache(M, PI, Dom)).
+
+
 sweep_module_class(M0, C) :-
     atom_string(M, M0),
     module_property(M, class(C0)),
@@ -529,8 +539,7 @@ sweep_predicate_html_documentation(P0, D) :-
     ;   '$autoload':library_index(_, M, Path),
         xref_source(Path, [comments(store)])
     ),
-    (   pldoc_man:load_man_object(M:PI, _, _, DOM)
-    ;   pldoc_man:load_man_object(PI, _, _, DOM)
+    (   man_dom(M, PI, DOM)
     ;   doc_comment(M:PI, Pos, _, Comment),
         pldoc_html:pred_dom(M:PI, [], Pos-Comment, DOM)
     ),
@@ -1075,7 +1084,7 @@ sweep_local_predicate_export_comment([Path0,F0,A,I0],Comm) :-
     atom_string(I, I0),
     compound_name_arguments(PI, I, [F,A]),
     doc_comment(_:PI, Path:_, _Summary, Comment),
-    comment_modes(Comment, Modes),
+    sweep_comment_modes(Comment, Modes),
     compound_name_arity(Head, F, A),
     member(ModeAndDet, Modes),
     strip_det(ModeAndDet, Head),
@@ -1284,7 +1293,7 @@ sweep_head_functors_collection([Arity,D,M0,Bef,Aft], Fs) :-
     maplist(term_string, Fs0, Fs).
 
 sweep_heads_collection([D,M0,Bef,Aft], Ps) :-
-    (   M0 = []
+    (   M0 == []
     ->  true
     ;   term_string(M, M0)
     ),
@@ -1293,24 +1302,40 @@ sweep_heads_collection([D,M0,Bef,Aft], Ps) :-
     ->  exclude([M:P/A]>>sweep_grammar_rule(M, P, A), PIs0, PIs)
     ;   PIs = PIs0
     ),
-    maplist(sweep_format_head_(D), PIs, Ps).
+    sweep_format_heads(PIs, D, Ps).
+
+sweep_format_heads([], _, []) :- !.
+sweep_format_heads([PI|T], D, [S|R]) :-
+    sweep_format_head_(D, PI, S),
+    sweep_format_heads(T, D, R).
 
-sweep_format_head_(D, M:F/A, [S|SP]) :-
+sweep_format_head_(D, M:F/A, [S,SP,ArgsNames,FL,A]) :-
     N is A - D,
     length(NamedArgs, N),
+    atom_length(F, FL),
     append(NamedArgs, _, OpenNamedArgs),
     (   predicate_argument_names(M:F/A, As, Extra)
     ->  maplist(name_variable, As, Vs),
         append(Vs, Extra, OpenNamedArgs)
-    ;   maplist(=('$VAR'('_')), NamedArgs)
+    ;   maplist(=('$VAR'('_')), NamedArgs),
+        ArgsNames = []
     ),
     !,
     H =.. [F|NamedArgs],
+    term_string_subterm_positions(S, SP, H).
+
+:- dynamic term_string_subterm_positions_cache/3.
+
+term_string_subterm_positions(S, SP, H) :-
+    term_string_subterm_positions_cache(S, SP, H),
+    !.
+term_string_subterm_positions(S, SP, H) :-
     term_string(H, S, [quoted(true),
                        character_escapes(true),
                        spacing(next_argument),
                        numbervars(true)]),
-    term_string(_, S, [subterm_positions(SP)]).
+    term_string(_, S, [subterm_positions(SP)]),
+    asserta(term_string_subterm_positions_cache(S, SP, H)).
 
 name_variable(N, V) :- V = '$VAR'(N).
 
@@ -1462,34 +1487,47 @@ predicate_argument_names(M:F/A, Args, Extra) :-
     predicate_argument_names_(N, Args0, Args).
 
 predicate_argument_names_from_man(M, PI, Args) :-
-    (   pldoc_man:load_man_object(M:PI, _, _, DOM0)
-    ->  true
-    ;   pldoc_man:load_man_object(PI, _, _, DOM0)
-    ),
+    man_dom(M, PI, DOM0),
     memberchk(element(dt, _, DOM1), DOM0),
     memberchk(element(a, _, DOM2), DOM1),
-    catch(findall(Arg,
-                  (   member(element(var, _, Vars), DOM2),
-                      member(ArgsSpec, Vars),
-                      term_string(CommaSeparatedArgs,
-                                  ArgsSpec,
-                                  [module(pldoc_modes),
-                                   variable_names(VN)]),
-                      maplist(call, VN),
-                      comma_list(CommaSeparatedArgs, ArgsList),
-                      member(Arg, ArgsList)
-                  ),
-                  Args),
-          error(syntax_error(_),_),
-          fail).
+    memberchk(element(var, _, Vars), DOM2),
+    arg(2, PI, N),
+    member(ArgsSpec, Vars),
+    arg_modes_string_to_list(ArgsSpec, Args),
+    length(Args, N).
+
+:- dynamic arg_modes_string_to_list_cache/2.
+
+arg_modes_string_to_list(ArgsSpec, ArgsList) :-
+    arg_modes_string_to_list_cache(ArgsSpec, ArgsList),
+    !.
+arg_modes_string_to_list(ArgsSpec, ArgsList) :-
+    term_string(CommaSeparatedArgs, ArgsSpec,
+                [module(pldoc_modes), variable_names(VN),syntax_errors(quiet)]),
+    bind_vars_to_names(VN),
+    comma_list(CommaSeparatedArgs, ArgsList),
+    asserta(arg_modes_string_to_list_cache(ArgsSpec, ArgsList)).
+
+bind_vars_to_names([]) :- !.
+bind_vars_to_names([N=N|T]) :- bind_vars_to_names(T).
+
 
 predicate_argument_names_from_pldoc(M, PI, Args) :-
     doc_comment(M:PI, _, _, C),
-    comment_modes(C, ModeAndDets),
+    sweep_comment_modes(C, ModeAndDets),
     member(ModeAndDet, ModeAndDets),
     strip_det(ModeAndDet, Head),
     Head =.. [_|Args].
 
+:- dynamic comment_modes_cache/2.
+
+sweep_comment_modes(C, ModeAndDets) :-
+    comment_modes_cache(C, ModeAndDets),
+    !.
+sweep_comment_modes(C, ModeAndDets) :-
+    comment_modes(C, ModeAndDets),
+    asserta(comment_modes_cache(C, ModeAndDets)).
+
 predicate_argument_names_(Arity, Args0, Args) :-
     length(Args0, Arity),
     maplist(strip_mode_and_type, Args0, Args).
@@ -1537,10 +1575,10 @@ dep_import(Path, Kind, PI0) -->
     [[Path, PI, Kind]].
 
 
-sweep_format_head([M0,F0,A,D], R) :-
+sweep_format_head([M0,F0,A,D], [S|SP]) :-
     atom_string(M, M0),
     atom_string(F, F0),
-    sweep_format_head_(D, M:F/A, R).
+    sweep_format_head_(D, M:F/A, [S,SP,_,_,_]).
 
 sweep_format_term([F0,N,P], [S|SP]) :-
     atom_string(F, F0),

diff --git a/sweeprolog.el b/sweeprolog.el
index 6a70d551a14ff1f131cc53d9b231f82bbd178382..73dbb0d43d02d4d64992b8e243e66364c1d9ba77 100644 (file)
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -253,6 +253,7 @@ inserted to the input history in `sweeprolog-top-level-mode' buffers."
          "--no-signals"
          "-g"
          "create_prolog_flag(sweep,true,[access(read_only),type(boolean)])"
+         "-O"
          "-l"
          (expand-file-name
           "sweep.pl"
@@ -1444,46 +1445,71 @@ list even when found in the current clause."
              (or (string-search "(" b) (length b))))))
 
 (defun sweeprolog-predicate-completion-candidates (beg end cxt)
-  (let ((col (sweeprolog--query-once
-              "sweep" "sweep_heads_collection"
-              (list cxt
-                    (sweeprolog--qualyfing-module beg)
-                    (buffer-substring-no-properties beg (point))
-                    (buffer-substring-no-properties (point) end)))))
-    (list beg end
-          (lambda (s p a)
-            (if (eq a 'metadata)
-                '(metadata
-                  (display-sort-function . sweeprolog-predicate-completion-sort)
-                  (cycle-sort-function   . sweeprolog-predicate-completion-sort))
-              (complete-with-action a col s p)))
-          :exclusive 'no
-          :annotation-function (lambda (_) " Predicate functor")
-          :exit-function
-          (lambda (string status)
-            (pcase status
-              ('finished
-               (pcase (cdr (assoc-string string col))
-                 (`(compound
-                    "term_position"
-                    0 ,length
-                    ,_fbeg ,_fend
-                    ,holes)
-                  (with-silent-modifications
-                    (dolist (hole holes)
-                      (pcase hole
-                        (`(compound "-" ,hbeg ,hend)
-                         (add-text-properties
-                          (- (point) length (- hbeg))
-                          (- (point) length (- hend))
-                          (list
-                           'sweeprolog-hole t
-                           'font-lock-face (list 'sweeprolog-hole)
-                           'rear-nonsticky '(sweeprolog-hole
-                                             cursor-sensor-functions
-                                             font-lock-face)))))))
-                  (backward-char length)
-                  (sweeprolog-forward-hole)))))))))
+  (let* ((col (sweeprolog--query-once
+               "sweep" "sweep_heads_collection"
+               (list cxt
+                     (sweeprolog--qualyfing-module beg)
+                     (buffer-substring-no-properties beg (point))
+                     (buffer-substring-no-properties (point) end))))
+         (table (make-hash-table :test 'equal :size (length col))))
+    (dolist (cand col)
+      (puthash (car cand) (cdr cand) table))
+    (let ((sort-fn
+           (lambda (cands)
+             (sort cands
+                   (lambda (a b)
+                     (let* ((aprops (gethash a table))
+                            (bprops (gethash b table))
+                            (aargs (nth 1 aprops))
+                            (bargs (nth 1 bprops))
+                            (aflen (nth 2 aprops))
+                            (bflen (nth 2 bprops))
+                            (arity (nth 3 aprops))
+                            (brity (nth 3 bprops))
+                            (afirst t) (bfirst nil))
+                       (cond
+                        ((and aargs (not bargs)) afirst)
+                        ((and bargs (not bargs)) bfirst)
+                        ((< aflen bflen)         afirst)
+                        ((< bflen aflen)         bfirst)
+                        ((< arity brity)         afirst)
+                        ((< brity arity)         bfirst)
+                        ((string< a b)           afirst)
+                        (t                       bfirst))))))))
+      (list beg end
+            (lambda (s p a)
+              (if (eq a 'metadata)
+                  (list 'metadata
+                        (cons 'display-sort-function sort-fn)
+                        (cons 'cycle-sort-function   sort-fn))
+                (complete-with-action a table s p)))
+            :exclusive 'no
+            :annotation-function (lambda (_) " Predicate")
+            :exit-function
+            (lambda (string status)
+              (pcase status
+                ('finished
+                 (pcase (cadr (assoc-string string col))
+                   (`(compound
+                      "term_position"
+                      0 ,length
+                      ,_fbeg ,_fend
+                      ,holes)
+                    (with-silent-modifications
+                      (dolist (hole holes)
+                        (pcase hole
+                          (`(compound "-" ,hbeg ,hend)
+                           (add-text-properties
+                            (- (point) length (- hbeg))
+                            (- (point) length (- hend))
+                            (list
+                             'sweeprolog-hole t
+                             'font-lock-face (list 'sweeprolog-hole)
+                             'rear-nonsticky '(sweeprolog-hole
+                                               cursor-sensor-functions
+                                               font-lock-face)))))))
+                    (backward-char length)
+                    (sweeprolog-forward-hole))))))))))
 
 (defun sweeprolog-compound-completion-candidates (beg end)
   (let ((col (sweeprolog--query-once