Commits

Anonymous committed b354b67

Change `satisfies` semantics and signature; introduce `in`

Comments (0)

Files changed (2)

 (module comparse
 
 (parse 
- fail result item bind satisfies is char-seq maybe
+ fail result item bind
+ satisfies in is char-seq maybe
  sequence sequence*
  repeated zero-or-more one-or-more
  any-of all-of none-of none-of*
   (and-let* ((value (parser input)))
     ((proc (car value)) (cdr value))))
 
-(define (satisfies condition)
-  (if (char-set? condition)
-      (satisfies (lambda (c)
-                   (and (char? c)
-                        (char-set-contains? condition c))))
-      (bind item (lambda (x)
-                   (if (condition x)
-                       (result x)
-                       fail)))))
+(define (satisfies condition . args)
+  (bind item (lambda (x)
+               (if (apply condition x args)
+                   (result x)
+                   fail))))
+
+(define (args-list parser more-parsers)
+  (if (and (list? parser) (null? more-parsers))
+      parser
+      (cons parser more-parsers)))
+
+(define (in collection . items)
+  (if (and (null? items) (char-set? collection))
+      (satisfies
+       (lambda (c)
+         (and (char? c)
+              (char-set-contains? collection c))))
+      (satisfies memq (args-list collection items))))
 
 (define (is x)
-  (satisfies (lambda (y) (eq? x y))))
+  (satisfies eq? x))
 
 (define-syntax sequence*
   (syntax-rules ()
            (lambda (binding)
              (sequence* (more-bindings ...) body ...))))))
 
-(define (parser-list parser more-parsers)
-  (if (and (list? parser) (null? more-parsers))
-      parser
-      (cons parser more-parsers)))
-
 (define ((sequence parser . parsers) input)
-  (let loop ((parsers (parser-list parser parsers))
+  (let loop ((parsers (args-list parser parsers))
              (parts '())
              (input input))
     (if (null? parsers)
 
 ;; Allow (any-of (list parser ...)) alternatively?
 (define ((any-of parser . parsers) input)
-  (let loop ((parsers (parser-list parser parsers)))
+  (let loop ((parsers (args-list parser parsers)))
     (and (not (null? parsers))
          (or ((car parsers) input)
              (loop (cdr parsers))))))
 
 (define ((all-of parser . parsers) input)
-  (let loop ((parsers (parser-list parser parsers)))
+  (let loop ((parsers (args-list parser parsers)))
     (and-let* ((value ((car parsers) input)))
       (if (null? (cdr parsers))
           value
           (and value (loop (cdr parsers)))))))
 
 (define ((none-of parser . parsers) input)
-  (let loop ((parsers (parser-list parser parsers)))
+  (let loop ((parsers (args-list parser parsers)))
     (if (null? parsers)
         (cons #t input)
         (and (not ((car parsers) input))
              (loop (cdr parsers))))))
 
 (define (preceded-by parser . parsers)
-  (let loop ((parsers (parser-list parser parsers)))
+  (let loop ((parsers (args-list parser parsers)))
     (bind (car parsers)
           (lambda (value)
             (if (null? (cdr parsers))
 
 (define ((followed-by parser following . more-following) input)
   (and-let* ((value (parser input)))
-    (let loop ((following (parser-list following more-following))
+    (let loop ((following (args-list following more-following))
                (input (cdr value)))
       (if (null? following)
           value
     ((_ expect parser input)
      (test-parse expect (as-string parser) input))))
 
+(test-group "satisfies"
+  (test-parse 3 (satisfies odd?) '(3))
+  (test-parse #f (satisfies odd?) '(2))
+  (test-parse #\b (satisfies memq '(#\a #\b #\c)) "bcd"))
+
+(test-group "is"
+  (test-parse #\x (is #\x) "xyz")
+  (test-parse #f (is #\x) "ho"))
+
+(test-group "in"
+  (test-parse #\c (in (char-set #\a #\b #\c)) "c")
+  (test-parse 2 (in '(1 2 3)) '(2))
+  (test-parse #\b (in #\a #\b #\c) "bcd")
+  (test-parse #f (in '()) "hey"))
+
 (test-group "tests one-or-more / zero-or-more"
   (test-parse* "ooooo" (one-or-more (is #\o)) "ooooom")
   (test-parse* #f (one-or-more (is #\o)) "m")
     (test-parse #f not-xy "y")))
 
 (test-group "misc"
-  (test-parse* "aaba" (repeated (satisfies (char-set #\a #\b))) "aabac")
+  (test-parse* "aaba" (repeated (in #\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 (preceded-by (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* "b52" (zero-or-more (any-of (in char-set:digit) (is #\b))) "b52s")
 
   (test-parse #f (none-of (is #\b) (is #\a)) "a")
 
 
 (test-group "quoted string"
   (define (quoted-string #!key
-                         (delimiter (satisfies (char-set #\" #\')))
+                         (delimiter (in #\" #\'))
                          (escape (is #\\)))
     (let ((escaped-char (preceded-by escape item)))
-      (sequence* ((_ (zero-or-more (satisfies char-set:whitespace)))
+      (sequence* ((_ (zero-or-more (in char-set:whitespace)))
                   (actual-delimiter delimiter)
                   (chars (zero-or-more
                           (any-of escaped-char
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.