mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +02:00
Code Activity

peg: cleanups

Browse source 
* module/ice-9/peg.scm (until): Rename from until-works, and be
  functional (and faster).
  (peg-match): Adapt.
This commit is contained in:
Andy Wingo 2011-02-17 13:41:55 +01:00
parent 0d2f21fc81
commit 3c8963de27
1 changed files with 10 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

24
module/ice-9/peg.scm
View file

@ -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))