[elpa] master a268b9f 08/60: Add more APIs

[Junpeng Qiu]

branch: master
commit a268b9ff21b8f32fe03a61a38e2458ac0ce83b6f
Author: Junpeng Qiu <address@hidden>
Commit: Junpeng Qiu <address@hidden>

    Add more APIs
---
 parsec.el |   90 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 81 insertions(+), 9 deletions(-)

diff --git a/parsec.el b/parsec.el
index 9f13e88..3075a21 100644
--- a/parsec.el
+++ b/parsec.el
@@ -30,6 +30,8 @@
   "Combinator parsing library for Emacs, similar to Haskell's Parsec"
   :group 'development)
 
+(defvar parsec-last-error-message nil)
+
 (defun parsec-eob-or-char-as-string ()
   (let ((c (char-after)))
     (if c
@@ -45,8 +47,12 @@
 
 (defalias 'parsec-msg-get 'cdr)
 
+(defsubst parsec-throw (msg)
+  (throw 'failed msg))
+
 (defun parsec-stop (&rest args)
-  (throw 'failed
+  (parsec-throw
+   (setq parsec-last-error-message
          (let ((msg (plist-get args :message))
                (expected (plist-get args :expected))
                (found (plist-get args :found)))
@@ -56,7 +62,7 @@
              (parsec-msg (if (stringp msg)
                              msg
                            (format "Found \"%s\" -> Expected \"%s\""
-                                   found expected)))))))
+                                   found expected))))))))
 
 (defun parsec-ch (ch &rest args)
   (let ((next-char (char-after)))
@@ -75,6 +81,23 @@
       (parsec-stop :expected (char-to-string ch)
                    :found (parsec-eob-or-char-as-string)))))
 
+(defun parsec-satisfy (pred)
+  (let ((next-char (char-after)))
+    (if (and (not (eobp))
+             (funcall pred next-char))
+        (prog1
+            (cond
+             ((memq :nil args) nil)
+             ((memq :beg args)
+              (point))
+             ((memq :end args)
+              (1+ (point)))
+             (t
+              (char-to-string ch)))
+          (forward-char 1))
+      (parsec-stop :expected (format "%s" pred)
+                   :found (parsec-eob-or-char-as-string)))))
+
 (defun parsec-eob ()
   (unless (eobp)
     (parsec-stop :expected "`eob'"
@@ -109,13 +132,29 @@
 (defsubst parsec-num (num &rest args)
   (parsec-re (regexp-quote (number-to-string num))))
 
+(defsubst parsec-letter ()
+  (parsec-re "[a-zA-Z]"))
+
+(defsubst parsec-digit ()
+  (parsec-re "[0-9]"))
+
 (defmacro parsec-or (&rest parsers)
   (let ((outer-sym (make-symbol "outer"))
-        (parser-sym (make-symbol "parser")))
-    `(cl-loop named ,outer-sym for ,parser-sym in ',parsers
-              finally (parsec-stop :message "None of the parsers succeeds") do
-              (parsec-try
-               (return-from ,outer-sym (eval ,parser-sym))))))
+        (parser-sym (make-symbol "parser"))
+        (msg-sym (make-symbol "msg"))
+        (error-sym (make-symbol "err")))
+    `(let (,msg-sym ,error-sym)
+       (cl-loop named ,outer-sym for ,parser-sym in ',parsers
+                finally (parsec-stop
+                         :message
+                         (if ,error-sym
+                             (mapconcat #'identity ,error-sym "\n")
+                           "None of the parsers succeeds"))
+                do
+                (parsec-try
+                 (cl-return-from ,outer-sym
+                   (parsec-propagate (,msg-sym (eval ,parser-sym))
+                     (add-to-list ',error-sym (parsec-msg-get ,msg-sym)))))))))
 
 (defalias 'parsec-and 'progn)
 
@@ -124,6 +163,25 @@
 (defmacro parsec-try (&rest forms)
   `(catch 'failed ,@forms))
 
+(defmacro parsec-save (&rest forms)
+  (let ((orig-pt-sym (make-symbol "orig-pt"))
+        (msg-sym (make-symbol "msg")))
+    `(let ((,orig-pt-sym (point))
+           ,msg-sym)
+       (parsec-propagate (,msg-sym (parsec-and ,@forms))
+         (goto-char ,orig-pt-sym)))))
+
+(defmacro parsec-propagate (parser-cons &rest body)
+  (declare (indent 1))
+  (let ((res-sym (car parser-cons)))
+    `(progn
+       (setq ,res-sym (parsec-try ,(cadr parser-cons)))
+       (if (parsec-msg-p ,res-sym)
+           (progn
+             ,@body
+             (parsec-throw ,res-sym))
+         ,res-sym))))
+
 (defmacro parsec-try-with-message (msg &rest forms)
   (declare (indent 1))
   (let ((res-sym (make-symbol "result")))
@@ -136,7 +194,7 @@
 
 (defmacro parsec-ensure-with-message (msg &rest forms)
   (declare (indent 1))
-  (let* ((error-sym (make-symbol "err")))
+  (let ((error-sym (make-symbol "err")))
     `(let (,error-sym)
        (if (parsec-msg-p (setq ,error-sym
                                (parsec-try-with-message ,msg ,@forms)))
@@ -148,7 +206,7 @@
 
 (defalias 'parsec-parse 'parsec-try)
 
-(defmacro parsec-until (parser &optional &key skip)
+(cl-defmacro parsec-until (parser &optional &key skip)
   `(catch 'done
      (while (not (eobp))
        (parsec-try
@@ -186,6 +244,12 @@
     (cons ,parser (parsec-many (parsec-and ,separator ,parser)))
     nil))
 
+(defmacro parsec-between (open close parser)
+  `(parsec-save
+    ,open
+    (parsec-return ,parser
+      ,close)))
+
 (defun parsec-just (x) (cons 'Just x))
 
 (defvar parsec-nothing 'Nothing)
@@ -204,5 +268,13 @@
            parsec-nothing
          (parsec-just ,res)))))
 
+(defmacro parsec-do-parse (input &rest parsers)
+  (declare (indent 1))
+  `(with-temp-buffer
+     (insert ,input)
+     (goto-char (point-min))
+     (parsec-try
+      ,@parsers)))
+
 (provide 'parsec)
 ;;; parsec.el ends here