Commits

llibra committed 4f88cc3

Refactored with EMATCH-VALUES of fivepm.

Comments (0)

Files changed (4)

   (labels ((rec (stream1 index)
              (if (= index (length string))
                  (success nil stream1)
-                 (result-match
+                 (ematch-values
                      (funcall (specific-char (aref string index)) stream1)
                    ((t _ stream2 _ _)
                     (rec stream2 (1+ index)))
                    ((nil pos msgs)
                     (failure pos msgs))))))
     (lambda (stream)
-      (result-match (rec stream 0)
+      (ematch-values (rec stream 0)
         ((t _ stream pos msgs)
          (success string stream pos msgs))
         ((nil pos msgs)
 
 (defun bind (parser fn)
   (lambda (stream)
-    (result-match (funcall parser stream)
+    (ematch-values (funcall parser stream)
       ((t value1 stream1 _ msgs1)
-       (result-match (funcall (funcall fn value1) stream1)
+       (ematch-values (funcall (funcall fn value1) stream1)
          ((t value2 stream2 pos2 msgs2)
           (let ((msgs (if (eq stream1 stream2) (cons msgs1 msgs2) msgs2)))
             (success value2 stream2 pos2 msgs)))
       `(bind ,form (lambda (,var) ,@body))))
 
 (defmacro mlet* (bindings &body body)
-  (match bindings
+  (ematch bindings
     (() `(progn ,@body))
     ((cons (list var parser) rest)
      `(mlet1 ,var ,parser (mlet* ,rest ,@body)))))
 
 (defmacro seq/bind (&rest parsers)
   (flet ((<-p (<-) (string= <- "<-")))
-    (match parsers
+    (ematch parsers
       (() '(unit nil))
       ((guard (list (list _ <- parser)) (<-p <-)) parser)
       ((list parser) parser)
 
 (defun choice2 (parser1 parser2)
   (lambda (stream)
-    (result-match (funcall parser1 stream)
+    (ematch-values (funcall parser1 stream)
       ((t value stream pos msgs)
        (success value stream pos msgs))
       ((nil pos1 msgs1)
        (if (eq stream pos1)
-           (result-match (funcall parser2 pos1)
+           (ematch-values (funcall parser2 pos1)
              ((t value2 stream2 pos2 msgs2)
               (let ((msgs (if (eq pos1 stream2) (cons msgs1 msgs2) msgs2)))
                 (success value2 stream2 pos2 msgs)))
 
 (defun try (parser)
   (lambda (stream)
-    (result-match (funcall parser stream)
+    (ematch-values (funcall parser stream)
       ((t value stream pos msgs)
        (success value stream pos msgs))
       ((nil pos msgs)
 
 (defun expect (parser x)
   (lambda (stream0)
-    (result-match (funcall parser stream0)
+    (ematch-values (funcall parser stream0)
       ((t value stream pos msgs)
        (let ((msgs (if (eq stream0 stream) (list x) msgs)))
          (success value stream pos msgs)))
 ;; TODO: Treating a parser that accepts an empty string properly
 (defun many-common (accum-fn parser stream)
   (labels ((rec (stream0 accum)
-             (result-match (funcall parser stream0)
-               ((t value stream _ _)
+             (ematch-values (funcall parser stream0)
+               ((t value stream)
                 (rec stream (funcall accum-fn value accum)))
                ((nil pos msgs)
                 (if (eq stream0 pos)
 
 (defun many (parser)
   (lambda (stream)
-    (result-match (many-common #'cons parser stream)
+    (ematch-values (many-common #'cons parser stream)
       ((t value stream pos msgs)
        (success (nreverse value) stream pos msgs))
       ((nil pos msgs)
 
 (defun parse (parser input &key (parser-error-p t))
   (let ((stream (parser-stream input)))
-    (result-match (funcall parser stream)
-      ((t value _ _ _)
+    (ematch-values (funcall parser stream)
+      ((t value)
        (values value t))
       ((nil pos msgs)
        (if parser-error-p

src/packages.lisp

 (defpackage :aly.util
   (:use :cl)
   (:import-from :alexandria :with-gensyms)
-  (:import-from :5pm :match)
-  (:export :defalias :result-match :intersperse))
+  (:export :defalias :intersperse))
 
 (defpackage :aly.stream
   (:use :cl)
 (defpackage :aly.core
   (:use :cl :aly.util :aly.stream :aly.condition)
   (:import-from :alexandria :with-gensyms :flatten)
-  (:import-from :5pm :match :guard)
+  (:import-from :5pm :match :ematch :ematch-values :guard)
   (:export :success :failure :satisfy :unit :fail :bind :mlet1 :mlet* :seq :seq1
            :seqn :seq/bind :choice :try :expect :many :skip-many :eoi :parse))
 
 (defpackage :aly.char
   (:use :cl :aly.util :aly.core :aly.combinator)
   (:import-from :alexandria :curry :rcurry)
+  (:import-from :5pm :ematch-values)
   (:export :specific-char :specific-string :one-of :none-of :any-char :upper
            :lower :letter :alpha-num :digit :decimal-digit :hex-digit :oct-digit
            :newline :tab :whitespace :whitespaces))
        (setf (symbol-function ',name) ,function)
        ',name)))
 
-;;; TODO: Refactoring for speed
-(defmacro result-match (form &body clauses)
-  (with-gensyms (values)
-    `(let ((,values (multiple-value-list ,form)))
-       ;; The list is allocated in the heap for tail call optimization.
-       ;; But it will make this part slow.
-       ;(declare (dynamic-extent ,values))
-       (match ,values ,@(mapcar (lambda (x)
-                                  (cons (cons 'list (car x)) (cdr x)))
-                                clauses)))))
-
 (defun intersperse (item list &optional (last-item item))
   (labels ((rec (rest acc)
              (if rest
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.