Commit 3928ef2d authored by Stefan Monnier's avatar Stefan Monnier

Merge syntax-propertize--done and parse-sexp-propertize-done

* lisp/emacs-lisp/syntax.el (syntax-propertize--done): Remove.
(syntax-propertize): Set syntax-propertize--done even if
syntax-propertize-function is nil.  Avoid recursive invocations.
(syntax-propertize-chunks): New var.
(internal--syntax-propertize): Use it.  Rename from syntax--jit-propertize.
Simplify.
(parse-sexp-propertize-function): Don't set any more.

* src/syntax.c (SETUP_SYNTAX_TABLE): Call parse_sexp_propertize as needed.
(parse_sexp_propertize): Don't assume charpos is not yet propertized.
Call Qinternal__syntax_propertize instead of
Vparse_sexp_propertize_function.  Truncate e_property if needed.
(update_syntax_table_forward): Streamline.
(syms_of_syntax): Define Qinternal__syntax_propertize.
(syntax_propertize__done): Rename from parse_sexp_propertize_done.
parent 818f06ea
......@@ -106,10 +106,6 @@ Put first the functions more likely to cause a change and cheaper to compute.")
(point-max))))
(cons beg end))
(defvar syntax-propertize--done -1
"Position up to which syntax-table properties have been set.")
(make-variable-buffer-local 'syntax-propertize--done)
(defun syntax-propertize--shift-groups (re n)
(replace-regexp-in-string
"\\\\(\\?\\([0-9]+\\):"
......@@ -290,54 +286,59 @@ The return value is a function suitable for `syntax-propertize-function'."
(defun syntax-propertize (pos)
"Ensure that syntax-table properties are set until POS."
(when (and syntax-propertize-function
(< syntax-propertize--done pos))
;; (message "Needs to syntax-propertize from %s to %s"
;; syntax-propertize--done pos)
(set (make-local-variable 'parse-sexp-lookup-properties) t)
(save-excursion
(with-silent-modifications
(make-local-variable 'parse-sexp-propertize-done) ;Just in case!
(let* ((start (max syntax-propertize--done (point-min)))
;; Avoid recursion!
(parse-sexp-propertize-done most-positive-fixnum)
(end (max pos
(min (point-max)
(+ start syntax-propertize-chunk-size))))
(funs syntax-propertize-extend-region-functions))
(while funs
(let ((new (funcall (pop funs) start end)))
(if (or (null new)
(and (>= (car new) start) (<= (cdr new) end)))
nil
(setq start (car new))
(setq end (cdr new))
;; If there's been a change, we should go through the
;; list again since this new position may
;; warrant a different answer from one of the funs we've
;; already seen.
(unless (eq funs
(cdr syntax-propertize-extend-region-functions))
(setq funs syntax-propertize-extend-region-functions)))))
;; Move the limit before calling the function, so the function
;; can use syntax-ppss.
(setq syntax-propertize--done end)
;; (message "syntax-propertizing from %s to %s" start end)
(remove-text-properties start end
'(syntax-table nil syntax-multiline nil))
(funcall syntax-propertize-function start end))))))
;;; Link syntax-propertize with the new parse-sexp-propertize.
(setq-default parse-sexp-propertize-function #'syntax--jit-propertize)
(defun syntax--jit-propertize (charpos)
(if (not syntax-propertize-function)
(setq parse-sexp-propertize-done (1+ (point-max)))
(syntax-propertize charpos)
(setq parse-sexp-propertize-done
(if (= (point-max) syntax-propertize--done)
(1+ (point-max))
syntax-propertize--done))))
(when (< syntax-propertize--done pos)
(if (null syntax-propertize-function)
(setq syntax-propertize--done (max (point-max) pos))
;; (message "Needs to syntax-propertize from %s to %s"
;; syntax-propertize--done pos)
(set (make-local-variable 'parse-sexp-lookup-properties) t)
(save-excursion
(with-silent-modifications
(make-local-variable 'syntax-propertize--done) ;Just in case!
(let* ((start (max (min syntax-propertize--done (point-max))
(point-min)))
(end (max pos
(min (point-max)
(+ start syntax-propertize-chunk-size))))
(funs syntax-propertize-extend-region-functions))
(while funs
(let ((new (funcall (pop funs) start end))
;; Avoid recursion!
(syntax-propertize--done most-positive-fixnum))
(if (or (null new)
(and (>= (car new) start) (<= (cdr new) end)))
nil
(setq start (car new))
(setq end (cdr new))
;; If there's been a change, we should go through the
;; list again since this new position may
;; warrant a different answer from one of the funs we've
;; already seen.
(unless (eq funs
(cdr syntax-propertize-extend-region-functions))
(setq funs syntax-propertize-extend-region-functions)))))
;; Move the limit before calling the function, so the function
;; can use syntax-ppss.
(setq syntax-propertize--done end)
;; (message "syntax-propertizing from %s to %s" start end)
(remove-text-properties start end
'(syntax-table nil syntax-multiline nil))
;; Avoid recursion!
(let ((syntax-propertize--done most-positive-fixnum))
(funcall syntax-propertize-function start end))))))))
;;; Link syntax-propertize with syntax.c.
(defvar syntax-propertize-chunks
;; We're not sure how far we'll go. In my tests, using chunks of 20000
;; brings to overhead to something negligible. Passing ‘charpos’ directly
;; also works (basically works line-by-line) but results in an overhead which
;; I thought was a bit too high (like around 50%).
2000)
(defun internal--syntax-propertize (charpos)
;; FIXME: Called directly from C.
(syntax-propertize (min (+ syntax-propertize-chunks charpos) (point-max))))
;;; Incrementally compute and memoize parser state.
......
......@@ -181,6 +181,7 @@ static void scan_sexps_forward (struct lisp_parse_state *,
ptrdiff_t, ptrdiff_t, ptrdiff_t, EMACS_INT,
bool, Lisp_Object, int);
static bool in_classes (int, Lisp_Object);
static void parse_sexp_propertize (ptrdiff_t charpos);
/* This setter is used only in this file, so it can be private. */
static void
......@@ -247,12 +248,12 @@ SETUP_SYNTAX_TABLE (ptrdiff_t from, ptrdiff_t count)
gl_state.offset = 0;
if (parse_sexp_lookup_properties)
{
if (count > 0 || from > BEGV)
update_syntax_table (count > 0 ? from : from - 1, count, true, Qnil);
if (gl_state.e_property > parse_sexp_propertize_done)
if (count > 0)
update_syntax_table_forward (from, true, Qnil);
else if (from > BEGV)
{
gl_state.e_property = parse_sexp_propertize_done;
gl_state.e_property_truncated = true;
update_syntax_table (from - 1, count, true, Qnil);
parse_sexp_propertize (from - 1);
}
}
}
......@@ -478,33 +479,44 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init,
static void
parse_sexp_propertize (ptrdiff_t charpos)
{
EMACS_INT modiffs = CHARS_MODIFF;
safe_call1 (Vparse_sexp_propertize_function,
make_number (1 + charpos));
if (modiffs != CHARS_MODIFF)
error ("parse-sexp-propertize-function modified the buffer!");
if (parse_sexp_propertize_done <= charpos)
error ("parse-sexp-propertize-function did not move"
" parse-sexp-propertize-done");
SETUP_SYNTAX_TABLE (charpos, 1);
EMACS_INT zv = ZV;
if (syntax_propertize__done <= charpos
&& syntax_propertize__done < zv)
{
EMACS_INT modiffs = CHARS_MODIFF;
safe_call1 (Qinternal__syntax_propertize,
make_number (min (zv, 1 + charpos)));
if (modiffs != CHARS_MODIFF)
error ("parse-sexp-propertize-function modified the buffer!");
if (syntax_propertize__done <= charpos
&& syntax_propertize__done < zv)
error ("parse-sexp-propertize-function did not move"
" syntax-propertize--done");
SETUP_SYNTAX_TABLE (charpos, 1);
}
else if (gl_state.e_property > syntax_propertize__done)
{
gl_state.e_property = syntax_propertize__done;
gl_state.e_property_truncated = true;
}
}
void
update_syntax_table_forward (ptrdiff_t charpos, bool init,
Lisp_Object object)
Lisp_Object object)
{
if (!(gl_state.e_property_truncated))
update_syntax_table (charpos, 1, init, object);
if ((gl_state.e_property > parse_sexp_propertize_done
|| gl_state.e_property_truncated)
&& NILP (object))
if (gl_state.e_property_truncated)
{
if (parse_sexp_propertize_done > charpos)
{
gl_state.e_property = parse_sexp_propertize_done;
gl_state.e_property_truncated = true;
}
else
eassert (NILP (object));
eassert (charpos >= gl_state.e_property);
eassert (charpos >= syntax_propertize__done);
parse_sexp_propertize (charpos);
}
else
{
update_syntax_table (charpos, 1, init, object);
if (gl_state.e_property > syntax_propertize__done
&& NILP (object))
parse_sexp_propertize (charpos);
}
}
......@@ -2332,13 +2344,13 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
&& SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0) == style
&& (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ?
(nesting > 0 && --nesting == 0) : nesting < 0))
/* we have encountered a comment end of the same style
/* We have encountered a comment end of the same style
as the comment sequence which began this comment
section */
section. */
break;
if (code == Scomment_fence
&& style == ST_COMMENT_STYLE)
/* we have encountered a comment end of the same style
/* We have encountered a comment end of the same style
as the comment sequence which began this comment
section. */
break;
......@@ -2346,8 +2358,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
&& code == Scomment
&& SYNTAX_FLAGS_COMMENT_NESTED (syntax)
&& SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0) == style)
/* we have encountered a nested comment of the same style
as the comment sequence which began this comment section */
/* We have encountered a nested comment of the same style
as the comment sequence which began this comment section. */
nesting++;
INC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
......@@ -2363,9 +2375,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
? nesting > 0 : nesting < 0))
{
if (--nesting <= 0)
/* we have encountered a comment end of the same style
as the comment sequence which began this comment
section */
/* We have encountered a comment end of the same style
as the comment sequence which began this comment section. */
break;
else
{
......@@ -2382,9 +2393,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
&& SYNTAX_FLAGS_COMSTART_SECOND (other_syntax))
&& (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ||
SYNTAX_FLAGS_COMMENT_NESTED (other_syntax)))
/* we have encountered a nested comment of the same style
as the comment sequence which began this comment
section */
/* We have encountered a nested comment of the same style
as the comment sequence which began this comment section. */
{
INC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
......@@ -2628,9 +2638,9 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
bool quoted;
bool mathexit = 0;
enum syntaxcode code;
EMACS_INT min_depth = depth; /* Err out if depth gets less than this. */
int comstyle = 0; /* style of comment encountered */
bool comnested = 0; /* whether the comment is nestable or not */
EMACS_INT min_depth = depth; /* Err out if depth gets less than this. */
int comstyle = 0; /* Style of comment encountered. */
bool comnested = 0; /* Whether the comment is nestable or not. */
ptrdiff_t temp_pos;
EMACS_INT last_good = from;
bool found;
......@@ -2674,11 +2684,11 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
SYNTAX_FLAGS_COMSTART_SECOND (other_syntax))
&& parse_sexp_ignore_comments)
{
/* we have encountered a comment start sequence and we
/* We have encountered a comment start sequence and we
are ignoring all text inside comments. We must record
the comment style this sequence begins so that later,
only a comment end of the same style actually ends
the comment section */
the comment section. */
code = Scomment;
comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax);
comnested |= SYNTAX_FLAGS_COMMENT_NESTED (other_syntax);
......@@ -2696,7 +2706,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
if (from == stop)
goto lose;
INC_BOTH (from, from_byte);
/* treat following character as a word constituent */
/* Treat following character as a word constituent. */
case Sword:
case Ssymbol:
if (depth || !sexpflag) break;
......@@ -3501,7 +3511,7 @@ Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.
target = XINT (targetdepth);
}
else
target = TYPE_MINIMUM (EMACS_INT); /* We won't reach this depth */
target = TYPE_MINIMUM (EMACS_INT); /* We won't reach this depth. */
validate_region (&from, &to);
scan_sexps_forward (&state, XINT (from), CHAR_TO_BYTE (XINT (from)),
......@@ -3650,19 +3660,10 @@ Otherwise, that text property is simply ignored.
See the info node `(elisp)Syntax Properties' for a description of the
`syntax-table' property. */);
DEFVAR_INT ("parse-sexp-propertize-done", parse_sexp_propertize_done,
DEFVAR_INT ("syntax-propertize--done", syntax_propertize__done,
doc: /* Position up to which syntax-table properties have been set. */);
parse_sexp_propertize_done = -1;
DEFVAR_LISP ("parse-sexp-propertize-function",
Vparse_sexp_propertize_function,
doc: /* Function to set the `syntax-table' text property.
Called with one argument, the position at which the property is needed.
After running it, `parse-sexp-propertize-done' should be strictly greater
than the argument passed. */);
/* Note: Qnil is a temporary (and invalid) value; it will be properly set in
syntax.el. */
Vparse_sexp_propertize_function = Qnil;
syntax_propertize__done = -1;
DEFSYM (Qinternal__syntax_propertize, "internal--syntax-propertize");
words_include_escapes = 0;
DEFVAR_BOOL ("words-include-escapes", words_include_escapes,
......
......@@ -174,9 +174,10 @@ SYNTAX_TABLE_BYTE_TO_CHAR (ptrdiff_t bytepos)
INLINE void
UPDATE_SYNTAX_TABLE_FORWARD (ptrdiff_t charpos)
{
{ /* Performs just-in-time syntax-propertization. */
if (parse_sexp_lookup_properties && charpos >= gl_state.e_property)
update_syntax_table_forward (charpos + gl_state.offset, false, gl_state.object);
update_syntax_table_forward (charpos + gl_state.offset,
false, gl_state.object);
}
/* Make syntax table state (gl_state) good for CHARPOS, assuming it is
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment