diff options
| author | Andy Wingo <wingo@pobox.com> | 2011-02-17 13:41:55 +0100 |
|---|---|---|
| committer | Noah Lavine <noah.b.lavine@gmail.com> | 2012-01-20 08:26:40 -0500 |
| commit | 6d44373bbdb8886dd34920d085dd163a5c53d099 (patch) | |
| tree | f33d676454e0800ea7a5a1ce698cd7c316cfac7c | |
| parent | 2d68c6ae39d6daebca76959a64713b40aed2a943 (diff) | |
| download | guile-6d44373bbdb8886dd34920d085dd163a5c53d099.tar.gz | |
peg: cleanups
* module/ice-9/peg.scm (until): Rename from until-works, and be
functional (and faster).
(peg-match): Adapt.
| -rw-r--r-- | module/ice-9/peg.scm | 24 |
1 files changed, 10 insertions, 14 deletions
diff --git a/module/ice-9/peg.scm b/module/ice-9/peg.scm index fa7cb3e79..9419dd5c8 100644 --- a/module/ice-9/peg.scm +++ b/module/ice-9/peg.scm @@ -45,15 +45,12 @@ ;; Perform ACTION. If it succeeded, return its return value. If it failed, run ;; IF_FAILS and try again -(define-syntax until-works - (lambda (x) - (syntax-case x () - ((_ action if-fails) - #'(let ((retval action)) - (while (not retval) - if-fails - (set! retval action)) - retval))))) +(define-syntax until + (syntax-rules () + ((_ test stmt stmt* ...) + (let lp () + (or action + (begin stmt stmt* (lp))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;; GENERIC LIST-PROCESSING MACROS @@ -427,11 +424,10 @@ #`(let ((string (string-copy string-uncopied)) (strlen (string-length string-uncopied)) (at 0)) - (let ((ret ((@@ (ice-9 peg) until-works) - (or (>= at strlen) - (#,peg-sexp-compile - string strlen at)) - (set! at (+ at 1))))) + (let ((ret (until (or (>= at strlen) + (#,peg-sexp-compile + string strlen at)) + (set! at (+ at 1))))) (if (eq? ret #t) ;; (>= at strlen) succeeded #f (let ((end (car ret)) |