mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-21 20:20:24 +02:00
Code Activity

peg: lower datum->syntax in cg-range case

Browse source 
* module/ice-9/peg.scm (cg-range): Datum->syntax here...
  (peg-sexp-compile): ...instead of here.
This commit is contained in:
Noah Lavine 2011-01-30 16:10:07 -05:00 • committed by Andy Wingo
parent 6a297af101
commit 0b61da75fe
1 changed files with 13 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -184,15 +184,18 @@
;; Generates code for matching a range of characters between start and end.
;; E.g.: (cg-range syntax #\a #\z 'body)
(define (cg-range for-syntax start end accum)
(safe-bind
(str strlen at c)
(cggl for-syntax str strlen at
`(let ((,c (string-ref ,str ,at)))
(if (and
(char>=? ,c ,start)
(char<=? ,c ,end))
,(cggr for-syntax accum 'cg-range `(string ,c) `(+ ,at 1))
#f)))))
(let ((str (syntax str))
(strlen (syntax strlen))
(at (syntax at))
(c (syntax c)))
(datum->syntax for-syntax
(cggl for-syntax str strlen at
`(let ((,c (string-ref ,str ,at)))
(if (and
(char>=? ,c ,start)
(char<=? ,c ,end))
,(cggr for-syntax accum 'cg-range `(string ,c) `(+ ,at 1))
#f))))))
;; Filters the accum argument to peg-sexp-compile for buildings like string
;; literals (since we don't want to tag them with their name if we're doing an
@ -228,8 +231,7 @@
(error-val `(peg-sexp-compile-error-1 ,match ,accum))))
((eq? (car match) 'range) ;; range of characters (e.g. [a-z])
(datum->syntax for-syntax
(cg-range for-syntax (cadr match) (caddr match) (baf accum))))
(cg-range for-syntax (cadr match) (caddr match) (baf accum)))
((eq? (car match) 'ignore) ;; match but don't parse
(peg-sexp-compile for-syntax (cadr match) 'none))
((eq? (car match) 'capture) ;; parse