(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
'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)
- "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
- 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
(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)
;; 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)
(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"))))
+(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
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)
((= (+ 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)
)))
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)))
- (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.
(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)