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

psyntax support for with-fluids

Browse source 
* module/ice-9/psyntax.scm (build-dynlet, with-fluids): Use psyntax to
  recognize `with-fluids' as a core form, producing <dynlet> if we are
  compiling.
  (sc-expand): To spice up the mix, use with-fluids here in the
  implementation.

* module/ice-9/psyntax-pp.scm: Bootstrapped twice (!).

* module/ice-9/boot-9.scm: Remove with-fluids definition, it's in the
  core now.
This commit is contained in:
Andy Wingo 2010-02-18 22:11:57 +01:00
commit 6360c1d4c1
3 changed files with 6665 additions and 6556 deletions
Download patch file Download diff file Expand all files Collapse all files

18
module/ice-9/boot-9.scm
View file

@ -2904,24 +2904,6 @@ module '(ice-9 q) '(make-q q-length))}."
;;; {with-fluids}
;;;
;; with-fluids is a convenience wrapper for the builtin procedure
;; `with-fluids*'. The syntax is just like `let':
;;
;; (with-fluids ((fluid val)
;; ...)
;; body)
(defmacro with-fluids (bindings . body)
(let ((fluids (map car bindings))
(values (map cadr bindings)))
(if (and (= (length fluids) 1) (= (length values) 1))
`(with-fluid* ,(car fluids) ,(car values) (lambda () ,@body))
`(with-fluids* (list ,@fluids) (list ,@values)
(lambda () ,@body)))))
;;; {While}
;;;
;;; with `continue' and `break'.

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

File diff suppressed because it is too large Load diff

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

@ -358,6 +358,13 @@
`(if ,test-exp ,then-exp ,else-exp))
source)))))
(define build-dynlet
(lambda (source fluids vals body)
(case (fluid-ref *mode*)
((c) ((@ (language tree-il) make-dynlet) source fluids vals body))
(else (decorate-source `(with-fluids ,(map list fluids vals) ,body)
source)))))
(define build-lexical-reference
(lambda (type source name var)
(case (fluid-ref *mode*)
@ -2184,6 +2191,17 @@
(chi #'then r w mod)
(chi #'else r w mod))))))
(global-extend 'core 'with-fluids
(lambda (e r w s mod)
(syntax-case e ()
((_ ((fluid val) ...) b b* ...)
(build-dynlet
s
(map (lambda (x) (chi x r w mod)) #'(fluid ...))
(map (lambda (x) (chi x r w mod)) #'(val ...))
(chi-body #'(b b* ...)
(source-wrap e w s mod) r w mod))))))
(global-extend 'begin 'begin '())
(global-extend 'define 'define '())
@ -2372,10 +2390,9 @@
(esew (if (or (null? rest) (null? (cdr rest)))
'(eval)
(cadr rest))))
(with-fluid* *mode* m
(lambda ()
(chi-top x null-env top-wrap m esew
(cons 'hygiene (module-name (current-module))))))))))
(with-fluids ((*mode* m))
(chi-top x null-env top-wrap m esew
(cons 'hygiene (module-name (current-module)))))))))
(set! identifier?
(lambda (x)