Implement monadic parsing

This commit is contained in:
Greg Sexton 2014-03-25 22:00:34 +00:00
parent 5b97990a0d
commit 7bf9c22e47

View File

@ -158,58 +158,76 @@ used to nil out data. This mutates the node."
(origami-content (+ (origami-content-consumed-count content) consumed) (origami-content (+ (origami-content-consumed-count content) consumed)
(substring (origami-content-string content) consumed))) (substring (origami-content-string content) consumed)))
;;; scanner ;;; parser
(defun origami-scanner-bind (h f) (defun origami-run-parser (parser content)
(funcall parser content))
(defun origami-parser-bind (m f)
"State monad composed with the maybe monad." "State monad composed with the maybe monad."
(if (null h) nil (if (null m) nil
(lambda (s) (lambda (s)
(let ((new-result (funcall h s))) (let ((new-result (origami-run-parser m s)))
(if (null new-result) nil (if (null new-result) nil
(destructuring-bind (new-value . new-state) new-result (destructuring-bind (new-value . new-state) new-result
(funcall (funcall f new-value) new-state))))))) (origami-run-parser (funcall f new-value) new-state)))))))
;;; TODO: reimplement this as a macro so that intermediate results are (defmacro origami-do (expr &rest more)
;;; visible. Basically implement proper do notation. (let ((assignment-p (and (listp expr) (equal (cadr expr) '<-))))
(defun origami-scanner-bind-chain (scanner &rest funs) (let ((var (if assignment-p (car expr) (gensym)))
(-reduce-from (lambda (acc f) (origami-scanner-bind acc f)) scanner funs)) (f (if assignment-p (caddr expr) expr)))
(if more
`(origami-parser-bind
,f (lambda (,var)
(origami-do ,@more)))
f))))
(defun origami-scanner-return (x) (defun origami-parser-return (x)
(lambda (s) (cons x s))) (lambda (s) (cons x s)))
(defun origami-run-scanner (scanner content) (defun origami-parser-zero ()
(funcall scanner content)) (lambda (s) nil))
(defun origami-scan (buffer scanner) (defun origami-parser-get ()
(lambda (s) (cons s s)))
(defun origami-parser-item ()
(lambda (content)
(let ((content-str (origami-content-string content)))
(unless (s-blank? content-str)
(cons (substring content-str 0 1) (origami-content-from content 1))))))
(defun origami-parser-position ()
(origami-do (content <- (origami-parser-get))
(origami-parser-return (origami-content-consumed-count content))))
(defun origami-parser-sat (p)
(origami-do (pos <- (origami-parser-position))
(a <- (origami-parser-item))
(if (funcall p a)
(origami-parser-return pos)
(origami-parser-zero))))
(defun origami-parser-char (x)
(origami-parser-sat (lambda (c) (equal x c))))
(defun origami-parser-paired (start end children)
(origami-do (begin <- start)
(children <- children)
(end <- end)
(origami-parser-return (origami-fold-node begin end t children))))
(origami-run-parser
(origami-parser-paired (origami-parser-char "{")
(origami-parser-char "}")
(origami-parser-return nil))
(origami-content 7 "{}"))
;;; TODO: rework this
(defun origami-parse (buffer parser)
(with-current-buffer buffer (with-current-buffer buffer
(let ((contents (buffer-string))) (let ((contents (buffer-string)))
(origami-run-scanner scanner (origami-content 0 contents))))) (origami-run-parser parser (origami-content 0 contents)))))
(defun origami-scanner-consume (prefix content)
(lambda (state)
(when (s-prefix-p prefix (origami-content-string content))
(cons (origami-content-from content (length prefix)) state))))
(defun origami-pair-scanner (start end skip)
(lambda (content)
(origami-scanner-bind-chain
(origami-scanner-consume start content)
;; skip
(lambda (skip-content) (origami-scanner-consume end skip-content))
(lambda (new-content)
(lambda (state)
(cons new-content (cons (list (origami-content-consumed-count content)
(origami-content-consumed-count new-content))
state)))))))
;;; TODO: maybe scan and build up a simple list of (start end) values,
;;; in the next pass transform this in to the proper fold structure?
(origami-run-scanner
(origami-scanner-bind
(origami-scanner-return (origami-content 0 "{}"))
(origami-pair-scanner "{" "}" nil))
'foo) ;=> ((2 . "") . foo)
;;; commands ;;; commands