~ chicken-core (chicken-5) e25965cdd25e521a5622f9712b76843458e887f2
commit e25965cdd25e521a5622f9712b76843458e887f2
Author: megane <meganeka@gmail.com>
AuthorDate: Thu Oct 10 12:11:07 2019 +0300
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Sun Oct 20 09:23:17 2019 +1300
Print more information about why an identifier cannot be exported
After change:
Warning: Cannot export `a-type-alias' because it is a type abbreviation.
Warning: Cannot export `an-inline' because it is an inlined function.
Warning: Cannot export `a-constant' because it is a constant.
Warning: Cannot export `a-foreign' because it is a foreign variable.
Warning: Exported identifier `a-undefined' has not been defined.
When trying to compile this:
(module
mod
(a-type-alias an-inline a-constant a-foreign a-undefined)
(import scheme)
(cond-expand
(chicken-5 (import (chicken base) (chicken type)
(chicken foreign)))
(else (import chicken)))
(define-type a-type-alias fixnum)
(define-inline (an-inline) 1)
(define-constant a-constant 2)
(define-foreign-variable a-foreign int)
)
Signed-off-by: Evan Hanson <evhan@foldling.org>
diff --git a/core.scm b/core.scm
index 02c7c6b7..9f39bb30 100644
--- a/core.scm
+++ b/core.scm
@@ -1042,13 +1042,19 @@
;; avoid backtrace
(print-error-message ex (current-error-port))
(exit 1))
- (##sys#finalize-module
+ (##sys#finalize-module
(##sys#current-module)
(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))))))
+ (cond
+ ((assq id foreign-variables)
+ "a foreign variable")
+ ((hash-table-ref inline-table id)
+ "an inlined function")
+ ((hash-table-ref constant-table id)
+ "a constant")
+ ((##sys#get id '##compiler#type-abbreviation)
+ "a type abbreviation")
+ (else #f)))))
(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 1501ab04..de8c9f6c 100644
--- a/modules.scm
+++ b/modules.scm
@@ -446,8 +446,10 @@
(define ##sys#finalize-module
(let ((display display)
(write-char write-char))
- (lambda (mod #!optional (check-export (lambda _ #t)))
- ;; check-export: returns #f if given identifier names a non-exportable object
+ (lambda (mod #!optional (invalid-export (lambda _ #f)))
+ ;; invalid-export: Returns a string if given identifier names a
+ ;; non-exportable object. The string names the type (e.g. "an
+ ;; inline function"). Returns #f otherwise.
(let* ((explist (module-export-list mod))
(name (module-name mod))
(dlist (module-defined-list mod))
@@ -478,21 +480,26 @@
(if (and def (symbol? (cdr def)))
(cdr def)
(let ((a (assq id (##sys#current-environment))))
- (cond ((and a (symbol? (cdr a)))
+ (define (fail msg)
+ (##sys#warn msg)
+ (set! missing #t))
+ (define (id-string)
+ (string-append "`" (symbol->string id) "'"))
+ (cond ((and a (symbol? (cdr a)))
(dm "reexporting: " id " -> " (cdr a))
- (cdr a))
+ (cdr a))
+ (def (module-rename id name))
+ ((invalid-export id)
+ =>
+ (lambda (type)
+ (fail (string-append
+ "Cannot export " (id-string)
+ " because it is " type "."))))
((not def)
- (set! missing #t)
- (##sys#warn
- (string-append
- "exported identifier of module `"
- (symbol->string name)
- (if (check-export id)
- "' has not been defined"
- "' does not refer to value or syntax binding"))
- id)
- #f)
- (else (module-rename id name)))))))
+ (fail (string-append
+ "Exported identifier " (id-string)
+ " has not been defined.")))
+ (else (bomb "fail")))))))
(loop (cdr xl))))))))))
(for-each
(lambda (u)
Trap