1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +02:00

peg; syntax helper cleanups

* module/ice-9/peg.scm (until, single?, push!): Move outside the
  eval-when.  Use syntax-rules, and single? is faster now.
This commit is contained in:
Andy Wingo 2011-02-17 13:49:28 +01:00
parent 3c8963de27
commit b5ebb8abad

View file

@ -35,10 +35,9 @@
peg:substring peg:substring
peg-record? peg-record?
keyword-flatten) keyword-flatten)
#:use-module (system base pmatch)
#:use-module (ice-9 pretty-print)) #:use-module (ice-9 pretty-print))
(eval-when (compile load eval)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; LOOPING CONSTRUCTS ;;;;; LOOPING CONSTRUCTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -50,7 +49,7 @@
((_ test stmt stmt* ...) ((_ test stmt stmt* ...)
(let lp () (let lp ()
(or action (or action
(begin stmt stmt* (lp))))))) (begin stmt stmt* ... (lp)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; GENERIC LIST-PROCESSING MACROS ;;;;; GENERIC LIST-PROCESSING MACROS
@ -59,17 +58,19 @@
;; Return #t if the list has only one element (calling length all the time on ;; Return #t if the list has only one element (calling length all the time on
;; potentially long lists was really slow). ;; potentially long lists was really slow).
(define-syntax single? (define-syntax single?
(lambda (x) (syntax-rules ()
(syntax-case x () ((_ x)
((_ lst) (pmatch x
#'(and (list? lst) (not (null? lst)) (null? (cdr lst))))))) ((_) #t)
(else #f)))))
;; Push an object onto a list. ;; Push an object onto a list.
(define-syntax push! (define-syntax push!
(lambda (x) (syntax-rules ()
(syntax-case x () ((_ lst obj)
((_ lst obj) (set! lst (cons obj lst)))))
#'(set! lst (cons obj lst))))))
(eval-when (compile load eval)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; CODE GENERATORS ;;;;; CODE GENERATORS