Rewrite c-style parser
Remove parser combinator in favour of speed
This commit is contained in:
		| @@ -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 | ||||||
|   | |||||||
		Reference in New Issue
	
	Block a user