Changeset 10986 in project


Ignore:
Timestamp:
06/07/08 15:26:29 (13 years ago)
Author:
felix winkelmann
Message:

indirect exports for compiled modules and import libs incomplete

Location:
chicken/branches/hygienic
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/hygienic/TODO

    r10984 r10986  
    33* bugs
    44** modules
    5 *** syntax-definitions do not close over imported macros
    6     could we fixup SEs of exported macros with imported macros?
    7 *** import-libraries
    8 **** iexported macros will always have empty static SEs
    9      breaks in last module-tests example (baz should have gna in SE)
    105*** code-duplication in compiler and evaluator for ##core#module
    116*** "scheme" module does not include some special forms ("define-syntax", etc.)
  • chicken/branches/hygienic/expand.scm

    r10984 r10986  
    3131  (hide match-expression
    3232        macro-alias module-indirect-exports
    33         d dd dm map-se
     33        d dd dm map-se merge-se
    3434        lookup) )
    3535
     
    114114(define (##sys#extend-macro-environment name se handler)
    115115  (let ((me (##sys#macro-environment)))
    116     (dd "extending: " name " SE: " (map-se se))
    117116    (cond ((lookup name me) =>
    118117           (lambda (a)
     
    11731172        module-export-list module-defined-list set-module-defined-list!
    11741173        module-import-forms set-module-import-forms!
     1174        module-exist-list set-module-exist-list!
    11751175        module-defined-syntax-list set-module-defined-syntax-list!))
    11761176
    11771177(define-record-type module
    1178   (make-module name export-list defined-list defined-syntax-list undefined-list
     1178  (make-module name export-list defined-list exist-list defined-syntax-list undefined-list
    11791179               import-forms vexports sexports)
    11801180  module?
    11811181  (name module-name)                    ; SYMBOL
    11821182  (export-list module-export-list)      ; (SYMBOL | (SYMBOL ...) ...)
    1183   (defined-list module-defined-list set-module-defined-list!) ; ((SYMBOL . VALUE) ...)
     1183  (defined-list module-defined-list set-module-defined-list!) ; ((SYMBOL . VALUE) ...)    - *exported* value definitions
     1184  (exist-list module-exist-list set-module-exist-list!)       ; (SYMBOL ...)    - only for checking refs to undef'd
    11841185  (defined-syntax-list module-defined-syntax-list set-module-defined-syntax-list!) ; ((SYMBOL . VALUE) ...)
    11851186  (undefined-list module-undefined-list set-module-undefined-list!) ; (SYMBOL ...)
     
    12041205      (when (memq sym ulist)
    12051206        (set-module-undefined-list! mod (##sys#delq sym ulist)))
     1207      (set-module-exist-list! mod (cons sym (module-exist-list mod)))
    12061208      (when exp
    12071209        (dm "defined: " sym)
     
    12351237
    12361238(define (##sys#register-module name explist #!optional (vexports '()) (sexports '()))
    1237   (let ((mod (make-module name explist '() '() '() '() vexports sexports)))
     1239  (let ((mod (make-module name explist '() '() '() '() '() vexports sexports)))
    12381240    (set! ##sys#module-table (cons (cons name mod) ##sys#module-table))
    12391241    mod) )
     
    12661268              (loop (cdr dlist))))
    12671269            (else (loop (cdr dlist)))))))
     1270
     1271(define (merge-se . ses)                ; later occurrences take precedence to earlier ones
     1272  (let ((se (apply append ses)))
     1273    (dm "merging " (length ses) " se's with total length of " (length se))
     1274    (let ((se2
     1275           (let loop ((se se))
     1276             (cond ((null? se) '())
     1277                   ((assq (caar se) (cdr se)) (loop (cdr se)))
     1278                   (else (cons (car se) (loop (cdr se))))))))
     1279      (dm "  merged has length " (length se2))
     1280      se2)))
    12681281
    12691282(define (##sys#compiled-module-registration mod)
     
    13031316               iexports))
    13041317         (mod (make-module
    1305                name '() '() '() '() '()
     1318               name '() '() '() '() '() '()
    13061319               vexports sexps))
    1307          (exports (append iexps vexports sexps (##sys#current-environment))))
     1320         (exports (merge-se
     1321                   (##sys#macro-environment)
     1322                   (##sys#current-environment)
     1323                   iexps vexports sexps)))
    13081324    (##sys#mark-imported-symbols iexps)
    13091325    (for-each
     
    13221338  (let* ((me (##sys#macro-environment))
    13231339         (mod (make-module
    1324               name '() '() '() '()'()
     1340              name '() '() '() '() '()'()
    13251341              (map (lambda (ve)
    13261342                     (if (symbol? ve)
     
    13511367         (name (module-name mod))
    13521368         (dlist (module-defined-list mod))
     1369         (elist (module-exist-list mod))
    13531370         (sdlist (map (lambda (sym) (assq sym (##sys#macro-environment)))
    13541371                      (module-defined-syntax-list mod)))
     
    13751392                              (##sys#module-rename id name))))
    13761393                       (loop (cdr xl)))))))))
    1377     (for-each
     1394    (for-each                           ;*** do we need this? it should only appear in dlist if exported
    13781395     (lambda (x)
    13791396       (unless (assq (car x) dlist)
     
    13821399    (for-each
    13831400     (lambda (u)
    1384        (unless (assq u dlist)
     1401       (unless (memq u elist)
    13851402         (##sys#warn
    13861403          (string-append
     
    13891406           "'"))))
    13901407     (module-undefined-list mod))
    1391     (let ((exports
    1392            (map (lambda (exp)
    1393                   (cond ((symbol? (cdr exp)) exp)
    1394                         ((assq (car exp) (##sys#macro-environment)))
    1395                         (else (##sys#error "(internal) indirect export not found" (car exp)))) )
    1396                 (module-indirect-exports mod))))
     1408    (let* ((exports
     1409            (map (lambda (exp)
     1410                   (cond ((symbol? (cdr exp)) exp)
     1411                         ((assq (car exp) (##sys#macro-environment)))
     1412                         (else (##sys#error "(internal) indirect export not found" (car exp)))) )
     1413                 (module-indirect-exports mod)))
     1414           (new-se (merge-se
     1415                    (##sys#macro-environment)
     1416                    (##sys#current-environment)
     1417                    exports)))
    13971418      (##sys#mark-imported-symbols exports)
    13981419      (for-each
    13991420       (lambda (m)
    1400          (let ((se (append exports (cadr m))))
     1421         (let ((se (merge-se (cadr m) new-se)))
    14011422           (dm `(FIXUP: ,(car m) ,@(map-se se)))
    14021423           (set-car! (cdr m) se)))
  • chicken/branches/hygienic/tests/module-tests.scm

    r10984 r10986  
    6767(test-equal "indirect imports" (run) '(gna 99))
    6868
    69 #| currently fails
    70 
    7169(module m1 ((s1 f1))
    7270  (import scheme chicken)
    73   (define (f1) (print "f1"))
     71  (define (f1) (print "f1") 'f1)
    7472  (define-syntax s1
    7573    (syntax-rules ()
     
    8886      ((_) (s2)))))
    8987
    90 (import m2)
    91 (s2)                                    ; fails
    92 ;(import m3)
    93 ;(s3)
    94 |#
     88(import m3)
     89(test-equal "chained indirect imports" (s3) 'f1)
    9590
    9691(test-end "modules")
Note: See TracChangeset for help on using the changeset viewer.