[Emacs-diffs] master 3928ef2: Merge syntax-propertize--done and parse-sexp-propertize-done

[Stefan Monnier]

branch: master
commit 3928ef2dd5b8febf3b1d9c1bfb22af3698d16bea
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    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.
---
 lisp/emacs-lisp/syntax.el |  105 +++++++++++++++++++++---------------------
 src/syntax.c              |  113 +++++++++++++++++++++++----------------------
 src/syntax.h              |    5 +-
 3 files changed, 113 insertions(+), 110 deletions(-)

diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 6c9cba3..5101925 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -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.
 
diff --git a/src/syntax.c b/src/syntax.c
index fcd6d01..de45c50 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -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,
diff --git a/src/syntax.h b/src/syntax.h
index 9c44181..34b652b 100644
--- a/src/syntax.h
+++ b/src/syntax.h
@@ -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