mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-30 06:50:31 +02:00
peg: more syntax helper cleanup
* module/ice-9/peg.scm (single-filter, push-not-null!): Use syntax-rules, and move outside the eval-when.
This commit is contained in:
parent
bb7ff21a77
commit
a907bce657
1 changed files with 16 additions and 15 deletions
|
@ -48,7 +48,7 @@
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((_ test stmt stmt* ...)
|
((_ test stmt stmt* ...)
|
||||||
(let lp ()
|
(let lp ()
|
||||||
(or action
|
(or test
|
||||||
(begin stmt stmt* ... (lp)))))))
|
(begin stmt stmt* ... (lp)))))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
@ -70,6 +70,21 @@
|
||||||
((_ lst obj)
|
((_ lst obj)
|
||||||
(set! lst (cons obj lst)))))
|
(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)
|
(eval-when (compile load eval)
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
@ -213,20 +228,6 @@
|
||||||
(else (datum->syntax for-syntax
|
(else (datum->syntax for-syntax
|
||||||
(error-val `(peg-sexp-compile-error-3 ,match ,accum))))))
|
(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.
|
;; Top-level function builder for AND. Reduces to a call to CG-AND-INT.
|
||||||
(define (cg-and for-syntax arglst accum)
|
(define (cg-and for-syntax arglst accum)
|
||||||
#`(lambda (str strlen at)
|
#`(lambda (str strlen at)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue