From 069f65ef454be763ac011ec04ff4f1f317eb610a Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Thu, 3 Oct 2019 13:07:28 +0200
Subject: [PATCH] Extend export-identifier check

When finalizing a module, ensure that exported identififiers
do not refer to types, inline-procedures or constants.
---
 core.scm    |  6 +++++-
 modules.scm | 12 +++++++-----
 2 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/core.scm b/core.scm
index 9bb08b42..ae0faf6f 100644
--- a/core.scm
+++ b/core.scm
@@ -1040,7 +1040,11 @@
 						       (exit 1))
 						   (##sys#finalize-module 
                                                      (##sys#current-module)
-                                                     (map car foreign-variables)))
+                                                     (lambda (id)
+                                                       (and (not (assq id foreign-variables))
+                                                            (not (hash-table-ref inline-table id))
+                                                            (not (hash-table-ref constant-table id))
+                                                            (not (##sys#get id '##compiler#type-abbreviation))))))
 						 (let ((il (or (assq name import-libraries) all-import-libraries)))
 						   (when il
 						     (emit-import-lib name il)
diff --git a/modules.scm b/modules.scm
index aab5e6a5..e9abd786 100644
--- a/modules.scm
+++ b/modules.scm
@@ -446,8 +446,8 @@
 (define ##sys#finalize-module 
   (let ((display display)
 	(write-char write-char))
-    (lambda (mod #!optional (bad-exports '())) 
-      ;; bad-exports: any list of symbols which should be rejected as invalid
+    (lambda (mod #!optional (check-export (lambda _ #t)))
+      ;; check-export: returns #f if given identifier names a non-exportable object
       (let* ((explist (module-export-list mod))
 	     (name (module-name mod))
 	     (dlist (module-defined-list mod))
@@ -470,9 +470,11 @@
 		    (let* ((h (car xl))
 			   (id (if (symbol? h) h (car h))))
 		      (cond ((assq id sexports) (loop (cdr xl)))
-                            ((memq id bad-exports)
-                             (##sys#error "special identifier may not be exported"
-                                          id))
+                            ((not (check-export id))
+                             (set! missing #t)
+                             (##sys#warn "exported identifier does not refer to value or syntax binding"
+                                          id)
+                             (loop (cdr xl)))
                             (else 
                               (cons 
                                 (cons 
-- 
2.19.1