mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
Issue #185 - Allow export of another lib's export
This commit is contained in:
Justin Ethier
parent
ff07229be1
commit
78c253e1c3
8 changed files with 94 additions and 44 deletions
|
|
@ -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
|
||||
|
||||
|
|
|
|||
17
cyclone.scm
17
cyclone.scm
|
|
@ -180,10 +180,17 @@
|
|||
(set! lib-pass-thru-exports
|
||||
(filter
|
||||
(lambda (e)
|
||||
(and
|
||||
(not (member e module-globals)) ;; Defined by this lib? Not a PT
|
||||
(assoc e imported-vars)) ;; PT must be imported
|
||||
)
|
||||
(let ((module-global? (member e module-globals))
|
||||
(imported-var? (assoc e imported-vars)))
|
||||
(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
|
||||
|
|
|
|||
|
|
@ -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!
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -90,7 +90,6 @@
|
|||
cell-get->cell
|
||||
expand
|
||||
expand-lambda-body
|
||||
let=>lambda
|
||||
isolate-globals
|
||||
has-global?
|
||||
global-vars
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
66
srfi/143.sld
66
srfi/143.sld
|
|
@ -14,42 +14,42 @@
|
|||
fx-greatest
|
||||
fx-least
|
||||
fixnum?
|
||||
fxzero? fxpositive? fxnegative? fxodd? fxeven?
|
||||
fx= fx< fx> fx<= fx>=
|
||||
fxmax fxmin
|
||||
fx+ fx- fx*
|
||||
fxabs fxsquare fxsqrt fxexpt
|
||||
fx+/carry
|
||||
fx-/carry
|
||||
fx*+/carry
|
||||
fxfloor/ fxfloor-quotient fxfloor-remainder
|
||||
fxceiling/ fxceiling-quotient fxceiling-remainder
|
||||
fxtruncate/ fxtruncate-quotient fxtruncate-remainder
|
||||
fxround/ fxround-quotient fxround-remainder
|
||||
fxeuclidean/ fxeuclidean-quotient fxeuclidean-remainder
|
||||
fxbalanced/ fxbalanced-quotient fxbalanced-remainder
|
||||
fxnot
|
||||
fxand fxior fxxor fxeqv
|
||||
fxnand fxnor
|
||||
fxandc1 fxandc2 fxorc1 fxorc2
|
||||
farithmetic-shift fxbit-count fxinteger-length
|
||||
;fxzero? fxpositive? fxnegative? fxodd? fxeven?
|
||||
;fx= fx< fx> fx<= fx>=
|
||||
;fxmax fxmin
|
||||
;fx+ fx- fx*
|
||||
;fxabs fxsquare fxsqrt fxexpt
|
||||
;fx+/carry
|
||||
;fx-/carry
|
||||
;fx*+/carry
|
||||
;fxfloor/ fxfloor-quotient fxfloor-remainder
|
||||
;fxceiling/ fxceiling-quotient fxceiling-remainder
|
||||
;fxtruncate/ fxtruncate-quotient fxtruncate-remainder
|
||||
;fxround/ fxround-quotient fxround-remainder
|
||||
;fxeuclidean/ fxeuclidean-quotient fxeuclidean-remainder
|
||||
;fxbalanced/ fxbalanced-quotient fxbalanced-remainder
|
||||
;fxnot
|
||||
;fxand fxior fxxor fxeqv
|
||||
;fxnand fxnor
|
||||
;fxandc1 fxandc2 fxorc1 fxorc2
|
||||
;farithmetic-shift fxbit-count fxinteger-length
|
||||
|
||||
fxif
|
||||
fxbit-set? fxcopy-bit fxbit-swap
|
||||
fxany-bit-set? fxevery-bit-set?
|
||||
fxfirst-set-bit
|
||||
;fxif
|
||||
;fxbit-set? fxcopy-bit fxbit-swap
|
||||
;fxany-bit-set? fxevery-bit-set?
|
||||
;fxfirst-set-bit
|
||||
|
||||
fxbit-field fxbit-field-any? fxbit-field-every?
|
||||
fxbit-field-clear fxbit-field-set
|
||||
fxbit-field-replace fbit-field-replace-same
|
||||
fxbit-field-rotate fxbit-field-reverse
|
||||
fxbit-field-append
|
||||
;fxbit-field fxbit-field-any? fxbit-field-every?
|
||||
;fxbit-field-clear fxbit-field-set
|
||||
;fxbit-field-replace fbit-field-replace-same
|
||||
;fxbit-field-rotate fxbit-field-reverse
|
||||
;fxbit-field-append
|
||||
|
||||
fixnum->list list->fixnum
|
||||
fixnum->vector vector->fixnum
|
||||
fxbits
|
||||
fxfold fxfor-each fxunfold
|
||||
fxlogical-shift
|
||||
;fixnum->list list->fixnum
|
||||
;fixnum->vector vector->fixnum
|
||||
;fxbits
|
||||
;fxfold fxfor-each fxunfold
|
||||
;fxlogical-shift
|
||||
)
|
||||
(begin
|
||||
(define (fx-width) 31)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue