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:
parent
3c8963de27
commit
b5ebb8abad
1 changed files with 12 additions and 11 deletions
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue