mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 14:30:34 +02:00
Code Activity

peg: more syntax helper cleanup

Browse source 
* module/ice-9/peg.scm (single-filter, push-not-null!): Use
  syntax-rules, and move outside the eval-when.
This commit is contained in:
Andy Wingo 2011-02-17 14:06:08 +01:00
parent bb7ff21a77
commit a907bce657
1 changed files with 16 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -48,7 +48,7 @@
(syntax-rules ()
((_ test stmt stmt* ...)
(let lp ()
(or action
(or test
(begin stmt stmt* ... (lp)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -70,6 +70,21 @@
((_ lst obj)
(set! lst (cons obj lst)))))
;; If SYM is a list of one element, return (car SYM), else return SYM.
(define-syntax single-filter
(syntax-rules ()
((_ exp)
(pmatch exp
((,elt) elt)
(,elts elts)))))
;; If OBJ is non-null, push it onto LST, otherwise do nothing.
(define-syntax push-not-null!
(syntax-rules ()
((_ lst obj)
(if (not (null? obj))
(push! lst obj)))))
(eval-when (compile load eval)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -213,20 +228,6 @@
(else (datum->syntax for-syntax
(error-val `(peg-sexp-compile-error-3 ,match ,accum))))))
;;;;; Convenience macros for making sure things come out in a readable form.
;; If SYM is a list of one element, return (car SYM), else return SYM.
(define-syntax single-filter
(lambda (x)
(syntax-case x ()
((_ sym)
#'(if (single? sym) (car sym) sym)))))
;; If OBJ is non-null, push it onto LST, otherwise do nothing.
(define-syntax push-not-null!
(lambda (x)
(syntax-case x ()
((_ lst obj)
#'(if (not (null? obj)) (push! lst obj))))))
;; Top-level function builder for AND. Reduces to a call to CG-AND-INT.
(define (cg-and for-syntax arglst accum)
#`(lambda (str strlen at)