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: more cggl / cggr excisions

Browse source 
* module/ice-9/peg.scm (cg-peg-any): Don't use cggr.
  (cg-range): Don't use cggl or cggr.
This commit is contained in:
Andy Wingo 2011-02-18 11:10:17 +01:00
parent 102d022f53
commit e9722ec0aa
1 changed files with 18 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -159,21 +159,28 @@ return EXP."
(define (cg-peg-any for-syntax accum)
#`(lambda (str len pos)
(and (< pos len)
#,(cggr for-syntax accum
'cg-peg-any #`(substring str pos (+ pos 1))
#`(+ pos 1)))))
#,(case accum
((all) #`(list (1+ pos)
(list 'cg-peg-any (substring str pos (1+ pos)))))
((name) #`(list (1+ pos) 'cg-peg-any))
((body) #`(list (1+ pos) (substring str pos (1+ pos))))
((none) #`(list (1+ pos) '()))
(else (error "bad accum" accum))))))
;; 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)
(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))))
#`(lambda (str len pos)
(and (< pos len)
(let ((c (string-ref str pos)))
(and (char>=? c #,start)
(char<=? c #,end)
#,(case accum
((all) #`(list (1+ pos) (list 'cg-range (string c))))
((name) #`(list (1+ pos) 'cg-range))
((body) #`(list (1+ pos) (string c)))
((none) #`(list (1+ pos) '()))
(else (error "bad accum" accum))))))))
;; 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