Changeset 10712 in project


Ignore:
Timestamp:
05/05/08 20:20:23 (13 years ago)
Author:
felix winkelmann
Message:

various tests and improvements

Location:
chicken/branches/hygienic
Files:
30 edited

Legend:

Unmodified
Added
Removed

  • chicken/branches/hygienic/TODO

    r10658 r10712  
    55* test line-number retention over macro-expansion
    66
     7* syntax-error
     8** if ##sys#current-module is set, add name to error message
     9
     10* move module-tests into tests/ directory (add to runtests.sh)
     11
    712* modules
    8 ** implement for compiler
    9 *** hide unexported module definitions
     13** checks
     14*** exported id not defined
     15*** redefinition of imported id
     16*** multiple definition of export
     17** hide unexported module definitions
     18** support for re-exports of imported bindings
     19   fixup vexport/sexport lists
     20** support for "import-libraries"
     21*** write compiled module registration to extra file
     22*** declaration
     23    (emit-import-library [MODULE | (MODULE FILENAME) ...])
     24*** option
     25    -emit-import-library MODULE
     26** import specs
     27   (import SPEC)
     28   SPEC = MODULE
     29        | (hide SPEC ID1 ...)
     30        | (subset SPEC ID1 ...)
     31        | (rename SPEC (IDOLD1 IDNEW1) ...)
     32        | (prefix SPEC PREFIX)
    1033
    1134* update manual/NEWS
    … …  
    1538*** user defined ellipsis
    1639*** define-compiled-syntax
     40*** modules
    1741** ack synrules authors
    1842** removals
    19    run-time and compile-time situations for eval-when
    20    define-foreign-record
    21    define-foreign-enum
    22    define-record
    23    define-macro
     43*** run-time and compile-time situations for eval-when
     44*** syntax
     45    define-foreign-record
     46    define-foreign-enum
     47    define-record
     48    define-macro
     49*** compiler options
     50    -check-imports
     51    -emit-exports
     52    -import
    2453
    2554* csi

  • chicken/branches/hygienic/batch-driver.scm

    r10629 r10712  
    3737  non-foldable-standard-bindings foldable-standard-bindings non-foldable-extended-bindings foldable-extended-bindings
    3838  standard-bindings-that-never-return-false side-effect-free-standard-bindings-that-never-return-false
    39   compiler-cleanup-hook check-global-exports disabled-warnings check-global-imports
     39  compiler-cleanup-hook disabled-warnings
    4040  file-io-only undefine-shadowed-macros
    4141  unit-name insert-timer-checks used-units inline-max-size
    … …  
    6565  default-declarations units-used-by-default words-per-flonum default-debugging-declarations
    6666  default-profiling-declarations default-optimization-passes
    67   inline-max-size file-requirements use-import-table lookup-exports-file
     67  inline-max-size file-requirements
    6868  foreign-string-result-reserve parameter-limit eq-inline-operator optimizable-rest-argument-operators
    6969  membership-test-operators membership-unfold-limit valid-compiler-options valid-compiler-options-with-argument
    … …  
    215215    (when (memq 't debugging-chicken) (##sys#start-timer))
    216216    (when (memq 'b debugging-chicken) (set! time-breakdown #t))
    217     (and-let* ((xfile (memq 'emit-exports options)))
    218       (set! export-file-name (cadr xfile)) )
     217    (when (memq 'emit-exports options)
     218      (warning "deprecated compiler option: emit-exports") )
    219219    (when (memq 'raw options)
    220220      (set! explicit-use-flag #t)
    … …  
    223223    (when (memq 'no-lambda-info options)
    224224      (set! emit-closure-info #f) )
    225     (set! use-import-table (memq 'check-imports options))
    226     (let ((imps (collect-options 'import)))
    227       (when (pair? imps)
    228         (set! use-import-table #t)
    229         (for-each lookup-exports-file imps) ) )
     225    (when (memq 'check-imports options)
     226      (compiler-warning 'usage "deprecated compiler option: -check-imports"))
     227    (when (memq 'import options)
     228      (compiler-warning 'usage "deprecated compiler option: -import"))
    230229    (set! disabled-warnings (map string->symbol (collect-options 'disable-warning)))
    231230    (when (memq 'no-warnings options)
    … …  
    529528                   (let ([db (analyze 'opt node2 i progress)])
    530529                     (when first-analysis
    531                        (when use-import-table (check-global-imports db))
    532                        (check-global-exports db)
    533530                       (when (memq 'u debugging-chicken)
    534531                         (dump-undefined-globals db)) )
    … …  
    571568                              (when (and ##sys#warnings-enabled (> (- (cputime) start-time) funny-message-timeout))
    572569                                (display "(do not worry - still compiling...)\n") )
    573                               (when export-file-name
    574                                 (dump-exported-globals db export-file-name) )
    575570                              (when a-only (exit 0))
    576571                              (print-node "closure-converted" '|9| node3)

  • chicken/branches/hygienic/chicken-ffi-macros.scm

    r10532 r10712  
    173173                 (bad) ) )
    174174          (bad) )
    175       '(##sys#void) ) ) ) )
     175      '(##core#undefined) ) ) ) )

  • chicken/branches/hygienic/chicken-more-macros.scm

    r10557 r10712  
    157157                          ,@(map (lambda (id nt) `(##core#set! ,id ,nt))
    158158                                 ids new-tmps)
    159                           (##sys#void) )
     159                          (##core#undefined) )
    160160                (,%lambda () ,@body)
    161161                (,%lambda ()
    … …  
    164164                          ,@(map (lambda (id ot) `(##core#set! ,id ,ot))
    165165                                 ids old-tmps)
    166                           (##sys#void) ) ) ) ) )))
     166                          (##core#undefined) ) ) ) ) )))
    167167
    168168(##sys#extend-macro-environment
    … …  
    834834                            (if (memq sname vars)
    835835                                sname
    836                                 '(##sys#void) ) )
     836                                '(##core#undefined) ) )
    837837                          slotnames) ) )
    838838        (,%define (,pred ,x) (##sys#structure? ,x ',t))
    … …  
    10241024    (let ((head (cadr form))
    10251025          (body (cddr form)))
    1026       (let* ((body (if (null? body) '((##sys#void)) body))
     1026      (let* ((body (if (null? body) '((##core#undefined)) body))
    10271027             (name (if (pair? head) (car head) head))
    10281028             (body (if (pair? head)
    … …  
    10341034        (if ##sys#enable-runtime-macros
    10351035            `(,(r 'define) ,name ,body)
    1036             '(##sys#void)))))))
     1036            '(##core#undefined)))))))
    10371037
    10381038

  • chicken/branches/hygienic/chicken-setup.scm

    r10629 r10712  
    630630
    631631(define (write-info id files info)
    632   (let-values (((exports info) (fix-exports id info)))
    633632    (let ((info `((files ,@files)
    634                 ,@exports
    635633                ,@(or (and-let* (*repository-tree*
    636634                                 (a (assq id *repository-tree*))
    … …  
    645643                                (cut pp info))))
    646644        (unless *windows-shell* (run (chmod a+r ,(quotewrap setup-file))))
    647         write-setup-info))))
    648 
    649 (define (fix-exports id info)
    650   (let-values (((einfo oinfo) (partition (lambda (item) (eq? 'exports (car item))) info)))
    651     (let ((exports
    652            (if (pair? einfo)
    653                (append-map
    654                 (lambda (eitem)
    655                   (let loop ((exports (cdr eitem)))
    656                     (if (null? exports)
    657                         '()
    658                         (let ((x (car exports))
    659                               (rest (cdr exports)) )
    660                           (cond ((string? x) (append (read-file x) (loop rest)))
    661                                 ((symbol? x) (cons x (loop rest)))
    662                                 (else (error "invalid export item" x)) ) ) ) ) )
    663                 einfo)
    664                (and-let* ((f (file-exists? (make-pathname #f (->string id) "exports"))))
    665                  (read-file f) ) ) ) )
    666       (if exports
    667           (values `((exports ,@exports)) oinfo)
    668           (values '() oinfo) ) ) ) )
     645        write-setup-info)))
    669646
    670647(define (compute-builddir fpath)

  • chicken/branches/hygienic/compiler.scm

    r10657 r10712  
    6666; (data <tag1> <exp1> ...)
    6767; (post-process <string> ...)
    68 ; (emit-exports <string>)
    6968; (keep-shadowed-macros)
    7069; (import <symbol-or-string> ...)
    … …  
    119118; (##coresyntax <exp>)
    120119; (<exp> {<exp>})
    121 ; (define-syntax <symbol> <ewxo>)
    122 ; (define-compiled-syntax <symbol> <ewxo>)
     120; (define-syntax <symbol> <expr>)
     121; (define-compiled-syntax <symbol> <expr>)
     122; (##core#module <symbol> (<name> | (<name> ...) ...) <body>)
    123123;
    124124; - Core language:
    … …  
    266266  direct-call-ids foreign-type-table first-analysis callback-names disabled-warnings
    267267  initialize-compiler canonicalize-expression expand-foreign-lambda update-line-number-database! scan-toplevel-assignments
    268   compiler-warning import-table use-import-table compiler-macro-table compiler-macros-enabled
     268  compiler-warning compiler-macro-table compiler-macros-enabled
    269269  perform-cps-conversion analyze-expression simplifications perform-high-level-optimizations perform-pre-optimization!
    270270  reorganize-recursive-bindings substitution-table simplify-named-call inline-max-size
    … …  
    288288  make-random-name final-foreign-type real-name-table real-name set-real-name! safe-globals-flag
    289289  location-pointer-map literal-rewrite-hook
    290   lookup-exports-file undefine-shadowed-macros process-lambda-documentation emit-syntax-trace-info
     290  undefine-shadowed-macros process-lambda-documentation emit-syntax-trace-info
    291291  generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration
    292   process-custom-declaration do-lambda-lifting file-requirements emit-closure-info export-file-name
     292  process-custom-declaration do-lambda-lifting file-requirements emit-closure-info
    293293  foreign-argument-conversion foreign-result-conversion foreign-type-convert-argument foreign-type-convert-result
    294294  big-fixnum?)
    … …  
    324324(define-constant file-requirements-size 301)
    325325(define-constant real-name-table-size 997)
    326 (define-constant import-table-size 997)
    327326(define-constant default-inline-max-size 10)
    328327
    … …  
    363362(define inline-max-size -1)
    364363(define emit-closure-info #t)
    365 (define export-file-name #f)
    366 (define import-table #f)
    367 (define use-import-table #f)
    368364(define undefine-shadowed-macros #t)
    369365(define constant-declarations '())
    … …  
    441437      (vector-fill! file-requirements '())
    442438      (set! file-requirements (make-vector file-requirements-size '())) )
    443   (if import-table
    444       (vector-fill! import-table '())
    445       (set! import-table (make-vector import-table-size '())) )
    446439  (if foreign-type-table
    447440      (vector-fill! foreign-type-table '())
    … …  
    486479  (define (resolve-variable x0 se dest)
    487480    (let ((x (lookup x0 se)))
    488       (cond ((not (symbol? x)) x0)
     481      (cond ((not (symbol? x)) x0)      ; syntax?
    489482            [(and constants-used (##sys#hash-table-ref constant-table x))
    490483             => (lambda (val) (walk (car val) se dest)) ]
    … …  
    507500                     (finish-foreign-result ft body)
    508501                     t) ) ) ]
    509             [else (##sys#alias-global-hook x)])))
     502            ((not (assq x0 se)) (##sys#alias-global-hook x)) ; only globals
     503            (else x))))
    510504 
    511505  (define (eval/meta form)
    … …  
    597591                                                           id 'require-extension) #f)) ) ) )
    598592                                        (compiler-warning
    599                                          'ext "extension `~A' is currently not installed" id)
    600                                         (unless (and-let* (use-import-table
    601                                                            ((symbol? id))
    602                                                            (info (##sys#extension-information id #f))
    603                                                            (exps (assq 'exports info)) )
    604                                                   (for-each
    605                                                    (cut ##sys#hash-table-set! import-table <> id)
    606                                                    (cdr exps) )
    607                                                   #t)
    608                                           (lookup-exports-file id) ) )
     593                                         'ext "extension `~A' is currently not installed" id))
    609594                                    `(begin ,exp ,(loop (cdr ids))) ) ) ) )
    610595                          se dest) )
    … …  
    612597                        ((let)
    613598                         (##sys#check-syntax 'let x '(let #((variable _) 0) . #(_ 1)) #f se)
    614                          (let* ([bindings (cadr x)]
    615                                 [vars (unzip1 bindings)]
    616                                 [aliases (map gensym vars)]
     599                         (let* ((bindings (cadr x))
     600                                (vars (unzip1 bindings))
     601                                (aliases (map gensym vars))
    617602                                (se2 (append (map cons vars aliases) se)) )
    618603                           (set-real-names! aliases vars)
    … …  
    626611                        ((lambda ##core#internal-lambda)
    627612                         (##sys#check-syntax 'lambda x '(_ lambda-list . #(_ 1)) #f se)
    628                          (let ([llist (cadr x)]
    629                                [obody (cddr x)] )
     613                         (let ((llist (cadr x))
     614                               (obody (cddr x)) )
    630615                           (when (##sys#extended-lambda-list? llist)
    631616                             (set!-values
    … …  
    701686                       ((define-syntax)
    702687                        (##sys#check-syntax 'define-syntax x '(define-syntax variable _) #f se)
    703                         (##sys#extend-macro-environment
    704                          (lookup (cadr x) se)
    705                          (##sys#current-environment)
    706                          (##sys#er-transformer
    707                           (eval/meta (caddr x))))
    708                         (walk
    709                          (if ##sys#enable-runtime-macros
    710                              `(##sys#extend-macro-environment
    711                                ',(cadr x)
    712                                (##sys#current-environment)
    713                                (##sys#er-transformer
    714                                 ,(caddr x))) ;*** possibly wrong se?
    715                              '(##core#undefined) )
    716                          se dest))
     688                        (let ((name (lookup (cadr x) se))
     689                              (tx (caddr x)))
     690                          (##sys#extend-macro-environment
     691                           name
     692                           (##sys#current-environment)
     693                           (##sys#er-transformer (eval/meta tx)))
     694                          (##sys#register-export name (##sys#current-module) tx)
     695                          (walk
     696                           (if ##sys#enable-runtime-macros
     697                               `(##sys#extend-macro-environment
     698                                 ',(cadr x)
     699                                 (##sys#current-environment)
     700                                 (##sys#er-transformer
     701                                  ,tx)) ;*** possibly wrong se?
     702                               '(##core#undefined) )
     703                           se dest)) )
    717704
    718705                       ((define-compiled-syntax)
    719706                        (##sys#check-syntax 'define-compiled-syntax x '(_ variable _) #f se)
    720                         (##sys#extend-macro-environment
    721                          (lookup (cadr x) se)
    722                          (##sys#current-environment)
    723                          (##sys#er-transformer
    724                           (eval/meta (caddr x))))
    725                         (walk
    726                          `(##sys#extend-macro-environment
    727                            ',(cadr x)
     707                        (let ((name (lookup (cadr x) se))
     708                              (tx (caddr x)))
     709                          (##sys#extend-macro-environment
     710                           name
    728711                           (##sys#current-environment)
    729                            (##sys#er-transformer
    730                             ,(caddr x))) ;*** possibly wrong se?
    731                          se dest))
     712                           (##sys#er-transformer (eval/meta tx)))
     713                          (##sys#register-export name (##sys#current-module) tx)
     714                          (walk
     715                           `(##sys#extend-macro-environment
     716                             ',(cadr x)
     717                             (##sys#current-environment)
     718                             (##sys#er-transformer
     719                              ,tx)) ;*** possibly wrong se?
     720                           se dest)))
     721
     722                       ((##core#module)
     723                        (let* ((name (lookup (cadr x) se))
     724                               (exports
     725                                (map (lambda (exp)
     726                                       (cond ((symbol? exp) (lookup exp se))
     727                                             ((and (pair? exp) (symbol? (car exp)))
     728                                              (map (cut lookup <> se) exp) )
     729                                             (else
     730                                              (##sys#syntax-error-hook
     731                                               'module
     732                                               "invalid export syntax" exp name))))
     733                                     (caddr x)))
     734                               (me0 ##sys#macro-environment))
     735                          (when (pair? se)
     736                            (##sys#syntax-error-hook 'module "module definition not in toplevel scope"
     737                                                     name))
     738                          (let-values (((body mreg)
     739                                        (parameterize ((##sys#current-module
     740                                                        (##sys#register-module name exports) )
     741                                                       (##sys#import-environment '()))
     742                                          (fluid-let ((##sys#macro-environment ;*** make parameter later
     743                                                       ##sys#macro-environment))
     744                                            (let loop ((body (cdddr x)) (xs '()))
     745                                              (cond
     746                                               ((null? body)
     747                                                (##sys#finalize-module (##sys#current-module) me0)
     748                                                (values
     749                                                 (reverse xs)
     750                                                 (walk
     751                                                  (##sys#compiled-module-registration (##sys#current-module))
     752                                                  (##sys#current-meta-environment)
     753                                                  #f) ) )
     754                                               (else
     755                                                (loop
     756                                                 (cdr body)
     757                                                 (cons (walk (car body) se #f) xs)))))))))
     758                            (canonicalize-begin-body
     759                             (append (list mreg) body)))))
    732760
    733761                       ((##core#named-lambda)
    734762                        (walk `(,(macro-alias 'lambda se) ,@(cddr x)) se (cadr x)) )
    735763
    736                         ((##core#loop-lambda)
    737                          (let* ([vars (cadr x)]
    738                                 [obody (cddr x)]
    739                                 [aliases (map gensym vars)]
    740                                 (se2 (append (map cons vars aliases) se))
    741                                 [body
    742                                  (walk
    743                                   (##sys#canonicalize-body obody se2)
    744                                   se2 #f) ] )
    745                            (set-real-names! aliases vars)
    746                            `(lambda ,aliases ,body) ) )
     764                       ((##core#loop-lambda)
     765                        (let* ([vars (cadr x)]
     766                               [obody (cddr x)]
     767                               [aliases (map gensym vars)]
     768                               (se2 (append (map cons vars aliases) se))
     769                               [body
     770                                (walk
     771                                 (##sys#canonicalize-body obody se2)
     772                                 se2 #f) ] )
     773                          (set-real-names! aliases vars)
     774                          `(lambda ,aliases ,body) ) )
    747775
    748776                        ((set! ##core#set!)
    … …  
    11371165        (let ((us (cdr spec)))
    11381166          (apply register-feature! us)
    1139           (when use-import-table
    1140             (for-each lookup-exports-file us) )
    11411167          (when (pair? us)
    11421168            (##sys#hash-table-update! file-requirements 'uses (cut lset-union eq? us <>) (lambda () us))
    … …  
    12641290          (set! block-globals (lset-difference eq? block-globals syms))
    12651291          (set! export-list (lset-union eq? syms (or export-list '())))))
    1266        ((emit-exports)
    1267         (cond ((null? (cdr spec))
    1268                (quit "invalid `emit-exports' declaration" spec) )
    1269               ((not export-file-name)
    1270                (set! export-file-name (cadr spec))) ) )
    12711292       ((emit-external-prototypes-first)
    12721293        (set! external-protos-first #t) )
    … …  
    12891310              (set! constant-declarations (append syms constant-declarations))
    12901311              (quit "invalid arguments to `constant' declaration: ~S" spec)) ) )
    1291        ((import)
    1292         (let-values (((syms strs)
    1293                       (partition
    1294                        (lambda (x)
    1295                          (cond ((symbol? x) #t)
    1296                                ((string? x) #f)
    1297                                (else (quit "argument to `import' declaration is not a string or symbol" x)) ) )
    1298                        (cdr spec) ) ) )
    1299           (set! use-import-table #t)
    1300           (for-each
    1301            (cut ##sys#hash-table-set! import-table <> "<here>")
    1302            syms)
    1303           (for-each lookup-exports-file strs) ) )
    13041312       (else (compiler-warning 'syntax "illegal declaration specifier `~s'" spec)) )
    13051313     '(##core#undefined) ) ) )

  • chicken/branches/hygienic/csc.scm

    r10629 r10712  
    175175    -block -disable-interrupts -fixnum-arithmetic -to-stdout -profile -raw -accumulate-profile
    176176    -check-syntax -case-insensitive -benchmark-mode -shared -compile-syntax -no-lambda-info
    177     -lambda-lift -dynamic -disable-stack-overflow-checks -emit-debug-info -check-imports
     177    -lambda-lift -dynamic -disable-stack-overflow-checks -emit-debug-info
     178    -check-imports                      ; DEPRECATED
    178179    -emit-external-prototypes-first -inline -extension -release -static-extensions
    179180    -analyze-only -keep-shadowed-macros -disable-compiler-macros) )
    … …  
    182183  '(-debug -output-file -heap-size -nursery -stack-size -compiler -unit -uses -keyword-style
    183184    -optimize-level -include-path -database-size -extend -prelude -postlude -prologue -epilogue
    184     -inline-limit -profile-name -disable-warning -import -require-static-extension
    185     -feature -debug-level -heap-growth -heap-shrinkage -heap-initial-size -emit-exports
    186     -compress-literals) )               ; DEPRECATED
     185    -inline-limit -profile-name -disable-warning
     186    -import                             ; DEPRECATED
     187    -require-static-extension
     188    -feature -debug-level -heap-growth -heap-shrinkage -heap-initial-size
     189    -emit-exports -compress-literals) )         ; DEPRECATED
    187190
    188191(define-constant shortcuts
    … …  
    199202    (|-X| "-extend")
    200203    (|-N| "-no-usual-integrations")
    201     (|-G| "-check-imports")
     204    (|-G| "-check-imports")             ; DEPRECATED
    202205    (-x "-explicit-use")
    203206    (-u "-unsafe")
    … …  
    368371    -profile-name FILENAME      name of the generated profile information file
    369372    -emit-debug-info            emit additional debug-information
    370     -emit-exports FILENAME      write exported toplevel variables to FILENAME
    371     -G  -check-imports          look for undefined toplevel variables
    372     -import FILENAME            read externally exported symbols from FILENAME
    373373
    374374  Optimization options:

  • chicken/branches/hygienic/data-structures.scm

    r10624 r10712  
    7171
    7272(include "unsafe-declarations.scm")
    73 
    74 (cond-expand
    75  ((not unsafe)
    76   (declare (emit-exports "data-structures.exports")) )
    77  (else))
    7873
    7974(register-feature! 'data-structures)

  • chicken/branches/hygienic/distribution/manifest

    r10629 r10712  
    5454csi.c
    5555eval.c
    56 eval.exports
    5756data-structures.c
    58 data-structures.exports
    5957extras.c
    60 extras.exports
    6158library.c
    62 library.exports
    6359lolevel.c
    64 lolevel.exports
    6560optimizer.c
    6661regex.c
    67 regex.exports
    6862posixunix.c
    69 posix.exports
    7063posixwin.c
    7164profiler.c
    7265scheduler.c
    73 scheduler.exports
    7466srfi-69.c
    75 srfi-69.exports
    7667srfi-1.c
    77 srfi-1.exports
    7868srfi-13.c
    79 srfi-13.exports
    8069srfi-14.c
    81 srfi-14.exports
    8270srfi-18.c
    83 srfi-18.exports
    8471srfi-4.c
    85 srfi-4.exports
    8672stub.c
    8773support.c
    8874tcp.c
    89 tcp.exports
    9075ueval.c
    9176uextras.c
    … …  
    10489utcp.c
    10590utils.c
    106 utils.exports
    10791uutils.c
    10892build.scm

  • chicken/branches/hygienic/eval.scm

    r10658 r10712  
    9696
    9797(include "unsafe-declarations.scm")
    98 
    99 (cond-expand
    100  ((not unsafe) (declare (emit-exports "eval.exports")))
    101  (else))
    10298
    10399(define-foreign-variable install-egg-home c-string "C_INSTALL_EGG_HOME")
    … …  
    618614                         ((##core#module)
    619615                          (let* ((name (rename (cadr x) se))
    620                                 (exports
    621                                  (map (lambda (exp)
    622                                         (cond ((symbol? exp) (rename exp se))
    623                                               ((and (pair? exp) (symbol? (car exp)))
    624                                                (map (cut rename <> se) exp) )
     616                                 (exports
     617                                  (map (lambda (exp)
     618                                         (cond ((symbol? exp) (rename exp se))
     619                                               ((and (pair? exp) (symbol? (car exp)))
     620                                                (map (cut rename <> se) exp) )
    625621                                              (else
    626622                                               (##sys#syntax-error-hook
    627623                                                'module
    628624                                                "invalid export syntax" exp name))))
    629                                       (caddr x)))
    630                                 (me0 ##sys#macro-environment))
     625                                       (caddr x)))
     626                                 (me0 ##sys#macro-environment))
     627                            (when (pair? se)
     628                              (##sys#syntax-error-hook 'module "module definition not in toplevel scope"
     629                                                       name))
    631630                            (parameterize ((##sys#current-module
    632631                                            (##sys#register-module name exports) )
    … …  
    643642                                          (let loop2 ((xs xs))
    644643                                            (if (null? xs)
    645                                                 (##sys#void))
    646                                             (let ((n (##sys#slot xs 1)))
    647                                               (cond ((pair? n)
    648                                                     ((##sys#slot xs 0) v)
    649                                                     (loop2 n))
    650                                                     (else
    651                                                      ((##sys#slot xs 0) v)))))))
     644                                                (##sys#void)
     645                                                (let ((n (##sys#slot xs 1)))
     646                                                  (cond ((pair? n)
     647                                                        ((##sys#slot xs 0) v)
     648                                                        (loop2 n))
     649                                                        (else
     650                                                         ((##sys#slot xs 0) v))))))))
    652651                                      (loop
    653652                                       (cdr body)
    … …  
    11581157                       (memq id builtin-features/compiled)
    11591158                       (##sys#feature? id) ) )
    1160                (values '(##sys#void) #t) )
     1159               (values '(##core#undefined) #t) )
    11611160              ((memq id special-syntax-files)
    11621161               (let ((fid (##sys#->feature-id id)))
    … …  
    11641163                   (##sys#load (##sys#resolve-include-filename (##sys#symbol->string id) #t) #f #f)
    11651164                   (set! ##sys#features (cons fid ##sys#features)) )
    1166                  (values '(##sys#void) #t) ) )
     1165                 (values '(##core#undefined) #t) ) )
    11671166              ((memq id ##sys#core-library-modules)
    11681167               (values
    … …  
    12661265           (error "installed extension does not match required version" id vv (caddr spec)))
    12671266         id)
    1268        (syntax-error 'require-extension "invalid version specification" spec)) ) )
     1267       (##sys#syntax-error-hook 'require-extension "invalid version specification" spec)) ) )
    12691268
    12701269

  • chicken/branches/hygienic/expand.scm

    r10658 r10712  
    440440                                        (cons (if (pair? (cddr x))
    441441                                                  (caddr x)
    442                                                   '(##sys#void) )
     442                                                  '(##core#undefined) )
    443443                                              vals)
    444444                                        mvars mvals) ]
    … …  
    651651               (##sys#check-syntax 'define body '#(_ 0 1))
    652652               (##sys#register-export head (##sys#current-module))
    653                `(##core#set! ,head ,(if (pair? body) (car body) '(##sys#void))) )
     653               `(##core#set! ,head ,(if (pair? body) (car body) '(##core#undefined))) )
    654654              ((pair? (car head))
    655655               (##sys#check-syntax 'define head '(_ . lambda-list))
    … …  
    966966      (set! ##sys#macro-environment
    967967        (append (module-sexports mod) ##sys#macro-environment))
    968       '(##sys#void)))))
     968      '(##core#undefined)))))
    969969
    970970(##sys#extend-macro-environment
    … …  
    973973 (##sys#er-transformer
    974974  (lambda (x r c)
    975     (##sys#check-syntax 'module x '(_ symbol #(symbol 0) . #(_ 1)))
     975    (##sys#check-syntax 'module x '(_ symbol #(symbol 0) . #(_ 0)))
    976976    `(##core#module ,@(cdr x)))))
    977977
    … …  
    995995  (make-module name export-list defined-list vexports sexports)
    996996  module?
    997   (name module-name)
    998   (export-list module-export-list)
    999   (defined-list module-defined-list set-module-defined-list!)
    1000   (vexports module-vexports set-module-vexports!)
    1001   (sexports module-sexports set-module-sexports!) )
     997  (name module-name)                    ; SYMBOL
     998  (export-list module-export-list)      ; (SYMBOL | (SYMBOL ...) ...)
     999  (defined-list module-defined-list set-module-defined-list!) ; ((SYMBOL . VALUE) ...)
     1000  (vexports module-vexports set-module-vexports!)             ; (SYMBOL . SYMBOL)
     1001  (sexports module-sexports set-module-sexports!) )           ; ((SYMBOL SE TRANSFORMER) ...)
    10021002
    10031003(define (##sys#find-module name)
    … …  
    10051005        (else (error 'import "module not found" name))))
    10061006
    1007 (define (##sys#register-export sym mod)
     1007(define (##sys#register-export sym mod #!optional val)
    10081008  (when mod
    10091009    (when (##sys#find-export sym mod)
    10101010      (d "defined: " sym)
    1011       (set-module-defined-list! mod (cons sym (module-defined-list mod))))))
     1011      (set-module-defined-list!
     1012       mod
     1013       (cons (cons sym val)
     1014             (module-defined-list mod))))))
    10121015
    10131016(define (##sys#register-module name explist)
    … …  
    10151018    (set! ##sys#module-table (cons (cons name mod) ##sys#module-table))
    10161019    mod) )
     1020
     1021(define (##sys#compiled-module-registration mod)
     1022  (let ((dlist (module-defined-list mod)))
     1023    `(##sys#register-compiled-module
     1024      ',(module-name mod)
     1025      ',(module-vexports mod)
     1026      (list
     1027       ,@(map (lambda (sexport)
     1028                (let* ((name (car sexport))
     1029                       (a (assq name dlist)))
     1030                  (unless a
     1031                    (bomb "exported syntax has no source"))
     1032                  `(cons ',(car sexport) ,(cdr a))))
     1033              (module-sexports mod))))))
     1034
     1035(define (##sys#register-compiled-module name vexports sexports)
     1036  (let ((mod (make-module
     1037              name '() '() vexports
     1038              (map (lambda (se)
     1039                     (list (car se) '() (##sys#er-transformer (cdr se))))
     1040                   sexports))))
     1041    (set! ##sys#module-table (cons (cons name mod) ##sys#module-table))
     1042    mod))
    10171043
    10181044(define (##sys#find-export sym mod)
    … …  
    10441070    (for-each
    10451071     (lambda (x)
    1046        (unless (memq (car x) dlist)
     1072       (unless (assq (car x) dlist)
    10471073         (warning "exported identifier has not been defined" (car x))))
    10481074     vexports)
    1049     (d `(EXPORTS: ,(module-name mod) ,(module-defined-list mod)
     1075    (d `(EXPORTS: ,(module-name mod) ,(map car dlist)
    10501076                  ,(map car vexports) ,(map car sexports)))
    10511077    (set-module-vexports! mod vexports)

  • chicken/branches/hygienic/library.scm

    r10629 r10712  
    121121EOF
    122122) )
    123 
    124 (cond-expand
    125  ((not unsafe)
    126   (declare (emit-exports "library.exports")))
    127  (else) )
    128123
    129124(cond-expand

  • chicken/branches/hygienic/lolevel.scm

    r10629 r10712  
    6363
    6464(include "unsafe-declarations.scm")
    65 
    66 (cond-expand
    67  ((not unsafe)
    68   (declare (emit-exports "lolevel.exports")))
    69  (else))
    7065
    7166(register-feature! 'lolevel)

  • chicken/branches/hygienic/module-tests.scm

    r10658 r10712  
    22
    33
    4 (load "tests/test.scm")
     4(include "tests/test.scm")
    55
    66(test-begin "modules")
    … …  
    99(module foo (abc def)
    1010  (import scheme)
    11   (define (abc x)
    12     (display x)
    13     (newline)
    14     x)
     11  (define (abc x) (+ x 33))
    1512  (define-syntax def
    1613    (syntax-rules ()
    17       ((_ x)
    18        (begin
    19          (display "(def) ")
    20          (abc x)))))
     14      ((_ x) (+ 99 (abc x)))))
    2115  (abc 1))
    22 1)
     1634)
    2317
    2418(test-error "external/unimported variable (fail)" (abc 2))
    … …  
    2620
    2721(import foo)
    28 (test-equal "external/imported variable" (abc 4) 4)
    2922
    30 (test-equal "external/imported syntax" (def 5) 5)
     23(test-equal "external/imported variable" (abc 4) 37)
     24(test-equal "external/imported syntax" (def 5) 137)
    3125
    3226(test-end "modules")

  • chicken/branches/hygienic/posixunix.scm

    r10629 r10712  
    490490
    491491(include "unsafe-declarations.scm")
    492 
    493 (cond-expand
    494  ((not unsafe)
    495   (declare (emit-exports "posix.exports")) )
    496  (else))
    497492
    498493(register-feature! 'posix)

  • chicken/branches/hygienic/posixwin.scm

    r10629 r10712  
    926926
    927927(include "unsafe-declarations.scm")
    928 
    929 (cond-expand
    930  ((not unsafe)
    931   (declare (emit-exports "posix.exports")))
    932  (else))
    933928
    934929(register-feature! 'posix)

  • chicken/branches/hygienic/private-namespace.scm

    r10522 r10712  
    4343              (##sys#string->qualified-symbol prefix (symbol->string var))))
    4444           vars)
    45           '(##sys#void) ) ) ) ) )
     45          '(##core#undefined) ) ) ) ) )
    4646 (else
    4747  (define-macro (private . args)

  • chicken/branches/hygienic/regex.scm

    r10522 r10712  
    8181      ##sys#check-structure ##sys#check-symbol ##sys#check-blob ##sys#check-integer )
    8282    (export
    83       ##sys#check-chardef-table )
    84     (emit-exports "regex.exports") ) )
     83      ##sys#check-chardef-table )))
    8584 (else))
    8685

  • chicken/branches/hygienic/rules.make

    r10657 r10712  
    848848        $(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) LICENSE $(DESTDIR)$(IDOCDIR)
    849849        $(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) chicken-more-macros.scm $(DESTDIR)$(IDATADIR)
    850         $(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) *.exports $(DESTDIR)$(IDATADIR)
    851850        -$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) chicken.info $(DESTDIR)$(IINFODIR)
    852851        $(INSTALLINFO_PROGRAM) $(INSTALLINFO_PROGRAM_OPTIONS) --infodir=$(DESTDIR)$(IINFODIR) chicken.info
    … …  
    10371036          csc.c csi.c \
    10381037          chicken.c batch-driver.c compiler.c optimizer.c support.c \
    1039           c-platform.c c-backend.c *.exports
     1038          c-platform.c c-backend.c
    10401039
    10411040distclean: clean confclean

  • chicken/branches/hygienic/scheduler.scm

    r10439 r10712  
    3131  (disable-interrupts)
    3232  (usual-integrations)
    33   (emit-exports "scheduler.exports")
    3433  (disable-warning var)
    3534  (hide ##sys#ready-queue-head ##sys#ready-queue-tail ##sys#timeout-list

  • chicken/branches/hygienic/srfi-1.scm

    r10439 r10712  
    4242
    4343(include "unsafe-declarations.scm")
    44 
    45 (cond-expand
    46  ((not unsafe)
    47   (declare (emit-exports "srfi-1.exports")))
    48  (else))
    4944
    5045(register-feature! 'srfi-1)

  • chicken/branches/hygienic/srfi-13.scm

    r10522 r10712  
    4646
    4747(include "unsafe-declarations.scm")
    48 
    49 (cond-expand
    50  ((not unsafe)
    51   (declare (emit-exports "srfi-13.exports")))
    52  (else))
    5348
    5449(register-feature! 'srfi-13)

  • chicken/branches/hygienic/srfi-14.scm

    r10522 r10712  
    2525
    2626(include "unsafe-declarations.scm")
    27 
    28 (cond-expand
    29  ((not unsafe)
    30   (declare (emit-exports "srfi-14.exports")))
    31  (else))
    3227
    3328(register-feature! 'srfi-14)

  • chicken/branches/hygienic/srfi-18.scm

    r10439 r10712  
    5252
    5353(include "unsafe-declarations.scm")
    54 
    55 (cond-expand
    56  ((not unsafe)
    57   (declare (emit-exports "srfi-18.exports")))
    58  (else))
    5954
    6055(register-feature! 'srfi-18)

  • chicken/branches/hygienic/srfi-4.scm

    r10439 r10712  
    8282(include "unsafe-declarations.scm")
    8383
    84 (cond-expand
    85  ((not unsafe)
    86   (declare (emit-exports "srfi-4.exports")))
    87  (else))
    88 
    8984
    9085;;; Helper routines:

  • chicken/branches/hygienic/srfi-69.scm

    r10624 r10712  
    5656
    5757(include "unsafe-declarations.scm")
    58 
    59 (cond-expand
    60  ((not unsafe)
    61   (declare (emit-exports "srfi-69.exports")))
    62  (else))
    6358
    6459(register-feature! 'srfi-69)

  • chicken/branches/hygienic/support.scm

    r10522 r10712  
    3838  unit-name insert-timer-checks used-units source-filename pending-canonicalizations
    3939  foreign-declarations block-compilation line-number-database-size
    40   target-heap-size target-stack-size check-global-exports check-global-imports
     40  target-heap-size target-stack-size
    4141  default-default-target-heap-size default-default-target-stack-size verbose-mode original-program-size
    4242  current-program-size line-number-database-2 foreign-lambda-stubs immutable-constants foreign-variables
    … …  
    5454  debugging-chicken bomb check-signature posq stringify symbolify build-lambda-list
    5555  string->c-identifier c-ify-string words words->bytes check-and-open-input-file close-checked-input-file fold-inner
    56   constant? basic-literal? source-info->string import-table
     56  constant? basic-literal? source-info->string
    5757  collapsable-literal? immediate? canonicalize-begin-body extract-mutable-constants string->expr get get-all
    5858  put! collect! count! get-line get-line-2 find-lambda-container display-analysis-database varnode qnode
    … …  
    6565  foreign-string-result-reserve parameter-limit eq-inline-operator optimizable-rest-argument-operators
    6666  membership-test-operators membership-unfold-limit valid-compiler-options valid-compiler-options-with-argument
    67   default-optimization-iterations chop-separator chop-extension follow-without-loop dump-exported-globals
     67  default-optimization-iterations chop-separator chop-extension follow-without-loop
    6868  generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration
    6969  foreign-argument-conversion foreign-result-conversion final-foreign-type debugging export-list block-globals
    70   lookup-exports-file constant-declarations process-lambda-documentation big-fixnum?
    71   compiler-macro-table register-compiler-macro export-dump-hook export-import-hook
     70  constant-declarations process-lambda-documentation big-fixnum?
     71  compiler-macro-table register-compiler-macro export-dump-hook
    7272  make-random-name foreign-type-convert-result foreign-type-convert-argument process-custom-declaration)
    7373
    … …  
    8686(define (bomb . msg-and-args)
    8787  (if (pair? msg-and-args)
    88       (apply error (string-append "[internal compiler screwup] " (car msg-and-args)) (cdr msg-and-args))
    89       (error "[internal compiler screwup]") ) )
     88      (apply error (string-append "[internal compiler error] " (car msg-and-args)) (cdr msg-and-args))
     89      (error "[internal compiler error]") ) )
    9090
    9191(define (debugging mode msg . args)
    … …  
    759759;;; Some safety checks and database dumping:
    760760
    761 (define (export-dump-hook db file) (void))
    762 
    763 (define (dump-exported-globals db file)
    764   (unless block-compilation
    765     (with-output-to-file file
    766       (lambda ()
    767         (let ((exports '()))
    768           (##sys#hash-table-for-each
    769            (lambda (sym plist)
    770              (when (and (assq 'global plist)
    771                         (assq 'assigned plist)
    772                         (or (and export-list (memq sym export-list))
    773                             (not (memq sym block-globals)) ) )
    774                (set! exports (cons sym exports)) ) )
    775            db)
    776           (for-each
    777            (lambda (s)
    778              (write s)
    779              (newline) )
    780            (sort exports
    781                  (lambda (s1 s2)
    782                    (string<? (##sys#slot s1 1) (##sys#slot s2 1)))) )
    783           (export-dump-hook db file) ) ) ) ) )
    784 
    785761(define (dump-undefined-globals db)
    786762  (##sys#hash-table-for-each
    … …  
    803779      (for-each (cut compiler-warning 'var "exported global variable `~S' is not defined" <>) exps) ) ) )
    804780
    805 (define (check-global-imports db)
    806   (##sys#hash-table-for-each
    807    (lambda (sym plist)
    808      (let ((imp (##sys#hash-table-ref import-table sym))
    809            (refs (assq 'references plist))
    810            (assgn (assq 'assigned plist)) )
    811        (when (assq 'global plist)
    812          (cond (assgn
    813                 (when imp
    814                   (compiler-warning 'redef "redefinition of imported variable `~s' from `~s'" sym imp) ) )
    815                ((and (pair? refs) (not imp) (not (keyword? sym)))
    816                 (compiler-warning 'var "variable `~s' used but not imported" sym) ) ) ) ) )
    817    db) )
    818 
    819781(define (export-import-hook x id) (void))
    820 
    821 (define (lookup-exports-file id)
    822   (and-let* ((xfile (##sys#resolve-include-filename
    823                      (string-append (->string id) ".exports")
    824                      #t #t) )
    825              ((file-exists? xfile)) )
    826     (when verbose-mode
    827       (printf "loading exports file ~a ...~%" xfile) )
    828     (for-each
    829      (lambda (exp)
    830        (if (symbol? exp)
    831            (##sys#hash-table-set! import-table exp id)
    832            (export-import-hook exp id) ) )
    833      (read-file xfile)) ) )
    834782
    835783
    … …  
    12801228    -accumulate-profile         executable emits profiling information in append mode
    12811229    -no-lambda-info             omit additional procedure-information
    1282     -emit-exports FILENAME      write exported toplevel variables to FILENAME
    1283     -check-imports              look for undefined toplevel variables
    1284     -import FILENAME            read externally exported symbols from FILENAME
    12851230
    12861231  Optimization options:

  • chicken/branches/hygienic/synrules.scm

    r10370 r10712  
    9797  (define %tail (r 'tail))
    9898  (define %temp (r 'temp))
    99   (define %syntax-error (r 'syntax-error))
     99  (define %syntax-error '##sys#syntax-error-hook)
    100100
    101101  (define (make-transformer rules)
    … …  
    121121                                       0
    122122                                       (meta-variables pattern 0 '())))))
    123         (syntax-error "ill-formed syntax rule" rule)))
     123        (##sys#syntax-error-hook "ill-formed syntax rule" rule)))
    124124
    125125  ;; Generate code to test whether input expression matches pattern
    … …  
    226226                 (if (<= (cdr probe) dim)
    227227                     template
    228                      (syntax-error "template dimension error (too few ellipses?)"
    229                                    template))
     228                     (##sys#syntax-error-hook "template dimension error (too few ellipses?)"
     229                                              template))
    230230                 `(,%rename (##core#syntax ,template)))))
    231231          ((segment-template? template)
    … …  
    235235                   (free-meta-variables (car template) seg-dim env '())))
    236236             (if (null? vars)
    237                  (syntax-error "too many ellipses" template)
     237                 (##sys#syntax-error-hook "too many ellipses" template)
    238238                 (let* ((x (process-template (car template)
    239239                                             seg-dim
    … …  
    305305    (and (segment-template? pattern)
    306306         (or (null? (cddr pattern))
    307              (syntax-error "segment matching not implemented" pattern))))
     307             (##sys#syntax-error-hook "segment matching not implemented" pattern))))
    308308
    309309  (define (segment-template? pattern)

  • chicken/branches/hygienic/tcp.scm

    r10522 r10712  
    9090
    9191(register-feature! 'tcp)
    92 
    93 (cond-expand
    94  ((not unsafe)
    95   (declare (emit-exports "tcp.exports")))
    96  (else))
    9792
    9893(define-foreign-variable errno int "errno")

  • chicken/branches/hygienic/utils.scm

    r10629 r10712  
    5252
    5353(include "unsafe-declarations.scm")
    54 
    55 (cond-expand
    56  ((not unsafe)
    57   (declare (emit-exports "utils.exports")))
    58  (else))
    5954
    6055(register-feature! 'utils)
Note: See TracChangeset for help on using the changeset viewer.