Commits

Moritz Heidkamp  committed 2f26542

new api

  • Participants
  • Parent commits 55c69c6

Comments (0)

Files changed (2)

File comparse.scm

 
 (parse 
  fail result item bind satisfies is char-seq maybe
- sequence sequence* repeated  zero-or-more one-or-more
- any-of none-of followed-by
+ sequence sequence*
+ repeatedly zero-or-more one-or-more
+ any-of none-of last-of followed-by
  as-string)
 
 (import chicken scheme)
            (lambda (binding)
              (sequence* (more-bindings ...) body ...))))))
 
+(define ((sequence parser . parsers) input)
+  (let loop ((parsers (cons parser parsers))
+             (parts '())
+             (input input))
+    (if (null? parsers)
+        (cons (reverse parts) input)
+        (and-let* ((value ((car parsers) input)))
+          (loop (cdr parsers)
+                (cons (car value) parts)
+                (cdr value))))))
+
 (define ((char-seq str) input)
   (let ((len (string-length str)))
     (let loop ((pos 0) (input input))
          (or ((car parsers) input)
              (loop (cdr parsers))))))
 
-(define (sequence parser . parsers)
+;; skipping-over, finally, preceded-by
+(define (last-of parser . parsers)
   (let loop ((parsers (cons parser parsers)))
     (bind (car parsers)
           (lambda (value)
               (y (zero-or-more parser)))
     (result (cons x y))))
 
-(define (repeated parser #!key (min 0) max)
+(define (repeatedly parser #!key (min 0) max)
   (let loop ((min min) (max max))
     (any-of (sequence* ((x parser)
                         (y (loop (- min 1)
   (any-of parser (result #f)))
 
 (define (as-string parser)
-  (sequence* ((chars parser))
-    (result (list->string chars))))
+  (sequence* ((parts parser))
+    (result (apply conc parts))))
 
 (define (->lazy-seq x)
   (cond ((lazy-seq? x) x)

File tests/run.scm

     ((_ expect parser input)
      (test-parse expect (as-string parser) input))))
 
-(test-parse* "aaba" (repeated (satisfies (char-set #\a #\b))) "aabac")
-(test-parse* "   " (repeated (is #\space) max: 3) "      ")
-(test-parse* "" (repeated (is #\f)) "x")
-(test-parse* #f (repeated (is #\a) min: 1) "b")
-(test-parse #\a (sequence (none-of (is #\b) (is #\c)) item) "a")
+(test-parse* "aaba" (repeatedly (satisfies (char-set #\a #\b))) "aabac")
+(test-parse* "   " (repeatedly (is #\space) max: 3) "      ")
+(test-parse* "" (repeatedly (is #\f)) "x")
+(test-parse* #f (repeatedly (is #\a) min: 1) "b")
+(test-parse #\a (last-of (none-of (is #\b) (is #\c)) item) "a")
 (test-parse* "b52" (zero-or-more (any-of (satisfies char-set:digit) (is #\b))) "b52s")
 
 (test-parse #f (none-of (is #\b) (is #\a)) "a")
 (define (quoted-string #!key
                        (delimiter (satisfies (char-set #\" #\')))
                        (escape (is #\\)))
-  (let ((escaped-char (sequence escape item)))
+  (let ((escaped-char (last-of escape item)))
     (sequence* ((_ (zero-or-more (satisfies char-set:whitespace)))
                 (actual-delimiter delimiter)
                 (chars (zero-or-more
                         (any-of escaped-char
-                                (sequence (none-of escape (is actual-delimiter))
-                                          item))))
+                                (last-of (none-of escape (is actual-delimiter))
+                                         item))))
                 (_ (is actual-delimiter)))
       (result (list->string chars)))))
 
   (test "ok\\" (parse singly-quoted-bang-string "'ok\\'"))
   (test-assert (not (parse singly-quoted-bang-string "\"check\""))))
 
-(let ((lol (sequence (followed-by item (char-seq "ol")) item)))
+(let ((lol (last-of (followed-by item (char-seq "ol")) item)))
   (test #\o (parse lol "lol"))
   (test #f  (parse lol "lxl")))
+
+
+(test-group "sequence"
+  (test-parse* "ab" (sequence (is #\a) (is #\b)) "abc"))
+
+;; (test-group "repeatedly"
+;;   (test-parse* "hohoho" (repeatedly (char-seq "ho")) "hohoho")
+;;   (test-parse* "ho    ho ho"
+;;                (repeatedly (sequence (char-seq "ho") (zero-or-more (is #\space))))
+;;                ""))