Issue #185 - Allow export of another lib's export

CHANGELOG.md

@@ -12,6 +12,8 @@ The specific requirement from R<sup>7</sup>RS is:
 
 - Normalize the result of `string->number` such that bignums are only returned if the result truly is a bignum.
 - Allow Cyclone to find `(cyclone)` prefixed libraries installed in Cyclone's system folder.
+- Allow a library to export identifiers that it does not define directly, but rather that are defined by libraries imported by the library being compiled.
+- Raise an error if an unknown identifier is found in a library's `export` list.
 
 Bug Fixes
 

cyclone.scm

@@ -180,10 +180,17 @@
       (set! lib-pass-thru-exports
         (filter
           (lambda (e)
-            (and
+            (let ((module-global? (member e module-globals))
-              (not (member e module-globals)) ;; Defined by this lib? Not a PT
+                  (imported-var? (assoc e imported-vars)))
-              (assoc e imported-vars)) ;; PT must be imported
+              (cond
-          )
+                ((eq? e 'call/cc) #f) ;; Special case
+                ((and (not module-global?)
+                      (not imported-var?))
+                 (error "Identifier is exported but not defined" e))
+                (else
+                  ;; Pass throughs are not defined in this module,
+                  ;; but by definition must be defined in an imported lib
+                  (and (not module-global?) imported-var?)))))
           lib-pass-thru-exports))
       (trace:info "pass thru exports:")
       (trace:info lib-pass-thru-exports)
@@ -292,7 +299,7 @@
       (mta:code-gen input-program 
                     program? 
                     lib-name 
-                    lib-exports 
+                    lib-pass-thru-exports
                     imported-vars
                     module-globals
                     c-headers

scheme/cyclone/array-list.sld

@@ -25,7 +25,8 @@
     (scheme base)
     (scheme case-lambda))
   (export
-    array-list array-list? 
+    ;array-list 
+    array-list? 
     array-list-delete!
     array-list-empty? 
     array-list-insert!

scheme/cyclone/cgen.sld

@@ -1127,10 +1127,25 @@
          "" 
          (lib:list->import-set import)))
 
+;; Identifier exported by another library
+(define (mangle-exported-ident import-db ident error?)
+  (let ((idb-entry (lib:idb:lookup import-db ident)))
+    (cond
+      ((not idb-entry)
+       (if error?
+           (error `(Unable to find a library importing ,ident))
+           #f))
+      (else
+       (let ((suffix (import->string 
+                       (lib:idb:entry->library-name idb-entry)))
+             (prefix (mangle-global 
+                       (lib:idb:entry->library-id idb-entry))))
+         (string-append prefix suffix))))))
+
 (define (mta:code-gen input-program 
                       program? 
                       lib-name 
-                      lib-exports 
+                      lib-pass-thru-exports
                       import-db
                       globals
                       c-headers
@@ -1145,7 +1160,8 @@
               (member ident globals))
          (mangle-global ident))
         ;; Identifier exported by the library being compiled
-        ((member ident globals)
+        ((or (member ident globals)
+             (member ident lib-pass-thru-exports))
          (let ((suffix (import->string lib-name))
                (prefix (mangle-global ident)))
            (string-append prefix suffix)))
@@ -1196,6 +1212,21 @@
           (emits (cgen:mangle-global (car global)))
           (emits " = NULL;\n"))
         *globals*)
+    ;; "Pass-through"'s - exports from this module
+    ;; that are actually defined by another.
+    (for-each
+        (lambda (global)
+          (emits "object ")
+          (emits (cgen:mangle-global global))
+          (emits " = NULL;\n")
+
+          (let ((extern (mangle-exported-ident import-db global #f)))
+            (cond
+              (extern
+                (emits "extern object ")
+                (emits extern)
+                (emits ";\n")))))
+        lib-pass-thru-exports)
     ;; Globals defined by another module
     (for-each
         (lambda (global)
@@ -1320,6 +1351,15 @@
              (set! pairs (cons pair-sym pairs))
           ))
           *globals*)
+        (for-each
+          (lambda (g)
+            (let ((idb-entry (lib:idb:lookup import-db g)))
+              (if idb-entry
+                  (emits* 
+                    (cgen:mangle-global g) " = " 
+                    (mangle-exported-ident import-db g #f)
+                    ";\n"))))
+          lib-pass-thru-exports)
         (let loop ((code '())
                    (ps pairs)
                    (cs (map (lambda (_) (mangle (gensym 'c))) pairs)))

scheme/cyclone/transforms.sld

@@ -90,7 +90,6 @@
     cell-get->cell 
     expand 
     expand-lambda-body
-    let=>lambda 
     isolate-globals 
     has-global? 
     global-vars 

srfi/1.sld

@@ -10,7 +10,7 @@
   (import (scheme base)
           (scheme cxr))
   (export
-    xcons tree-copy make-list list-tabulate cons* list-copy 
+    xcons #;tree-copy make-list list-tabulate cons* list-copy 
     proper-list? circular-list? dotted-list? not-pair? null-list? list=
     circular-list length+
     iota

srfi/143.sld

@@ -14,42 +14,42 @@
     fx-greatest
     fx-least
     fixnum?
-    fxzero? fxpositive? fxnegative? fxodd? fxeven?
+    ;fxzero? fxpositive? fxnegative? fxodd? fxeven?
-    fx= fx< fx> fx<= fx>=
+    ;fx= fx< fx> fx<= fx>=
-    fxmax fxmin
+    ;fxmax fxmin
-    fx+ fx- fx*
+    ;fx+ fx- fx*
-    fxabs fxsquare fxsqrt fxexpt
+    ;fxabs fxsquare fxsqrt fxexpt
-    fx+/carry
+    ;fx+/carry
-    fx-/carry
+    ;fx-/carry
-    fx*+/carry
+    ;fx*+/carry
-    fxfloor/ fxfloor-quotient fxfloor-remainder
+    ;fxfloor/ fxfloor-quotient fxfloor-remainder
-    fxceiling/ fxceiling-quotient fxceiling-remainder
+    ;fxceiling/ fxceiling-quotient fxceiling-remainder
-    fxtruncate/ fxtruncate-quotient fxtruncate-remainder
+    ;fxtruncate/ fxtruncate-quotient fxtruncate-remainder
-    fxround/ fxround-quotient fxround-remainder
+    ;fxround/ fxround-quotient fxround-remainder
-    fxeuclidean/ fxeuclidean-quotient fxeuclidean-remainder
+    ;fxeuclidean/ fxeuclidean-quotient fxeuclidean-remainder
-    fxbalanced/ fxbalanced-quotient fxbalanced-remainder
+    ;fxbalanced/ fxbalanced-quotient fxbalanced-remainder
-    fxnot
+    ;fxnot
-    fxand   fxior   fxxor   fxeqv
+    ;fxand   fxior   fxxor   fxeqv
-    fxnand  fxnor 
+    ;fxnand  fxnor 
-    fxandc1 fxandc2 fxorc1  fxorc2 
+    ;fxandc1 fxandc2 fxorc1  fxorc2 
-    farithmetic-shift fxbit-count fxinteger-length
+    ;farithmetic-shift fxbit-count fxinteger-length
 
-    fxif 
+    ;fxif 
-    fxbit-set? fxcopy-bit fxbit-swap
+    ;fxbit-set? fxcopy-bit fxbit-swap
-    fxany-bit-set? fxevery-bit-set?
+    ;fxany-bit-set? fxevery-bit-set?
-    fxfirst-set-bit
+    ;fxfirst-set-bit
 
-    fxbit-field fxbit-field-any? fxbit-field-every?
+    ;fxbit-field fxbit-field-any? fxbit-field-every?
-    fxbit-field-clear fxbit-field-set
+    ;fxbit-field-clear fxbit-field-set
-    fxbit-field-replace  fbit-field-replace-same
+    ;fxbit-field-replace  fbit-field-replace-same
-    fxbit-field-rotate fxbit-field-reverse
+    ;fxbit-field-rotate fxbit-field-reverse
-    fxbit-field-append
+    ;fxbit-field-append
 
-    fixnum->list list->fixnum
+    ;fixnum->list list->fixnum
-    fixnum->vector vector->fixnum
+    ;fixnum->vector vector->fixnum
-    fxbits
+    ;fxbits
-    fxfold fxfor-each fxunfold
+    ;fxfold fxfor-each fxunfold
-    fxlogical-shift
+    ;fxlogical-shift
   )
   (begin
     (define (fx-width) 31)

srfi/27.sld

@@ -14,7 +14,8 @@
           (scheme time))
   (export random-integer random-real default-random-source
           next-mrg32k3a ;; TODO: only here for testing
-          make-random-source random-source?
+          make-random-source 
+          ; random-source?
           random-source-state-ref random-source-state-set!
           random-source-randomize! random-source-pseudo-randomize!
           random-source-make-integers random-source-make-reals)