Implement monadic parsing
This commit is contained in:
parent
5b97990a0d
commit
7bf9c22e47
98
origami.el
98
origami.el
@ -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
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user