diff options
| author | Andy Wingo <wingo@pobox.com> | 2011-02-17 13:41:55 +0100 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2011-03-24 21:10:03 +0100 |
| commit | 82d621927d46c94009ad7b2700011e259e06eaf0 (patch) | |
| tree | 5f9929fdf46817940f117bbae6c59baa1b458c7c | |
| parent | 20329a71c87e905c1b988cebc529e88bc39e6c0c (diff) | |
| download | guile-82d621927d46c94009ad7b2700011e259e06eaf0.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)) |