Rewrite c-style parser
Remove parser combinator in favour of speed
This commit is contained in:
parent
326763b766
commit
01249b4269
@ -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)
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user