dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

eval-when tidying up

Browse source 
* module/ice-9/psyntax.scm: Rename expand-when-list to parse-when-list,
  and simplify to compare literal values.
* module/ice-9/psyntax-pp.scm: Regenerate.
This commit is contained in:
Andy Wingo 2011-11-16 20:15:26 +01:00
commit 440ac793c4
2 changed files with 6677 additions and 10701 deletions
Download patch file Download diff file Expand all files Collapse all files

17348
module/ice-9/psyntax-pp.scm
View file

File diff suppressed because it is too large Load diff

30
module/ice-9/psyntax.scm
View file

@ -908,7 +908,7 @@
((eval-when-form) ((eval-when-form)
(syntax-case e () (syntax-case e ()
((_ (x ...) e1 e2 ...) ((_ (x ...) e1 e2 ...)
(let ((when-list (expand-when-list e #'(x ...) w)) (let ((when-list (parse-when-list e #'(x ...)))
(body #'(e1 e2 ...))) (body #'(e1 e2 ...)))
(cond (cond
((eq? m 'e) ((eq? m 'e)
@ -1032,23 +1032,17 @@
(build-data no-source 'macro) (build-data no-source 'macro)
e))))) e)))))
(define expand-when-list (define parse-when-list
(lambda (e when-list w) (lambda (e when-list)
;; when-list is syntax'd version of list of situations ;; when-list is syntax'd version of list of situations
(let f ((when-list when-list) (situations '())) (let ((result (strip when-list empty-wrap)))
(if (null? when-list) (let lp ((l result))
situations (if (null? l)
(f (cdr when-list) result
(cons (let ((x (car when-list))) (if (memq (car l) '(compile load eval expand))
(cond (lp (cdr l))
((free-id=? x #'compile) 'compile) (syntax-violation 'eval-when "invalid situation" e
((free-id=? x #'load) 'load) (car l))))))))
((free-id=? x #'eval) 'eval)
((eq? (syntax->datum x) 'expand) 'expand)
(else (syntax-violation 'eval-when
"invalid situation"
e (wrap x w #f)))))
situations))))))
;; syntax-type returns six values: type, value, e, w, s, and mod. The ;; syntax-type returns six values: type, value, e, w, s, and mod. The
;; first two are described in the table below. ;; first two are described in the table below.
@ -1216,7 +1210,7 @@
((eval-when-form) ((eval-when-form)
(syntax-case e () (syntax-case e ()
((_ (x ...) e1 e2 ...) ((_ (x ...) e1 e2 ...)
(let ((when-list (expand-when-list e #'(x ...) w))) (let ((when-list (parse-when-list e #'(x ...))))
(if (memq 'eval when-list) (if (memq 'eval when-list)
(expand-sequence #'(e1 e2 ...) r w s mod) (expand-sequence #'(e1 e2 ...) r w s mod)
(expand-void)))))) (expand-void))))))