>From e935bdeb78a02f791b612b28eb000dc4e4ebc6fb Mon Sep 17 00:00:00 2001
From: Evan Hanson <address@hidden>
Date: Sat, 28 Apr 2018 22:52:13 +0200
Subject: [PATCH 1/2] Add `current-module' helper macro to "chicken.module"

This special form returns the name of the module currently being
compiled (or evaluated) as a symbol.
---
 chicken-install.scm    | 4 +---
 expand.scm             | 8 ++++++++
 tests/module-tests.scm | 8 ++++++++
 3 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/chicken-install.scm b/chicken-install.scm
index b247a635..6df5ad67 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -929,7 +929,7 @@
 		  (sprintf "Failed to import from `~a'" file))
 	       (eval `(import-syntax ,(string->symbol module-name))))))
          files))
-      (print "generating database")
+      (print "generating database ...")
       (let ((db
              (sort
               (concatenate
@@ -938,14 +938,12 @@
                   (and-let* ((mod (cdr m))
                              (mname (##sys#module-name mod))
                              ((not (memq mname +internal-modules+))))
-                    (print* " " mname)
                     (let-values (((_ ve se) (##sys#module-exports mod)))
                       (append (map (lambda (se) (list (car se) 'syntax mname)) se)
                               (map (lambda (ve) (list (car ve) 'value mname)) ve)))))
                 ##sys#module-table))
               (lambda (e1 e2)
                 (string<? (symbol->string (car e1)) (symbol->string (car e2)))))))
-        (newline)
         (with-output-to-file dbfile
           (lambda ()
             (for-each (lambda (x) (write x) (newline)) db)))
diff --git a/expand.scm b/expand.scm
index d3fcdbbe..d0a7aca6 100644
--- a/expand.scm
+++ b/expand.scm
@@ -1184,6 +1184,14 @@
 		    (syntax-error-hook
 		     'define-interface "invalid exports" (caddr x))))))))))))
 
+(##sys#extend-macro-environment
+ 'current-module '()
+ (##sys#er-transformer
+  (lambda (x r c)
+    (##sys#check-syntax 'current-module x '(_))
+    (and-let* ((mod (##sys#current-module)))
+      `(##core#quote ,(##sys#module-name mod))))))
+
 ;; The chicken.module syntax environment
 (define ##sys#chicken.module-macro-environment (##sys#macro-environment))
 
diff --git a/tests/module-tests.scm b/tests/module-tests.scm
index 83f142d0..ec447e45 100644
--- a/tests/module-tests.scm
+++ b/tests/module-tests.scm
@@ -372,6 +372,14 @@
  "Internal getter returns same thing"
  3 (get-count))
 
+(test-assert
+ (not (current-module)))
+
+(test-assert
+ (module m33 ()
+   (import (scheme) (chicken module))
+   (eq? (current-module) 'm33)))
+
 (test-end "modules")
 
 (test-exit)
-- 
2.11.0