~ chicken-core (chicken-5) fdae78e16392632e7e043afe79939406494aeb27
commit fdae78e16392632e7e043afe79939406494aeb27
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Sun Jan 3 21:15:26 2016 +1300
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Tue Mar 8 22:52:32 2016 +1300
Trigger unit hook on module definition
diff --git a/core.scm b/core.scm
index 04a474b8..f521bfa1 100644
--- a/core.scm
+++ b/core.scm
@@ -952,7 +952,7 @@
(when (##sys#current-module)
(##sys#syntax-error-hook
'module "modules may not be nested" name))
- (let-values (((body mreg)
+ (let-values (((body module-registration)
(parameterize ((##sys#current-module
(##sys#register-module name unit-name exports))
(##sys#current-environment '())
@@ -981,18 +981,20 @@
(delete il import-libraries)))
(values
(reverse xs)
- '((##core#undefined)))))
+ `((##sys#unit-hook ',name)))))
((not enable-module-registration)
(values
(reverse xs)
- '((##core#undefined))))
+ '((##core#undefined)))) ; XXX correct?
(else
(values
(reverse xs)
- (if standalone-executable
- '()
+ `((##sys#unit-hook ',name)
+ .
+ ,(if standalone-executable
+ `()
(##sys#compiled-module-registration
- (##sys#current-module)))))))
+ (##sys#current-module))))))))
(else
(loop
(cdr body)
@@ -1014,7 +1016,7 @@
x
e ;?
(##sys#current-meta-environment) #f #f h ln) )
- mreg))
+ module-registration))
body))))
(do ((cs compiler-syntax (cdr cs)))
((eq? cs csyntax))
diff --git a/eval.scm b/eval.scm
index e0a53beb..21093b8e 100644
--- a/eval.scm
+++ b/eval.scm
@@ -680,6 +680,7 @@
(if (null? body)
(let ((xs (reverse xs)))
(##sys#finalize-module (##sys#current-module))
+ (##sys#unit-hook name)
(lambda (v)
(let loop2 ((xs xs))
(if (null? xs)
Trap