Ticket #901: reexport-syntax-with-star-export-list.diff

File reexport-syntax-with-star-export-list.diff, 2.3 KB (added by felix winkelmann, 10 years ago)
  • expand.scm

    diff --git a/expand.scm b/expand.scm
    index 660d1fa..ce03c31 100644
    a b  
    4040
    4141(include "common-declarations.scm")
    4242
    43 (define-syntax d (syntax-rules () ((_ . _) (void))))
     43;(define-syntax d (syntax-rules () ((_ . _) (void))))
    4444
    4545(set! ##sys#features
    4646  (append '(#:hygienic-macros
  • modules.scm

    diff --git a/modules.scm b/modules.scm
    index 078da0d..40c935b 100644
    a b  
    170170           exps)
    171171          (set-module-sexports! mod (append sexps (module-sexports mod)))
    172172          (set-module-exist-list! mod (append el exps)))
    173         (set-module-export-list!
    174          mod (append xl exps)))))
     173        (set-module-export-list! mod (append xl exps)))))
    175174
    176175(define (##sys#toplevel-definition-hook sym mod exp val) #f)
    177176
     
    704703           (when reexp?
    705704             (unless cm
    706705               (##sys#syntax-error-hook loc "`reexport' only valid inside a module"))
    707 
    708              (if (eq? #t (module-export-list cm))
    709                  (begin
    710                    (set-module-exist-list!
    711                     cm
    712                     (append (module-exist-list cm)
    713                             (map car vsv)
    714                             (map car vss))))
    715                  (set-module-export-list!
    716                   cm
    717                   (append
    718                    (let ((xl (module-export-list cm) ))
    719                      (if (eq? #t xl) '() xl))
    720                    (map car vsv)
    721                    (map car vss))))
     706             (let ((el (module-export-list cm)))
     707               (cond ((eq? #t el)
     708                      (set-module-sexports! cm (append vss (module-sexports cm)))
     709                      (set-module-exist-list!
     710                       cm
     711                       (append (module-exist-list cm)
     712                               (map car vsv)
     713                               (map car vss))))
     714                     (else
     715                      (set-module-export-list!
     716                       cm
     717                       (append
     718                        (let ((xl (module-export-list cm) ))
     719                          (if (eq? #t xl) '() xl))
     720                        (map car vsv)
     721                        (map car vss))))))
    722722             (when (pair? prims)
    723723               (set-module-meta-expressions!
    724724                cm
  • tests/reexport-tests.scm

    diff --git a/tests/reexport-tests.scm b/tests/reexport-tests.scm
    index 892ad64..651ed47 100644
    a b  
    3636(module m3 ()
    3737  (import scheme big-chicken)
    3838  (pp (string-intersperse '("abc" "def" "ghi") "-")))
     39
     40;;; #901 - reexport with "*" export list
     41
     42(module
     43 m4
     44 (foo-m4)
     45 (import chicken scheme)
     46 (define-syntax foo-m4
     47   (ir-macro-transformer
     48    (lambda (e i c)
     49      ''1))))
     50
     51(module
     52 m5
     53 *                                      ; () works here
     54 (import chicken scheme)
     55 (reexport m4))
     56
     57(import m5)
     58(print (foo-m4))