Rewrite c-style parser

Remove parser combinator in favour of speed
This commit is contained in:
Greg Sexton 2014-11-11 21:48:26 +00:00
parent 326763b766
commit 01249b4269
2 changed files with 38 additions and 21 deletions

View File

@ -45,28 +45,45 @@
:type 'hook :type 'hook
:group 'origami) :group 'origami)
(defun origami-pair (start children end create) ;;; TODO: generalize to take a function? then could use a regex or
;; TODO: make this a macro so I don't have to pass in the thunk? ;;; begin-defun etc?
"CHILDREN should be a zero-arg lambda -- a thunk -- returning a (defun origami-get-positions (content regex)
parser to allow for recursive nesting of a parser. CREATE is a (with-temp-buffer
function that should build state taking the beginning, end and (insert content)
children of the pair." (beginning-of-buffer)
(parser-do (initial-pos <- (parser-position)) (let (acc)
(begin <- start) (while (re-search-forward regex nil t)
(children <- (funcall children)) (setq acc (cons (cons (match-string 0) (point)) acc)))
(end <- end) (reverse acc))))
(parser-return (funcall create initial-pos end (- begin initial-pos) children))))
(defun origami-build-pair-tree (create positions)
;; this is so horrible, but fast
(let (acc beg (should-continue t))
(while (and should-continue positions)
(cond ((equal (caar positions) "{")
(if beg ;go down a level
(let* ((res (origami-build-pair-tree create positions))
(new-pos (car res))
(children (cdr res)))
(setq positions (cdr new-pos))
(setq acc (cons (funcall create beg (cdar new-pos) 0 children) acc))
(setq beg nil))
;; begin a new pair
(setq beg (cdar positions))
(setq positions (cdr positions))))
((equal (caar positions) "}")
(if beg
(progn ;close no children
(setq acc (cons (funcall create beg (cdar positions) 0 nil) acc))
(setq positions (cdr positions))
(setq beg nil))
(setq should-continue nil)))))
(cons positions (reverse acc))))
(defun origami-c-style-parser (create) (defun origami-c-style-parser (create)
(let ((pair (origami-pair (parser-char "{") (lambda (content)
(lambda () (origami-c-style-parser create)) (let ((positions (origami-get-positions (parser-content-string content) "[{}]")))
(parser-char "}") (list (cdr (origami-build-pair-tree create positions))))))
create)))
(parser-0+ (parser-conj
(parser-do
(parser-drop-until-regex "[{}]")
(parser-1? pair))
pair))))
(defun origami-lisp-parser (create regex) (defun origami-lisp-parser (create regex)
(lambda (content) (lambda (content)

View File

@ -338,7 +338,7 @@ was last built."
(defun origami-build-tree (buffer parser) (defun origami-build-tree (buffer parser)
(when parser (when parser
(with-current-buffer buffer (with-current-buffer buffer
(let ((contents (buffer-string))) (let ((contents (buffer-substring-no-properties (point-min) (point-max))))
(-> parser (-> parser
(parser-run (parser-content 0 contents)) (parser-run (parser-content 0 contents))
car car