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

peg: use quasisyntax instead of safe-bind

Browse source 
* module/ice-9/peg.scm (syntax-for-non-cache-case): Use quasisyntax
  instead of safe-bind.
This commit is contained in:
Noah Lavine 2011-01-29 13:30:48 -05:00 • committed by Andy Wingo
parent c011c0b6ef
commit bce6e5d3f2
1 changed files with 28 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -366,32 +366,38 @@
(define *cache-size* 512) (define *cache-size* 512)
(define (syntax-for-non-cache-case for-syntax matchf accumsym symsym) (define (syntax-for-non-cache-case for-syntax matchf accumsym symsym)
(datum->syntax for-syntax (safe-bind (let ((m-syn (datum->syntax for-syntax matchf))
(str strlen at res body) (a-syn (datum->syntax for-syntax accumsym))
`(lambda (,str ,strlen ,at) (s-syn (datum->syntax for-syntax symsym))
(let ((,res (,matchf ,str ,strlen ,at))) (str-syn (syntax str))
(strlen-syn (syntax strlen))
(at-syn (syntax at))
(res-syn (syntax res))
(body-syn (syntax body)))
#`(lambda (#,str-syn #,strlen-syn #,at-syn)
(let ((#,res-syn (#,m-syn #,str-syn #,strlen-syn #,at-syn)))
;; Try to match the nonterminal. ;; Try to match the nonterminal.
(if ,res (if #,res-syn
;; If we matched, do some post-processing to figure out ;; If we matched, do some post-processing to figure out
;; what data to propagate upward. ;; what data to propagate upward.
(let ((,at (car ,res)) (let ((#,at-syn (car #,res-syn))
(,body (cadr ,res))) (#,body-syn (cadr #,res-syn)))
,(cond #,(cond
((eq? accumsym 'name) ((eq? accumsym 'name)
`(list ,at ',symsym)) #`(list #,at-syn '#,s-syn))
((eq? accumsym 'all) ((eq? accumsym 'all)
`(list (car ,res) #`(list (car #,res-syn)
(cond (cond
((not (list? ,body)) ((not (list? #,body-syn))
(list ',symsym ,body)) (list '#,s-syn #,body-syn))
((null? ,body) ',symsym) ((null? #,body-syn) '#,s-syn)
((symbol? (car ,body)) ((symbol? (car #,body-syn))
(list ',symsym ,body)) (list '#,s-syn #,body-syn))
(#t (cons ',symsym ,body))))) (#t (cons '#,s-syn #,body-syn)))))
((eq? accumsym 'none) `(list (car ,res) '())) ((eq? accumsym 'none) #`(list (car #,res-syn) '()))
(#t (begin res)))) (#t #`(begin #,res-syn))))
;; If we didn't match, just return false. ;; If we didn't match, just return false.
#f)))))) #f)))))
;; Defines a new nonterminal symbol accumulating with ACCUM. ;; Defines a new nonterminal symbol accumulating with ACCUM.
(define-syntax define-nonterm (define-syntax define-nonterm