publish ada-mode 5.1.6, wisi 1.0.6, new package ada-ref-man

[gnu-emacs-elpa] / packages / wisi / wisi-parse.el

diff --git a/packages/wisi/wisi-parse.el b/packages/wisi/wisi-parse.el
index bd7ce7eec216b7383f8db455a4b0dee661451d80..e3b3da6a32eb6c246671fdca7556dfdc92ac2dc0 100755 (executable)
--- a/packages/wisi/wisi-parse.el
+++ b/packages/wisi/wisi-parse.el
@@ -29,6 +29,28 @@
 (require 'cl-lib)
 (require 'semantic/wisent)
 
 (require 'cl-lib)
 (require 'semantic/wisent)
 

+;; WORKAROUND: for some reason, this condition doesn't work in batch mode!
+;; (when (and (= emacs-major-version 24)
+;;        (= emacs-minor-version 2))
+  (require 'wisi-compat-24.2)
+;;)
+
+(defvar wisi-parse-max-parallel 15
+  "Maximum number of parallel parsers for acceptable performance.
+If a file needs more than this, it's probably an indication that
+the grammar is excessively redundant.")
+
+(defvar wisi-parse-max-parallel-current (cons 0 0)
+  "Cons (count . point); Maximum number of parallel parsers used in most recent parse,
+point at which that max was spawned.")
+
+(defvar wisi-debug 0
+  "wisi debug mode:
+0 : normal - ignore parse errors, for indenting new code
+1 : report parse errors (for running tests)
+2 : show parse states, position point at parse errors, debug-on-error works in parser
+3 : also show top 10 items of parser stack.")
+

 (cl-defstruct (wisi-parser-state
            (:copier nil))
   label ;; integer identifying parser for debug
 (cl-defstruct (wisi-parser-state
            (:copier nil))
   label ;; integer identifying parser for debug


@@ -70,31 +92,19 @@
      'error-message
      "wisi parse error")
 
      'error-message
      "wisi parse error")
 

-(defvar wisi-parse-max-parallel 15
-  "Maximum number of parallel parsers for acceptable performance.
-If a file needs more than this, it's probably an indication that
-the grammar is excessively redundant.")
-
-(defvar wisi-parse-max-parallel-current (cons 0 0)
-  "Cons (count . point); Maximum number of parallel parsers used in most recent parse,
-point at which that max was spawned.")
-
-(defvar wisi-debug 0
-  "wisi debug mode:
-0 : normal - ignore parse errors, for indenting new code
-1 : report parse errors (for running tests)
-2 : show parse states, position point at parse errors, debug-on-error works in parser
-3 : also show top 10 items of parser stack.")
+(defvar-local wisi-cache-max 0
+  "Maximimum position in buffer where wisi-cache text properties are valid.")

 
 (defun wisi-parse (automaton lexer)
 
 (defun wisi-parse (automaton lexer)

-  "Parse input using the automaton specified in AUTOMATON.
+  "Parse current buffer from bob using the automaton specified in AUTOMATON.

 
 - AUTOMATON is the parse table generated by `wisi-compile-grammar'.
 
 - LEXER is a function with no argument called by the parser to
 
 - AUTOMATON is the parse table generated by `wisi-compile-grammar'.
 
 - LEXER is a function with no argument called by the parser to

-  obtain the next token in input, as a list (symbol text start
-  . end), where `symbol' is the terminal symbol, `text' is the
-  token string, `start . end' is the range in the buffer."
+  obtain the next token from the current buffer after point, as a
+  list (symbol text start . end), where `symbol' is the terminal
+  symbol, `text' is the token string, `start . end' is the range
+  in the buffer."

   (let* ((actions (aref automaton 0))
         (gotos   (aref automaton 1))
         (parser-states ;; vector of parallel parser states
   (let* ((actions (aref automaton 0))
         (gotos   (aref automaton 1))
         (parser-states ;; vector of parallel parser states


@@ -108,12 +118,15 @@ point at which that max was spawned.")
         (active-parser-count 1)
         active-parser-count-prev
         (active 'shift)
         (active-parser-count 1)
         active-parser-count-prev
         (active 'shift)

-        (token (funcall lexer))
-        some-pending)
+        (token nil)
+        some-pending
+        )

 
 

-    (setq wisi-parse-max-parallel-current (cons 0 0))
+    (goto-char (point-min))
+    (aset (wisi-parser-state-stack (aref parser-states 0)) 0 0)

 
 

-    (aset (wisi-parser-state-stack (aref parser-states 0)) 0 0) ;; Initial state
+    (setq token (funcall lexer))
+    (setq wisi-parse-max-parallel-current (cons 0 0))

 
     (while (not (eq active 'accept))
       (setq active-parser-count-prev active-parser-count)
 
     (while (not (eq active 'accept))
       (setq active-parser-count-prev active-parser-count)


@@ -126,8 +139,12 @@ point at which that max was spawned.")
              ;; spawn a new parser
              (when (= active-parser-count wisi-parse-max-parallel)
                (signal 'wisi-parse-error
              ;; spawn a new parser
              (when (= active-parser-count wisi-parse-max-parallel)
                (signal 'wisi-parse-error

-                       (wisi-error-msg (concat "too many parallel parsers required;"
-                                               " simplify grammar, or increase `wisi-parse-max-parallel'"))))
+                       (let ((state (aref (wisi-parser-state-stack parser-state)
+                                          (wisi-parser-state-sp parser-state))))
+                         (wisi-error-msg (concat "too many parallel parsers required in grammar state %d;"
+                                                 " simplify grammar, or increase `wisi-parse-max-parallel'"
+                                                 state)))))
+

              (let ((j (wisi-free-parser parser-states)))
                (cond
                 ((= j -1)
              (let ((j (wisi-free-parser parser-states)))
                (cond
                 ((= j -1)


@@ -223,11 +240,23 @@ point at which that max was spawned.")
       (when (eq active 'shift)
        (when (> active-parser-count 1)
          (setq active-parser-count (wisi-parse-elim-identical parser-states active-parser-count)))
       (when (eq active 'shift)
        (when (> active-parser-count 1)
          (setq active-parser-count (wisi-parse-elim-identical parser-states active-parser-count)))

+

        (setq token (funcall lexer)))
     )
     (when (> active-parser-count 1)
       (error "ambiguous parse result"))))
 
        (setq token (funcall lexer)))
     )
     (when (> active-parser-count 1)
       (error "ambiguous parse result"))))
 

+(defun wisi-parsers-active-index (parser-states)
+  ;; only called when active-parser-count = 1
+  (let ((result nil)
+       (i 0))
+    (while (and (not result)
+               (< i (length parser-states)))
+      (when (wisi-parser-state-active (aref parser-states i))
+       (setq result i))
+      (setq i (1+ i)))
+    result))
+

 (defun wisi-parsers-active (parser-states active-count)
   "Return the type of parser cycle to execute.
 PARSER-STATES[*].active is the last action a parser took. If it
 (defun wisi-parsers-active (parser-states active-count)
   "Return the type of parser cycle to execute.
 PARSER-STATES[*].active is the last action a parser took. If it


@@ -235,6 +264,8 @@ was 'shift, that parser used the input token, and should not be
 executed again until another input token is available, after all
 parsers have shifted the current token or terminated.
 
 executed again until another input token is available, after all
 parsers have shifted the current token or terminated.
 

+Returns one of:
+

 'accept : all PARSER-STATES have active set to nil or 'accept -
 done parsing
 
 'accept : all PARSER-STATES have active set to nil or 'accept -
 done parsing
 


@@ -264,7 +295,9 @@ token, execute 'reduce parsers."
       'accept)
      ((= (+ shift-count accept-count) active-count)
       'shift)
       'accept)
      ((= (+ shift-count accept-count) active-count)
       'shift)

-     (t (error "unexpected result in wisi-parsers-active"))
+     (t
+      ;; all parsers in error state; should not get here
+      (error "all parsers in error state; programmer error"))

      )))
 
 (defun wisi-free-parser (parser-states)
      )))
 
 (defun wisi-free-parser (parser-states)


@@ -332,19 +365,37 @@ nil, 'shift, or 'accept."
        )))
   active-parser-count)
 
        )))
   active-parser-count)
 

+(defun wisi-parse-max-pos (tokens)
+  "Return max position in tokens, or point if tokens nil."
+  (let ((result (if tokens 0 (point))))
+    (mapc
+     (lambda (token)
+       (when (cl-cdddr token)
+        (setq result (max (cl-cdddr token) result))))
+     tokens)
+    result)
+  )
+
+(defun wisi-parse-exec-action (func tokens)
+  "Execute action if all tokens past wisi-cache-max."
+  ;; We don't execute actions if all tokens are before wisi-cache-max,
+  ;; because later actions can update existing caches, and if the
+  ;; parse fails that won't happen. It also saves time.
+  (if (>= (wisi-parse-max-pos tokens) wisi-cache-max)
+
+      (funcall func tokens)
+
+    (when (> wisi-debug 1)
+      (message "... action skipped"))
+    ))
+

 (defun wisi-execute-pending (pending)
   (while pending
     (when (> wisi-debug 1) (message "%s" (car pending)))
 
 (defun wisi-execute-pending (pending)
   (while pending
     (when (> wisi-debug 1) (message "%s" (car pending)))
 

-    (cond
-     ((and (>= emacs-major-version 24)
-          (>= emacs-minor-version 3))
-      (apply (pop pending)))
-
-     (t
-      (let ((func-args (pop pending)))
-       (apply (car func-args) (cdr func-args))))
-     )))
+    (let ((func-args (pop pending)))
+      (wisi-parse-exec-action (car func-args) (cadr func-args)))
+    ))

 
 (defun wisi-parse-1 (token parser-state pendingp actions gotos)
   "Perform one shift or reduce on PARSER-STATE.
 
 (defun wisi-parse-1 (token parser-state pendingp actions gotos)
   "Perform one shift or reduce on PARSER-STATE.


@@ -468,7 +519,10 @@ the first and last tokens of the nonterminal."
                          (list (list (nth 1 action) tokens))))
          (setf (wisi-parser-state-pending parser-state)
                (list (list (nth 1 action) tokens))))
                          (list (list (nth 1 action) tokens))))
          (setf (wisi-parser-state-pending parser-state)
                (list (list (nth 1 action) tokens))))

-      (funcall (nth 1 action) tokens))
+
+      ;; Not pending.
+      (wisi-parse-exec-action (nth 1 action) tokens)
+      )

     ))
 
 (provide 'wisi-parse)
     ))
 
 (provide 'wisi-parse)