mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00
Code Activity

refactor chi-top-sequence

Browse source 
* module/ice-9/psyntax.scm (chi-top-sequence): Refactor slightly.
* module/ice-9/psyntax-pp.scm: Regenerate.
This commit is contained in:
Andy Wingo 2011-10-28 12:14:00 +02:00
parent dd64fe65fd
commit 148dfc2409
2 changed files with 8926 additions and 8951 deletions
Download patch file Download diff file Expand all files Collapse all files

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

File diff suppressed because it is too large Load diff

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

@ -916,8 +916,8 @@
;; in reversed order ;; in reversed order
exps) exps)
(else (else
(call-with-values (scan
(lambda () (cdr body) r w s m esew mod
(call-with-values (call-with-values
(lambda () (lambda ()
(let ((e (car body))) (let ((e (car body)))
@ -950,7 +950,7 @@
(top-level-eval-hook (top-level-eval-hook
(chi-top-sequence body r w s 'e '(eval) mod) (chi-top-sequence body r w s 'e '(eval) mod)
mod)) mod))
(values exps)))) exps)))
((memq 'load when-list) ((memq 'load when-list)
(if (or (memq 'compile when-list) (if (or (memq 'compile when-list)
(memq 'expand when-list) (memq 'expand when-list)
@ -958,16 +958,16 @@
(scan body r w s 'c&e '(compile load) mod exps) (scan body r w s 'c&e '(compile load) mod exps)
(if (memq m '(c c&e)) (if (memq m '(c c&e))
(scan body r w s 'c '(load) mod exps) (scan body r w s 'c '(load) mod exps)
(values exps)))) exps)))
((or (memq 'compile when-list) ((or (memq 'compile when-list)
(memq 'expand when-list) (memq 'expand when-list)
(and (eq? m 'c&e) (memq 'eval when-list))) (and (eq? m 'c&e) (memq 'eval when-list)))
(top-level-eval-hook (top-level-eval-hook
(chi-top-sequence body r w s 'e '(eval) mod) (chi-top-sequence body r w s 'e '(eval) mod)
mod) mod)
(values exps)) exps)
(else (else
(values exps))))))) exps))))))
((define-syntax-form) ((define-syntax-form)
(let ((n (id-var-name value w)) (r (macros-only-env r))) (let ((n (id-var-name value w)) (r (macros-only-env r)))
(case m (case m
@ -976,22 +976,22 @@
(let ((e (chi-install-global n (chi e r w mod)))) (let ((e (chi-install-global n (chi e r w mod))))
(top-level-eval-hook e mod) (top-level-eval-hook e mod)
(if (memq 'load esew) (if (memq 'load esew)
(values (cons e exps)) (cons e exps)
(values exps)))
(if (memq 'load esew)
(values (cons (chi-install-global n (chi e r w mod))
exps)) exps))
(values exps)))) (if (memq 'load esew)
(cons (chi-install-global n (chi e r w mod))
exps)
exps)))
((c&e) ((c&e)
(let ((e (chi-install-global n (chi e r w mod)))) (let ((e (chi-install-global n (chi e r w mod))))
(top-level-eval-hook e mod) (top-level-eval-hook e mod)
(values (cons e exps)))) (cons e exps)))
(else (else
(if (memq 'eval esew) (if (memq 'eval esew)
(top-level-eval-hook (top-level-eval-hook
(chi-install-global n (chi e r w mod)) (chi-install-global n (chi e r w mod))
mod)) mod))
(values exps))))) exps))))
((define-form) ((define-form)
(let* ((n (id-var-name value w)) (let* ((n (id-var-name value w))
;; Lookup the name in the module of the define form. ;; Lookup the name in the module of the define form.
@ -1008,15 +1008,13 @@
(if (and (variable? old) (variable-bound? old)) (if (and (variable? old) (variable-bound? old))
(module-define! (current-module) n (variable-ref old)) (module-define! (current-module) n (variable-ref old))
(module-add! (current-module) n (make-undefined-variable))))) (module-add! (current-module) n (make-undefined-variable)))))
(values (cons (if (eq? m 'c&e)
(cons
(if (eq? m 'c&e)
(let ((x (build-global-definition s n (chi e r w mod)))) (let ((x (build-global-definition s n (chi e r w mod))))
(top-level-eval-hook x mod) (top-level-eval-hook x mod)
x) x)
(lambda () (lambda ()
(build-global-definition s n (chi e r w mod)))) (build-global-definition s n (chi e r w mod))))
exps))) exps))
((displaced-lexical) ((displaced-lexical)
(syntax-violation #f "identifier out of context" (syntax-violation #f "identifier out of context"
e (wrap value w mod))) e (wrap value w mod)))
@ -1024,20 +1022,14 @@
(syntax-violation #f "cannot define keyword at top level" (syntax-violation #f "cannot define keyword at top level"
e (wrap value w mod)))))) e (wrap value w mod))))))
(else (else
(values (cons (cons (if (eq? m 'c&e)
(if (eq? m 'c&e)
(let ((x (chi-expr type value e r w s mod))) (let ((x (chi-expr type value e r w s mod)))
(top-level-eval-hook x mod) (top-level-eval-hook x mod)
x) x)
(lambda () (lambda ()
(chi-expr type value e r w s mod))) (chi-expr type value e r w s mod)))
exps))))))) exps)))))))))
(lambda (exps) (let ((exps (scan body r w s m esew mod '())))
(scan (cdr body) r w s m esew mod exps))))))
(call-with-values (lambda ()
(scan body r w s m esew mod '()))
(lambda (exps)
(if (null? exps) (if (null? exps)
(build-void s) (build-void s)
(build-sequence (build-sequence
@ -1046,7 +1038,7 @@
(if (null? in) out (if (null? in) out
(let ((e (car in))) (let ((e (car in)))
(lp (cdr in) (lp (cdr in)
(cons (if (procedure? e) (e) e) out))))))))))) (cons (if (procedure? e) (e) e) out))))))))))
(define chi-install-global (define chi-install-global
(lambda (name e) (lambda (name e)