From: Eshel Yaron Date: Tue, 14 Nov 2023 08:40:21 +0000 (+0100) Subject: Optimize predicate completion at point X-Git-Tag: V9.1.19-sweep-0.27.1~6 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=68a2b02cd3e423124472ac2ef1f31de3837b420d;p=sweep.git 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 b13dbbd..60273bc 100644 --- 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 6a70d55..73dbb0d 100644 --- 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