mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-23 13:00:34 +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 (syntax-for-non-cache-case for-syntax matchf accumsym symsym)
(datum->syntax for-syntax (safe-bind
(str strlen at res body)
`(lambda (,str ,strlen ,at)
(let ((,res (,matchf ,str ,strlen ,at)))
(let ((m-syn (datum->syntax for-syntax matchf))
(a-syn (datum->syntax for-syntax accumsym))
(s-syn (datum->syntax for-syntax symsym))
(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.
(if ,res
(if #,res-syn
;; If we matched, do some post-processing to figure out
;; what data to propagate upward.
(let ((,at (car ,res))
(,body (cadr ,res)))
,(cond
((eq? accumsym 'name)
`(list ,at ',symsym))
((eq? accumsym 'all)
`(list (car ,res)
(cond
((not (list? ,body))
(list ',symsym ,body))
((null? ,body) ',symsym)
((symbol? (car ,body))
(list ',symsym ,body))
(#t (cons ',symsym ,body)))))
((eq? accumsym 'none) `(list (car ,res) '()))
(#t (begin res))))
(let ((#,at-syn (car #,res-syn))
(#,body-syn (cadr #,res-syn)))
#,(cond
((eq? accumsym 'name)
#`(list #,at-syn '#,s-syn))
((eq? accumsym 'all)
#`(list (car #,res-syn)
(cond
((not (list? #,body-syn))
(list '#,s-syn #,body-syn))
((null? #,body-syn) '#,s-syn)
((symbol? (car #,body-syn))
(list '#,s-syn #,body-syn))
(#t (cons '#,s-syn #,body-syn)))))
((eq? accumsym 'none) #`(list (car #,res-syn) '()))
(#t #`(begin #,res-syn))))
;; If we didn't match, just return false.
#f))))))
#f)))))
;; Defines a new nonterminal symbol accumulating with ACCUM.
(define-syntax define-nonterm