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 ;; Perform ACTION. If it succeeded, return its return value. If it failed, run
;; IF_FAILS and try again ;; IF_FAILS and try again
(define-syntax until-works (define-syntax until
(lambda (x) (syntax-rules ()
(syntax-case x () ((_ test stmt stmt* ...)
((_ action if-fails) (let lp ()
#'(let ((retval action)) (or action
(while (not retval) (begin stmt stmt* (lp)))))))
if-fails
(set! retval action))
retval)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; GENERIC LIST-PROCESSING MACROS ;;;;; GENERIC LIST-PROCESSING MACROS
@ -427,11 +424,10 @@
#`(let ((string (string-copy string-uncopied)) #`(let ((string (string-copy string-uncopied))
(strlen (string-length string-uncopied)) (strlen (string-length string-uncopied))
(at 0)) (at 0))
(let ((ret ((@@ (ice-9 peg) until-works) (let ((ret (until (or (>= at strlen)
(or (>= at strlen) (#,peg-sexp-compile
(#,peg-sexp-compile string strlen at))
string strlen at)) (set! at (+ at 1)))))
(set! at (+ at 1)))))
(if (eq? ret #t) ;; (>= at strlen) succeeded (if (eq? ret #t) ;; (>= at strlen) succeeded
#f #f
(let ((end (car ret)) (let ((end (car ret))