~ chicken-core (master) 14bf711c392bd414229d4c28a66cdf069a5cb529
commit 14bf711c392bd414229d4c28a66cdf069a5cb529
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Mar 3 19:34:17 2026 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Tue Mar 3 19:34:17 2026 +0100
implement missing 2nd part of "gruesome hack" for indirect imports
(was not migrated from r7rs egg)
reported by Peter McGoron
diff --git a/expand.scm b/expand.scm
index c39c9c04..31223547 100644
--- a/expand.scm
+++ b/expand.scm
@@ -1346,7 +1346,8 @@
(else (fail (car decls)))))
(let ((pd (parse-decls decls)))
`(##core#module ,real-name ,(if all #t `((,dummy)))
- ;; gruesome hack: we add a dummy export for adding indirect exports
+ ;; gruesome hack: we add a dummy export for adding indirect exports,
+ ;; see ##sys#register-export, which does the other half.
,@(if all
'()
`((##core#define-syntax ,dummy
diff --git a/modules.scm b/modules.scm
index b9fc3a37..2954ca19 100644
--- a/modules.scm
+++ b/modules.scm
@@ -203,22 +203,36 @@
(##sys#warn "redefinition of syntax binding" sym)))
(define (##sys#register-export sym mod)
+ (define (find-dummy dummy xl)
+ (cond ((null? xl) #f)
+ ((and (pair? (car xl)) (eq? dummy (caar xl))) (car xl))
+ (else (find-dummy dummy (cdr xl)))))
(when mod
- (let ((exp (or (eq? #t (module-export-list mod))
- (find-export sym mod #t)))
- (ulist (module-undefined-list mod)))
- (##sys#toplevel-definition-hook ; in compiler, hides unexported bindings
- sym (module-rename sym (module-name mod)) exp)
- (and-let* ((a (assq sym ulist)))
- (set-module-undefined-list! mod (delete a ulist eq?)))
- (check-for-redef sym (##sys#current-environment) (##sys#macro-environment))
- (set-module-exist-list! mod (cons sym (module-exist-list mod)))
- (when exp
- (dm "defined: " sym)
- (set-module-defined-list!
- mod
- (cons (cons sym #f)
- (module-defined-list mod)))))) )
+ (let ((el (module-export-list mod))
+ (name (module-name mod)))
+ ;; add any export to the list of indirect exports for the dummy symbol
+ ;; ("gruesome hack", part 2)
+ (and-let* ((dummy (##sys#get name '##r7rs#module)))
+ (unless (eq? sym dummy)
+ (cond ((memq sym el))
+ ((find-dummy dummy el) =>
+ (lambda (dummylist)
+ (set-cdr! dummylist (cons sym (cdr dummylist))))))))
+ (let ((exp (or (eq? #t el)
+ (find-export sym mod #t)))
+ (ulist (module-undefined-list mod)))
+ (##sys#toplevel-definition-hook ; in compiler, hides unexported bindings
+ sym (module-rename sym name) exp)
+ (and-let* ((a (assq sym ulist)))
+ (set-module-undefined-list! mod (delete a ulist eq?)))
+ (check-for-redef sym (##sys#current-environment) (##sys#macro-environment))
+ (set-module-exist-list! mod (cons sym (module-exist-list mod)))
+ (when exp
+ (dm "defined: " sym)
+ (set-module-defined-list!
+ mod
+ (cons (cons sym #f)
+ (module-defined-list mod)))))) ))
(define (##sys#register-syntax-export sym mod val)
(when mod
diff --git a/tests/r7rs-library-tests.scm b/tests/r7rs-library-tests.scm
index c575f085..0c401b9c 100644
--- a/tests/r7rs-library-tests.scm
+++ b/tests/r7rs-library-tests.scm
@@ -1,4 +1,5 @@
;; by Anton Idukov (included code was expanded too early)
+
(define-library (mod)
(export fx mx)
(import (scheme base))
@@ -6,3 +7,18 @@
(include "r7rs-library-tests-code.scm")
)
+
+;; reported by Peter McGoron, hack to handle arbitrary indirect exports was
+;; simply incomplete
+
+(define-library with-indirect-export
+ (import (scheme base))
+ (export bar)
+ (begin
+ (define baz 99)
+ (define-syntax bar
+ (syntax-rules ()
+ ((_) baz)))))
+
+(import with-indirect-export)
+(assert (= 99 (bar)))
Trap