Changeset 12595 in project for chicken


Ignore:
Timestamp:
11/26/08 16:05:25 (12 years ago)
Author:
felix winkelmann
Message:
  • removed custom declarations
  • added "-update-db" option to chicken-install
  • chicken: "-quiet" is useless and DEPRECATED
  • added support for db file in repository (not used yet)
  • compiler warns if first form in module body is not an `import' form
Location:
chicken/trunk
Files:
12 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/TODO

    r12562 r12595  
    4949
    5050** compiler
    51 *** remove "custom-declare" + stuff?
    5251*** generate object-files in /tmp (or TMPDIR)?
    5352
  • chicken/trunk/batch-driver.scm

    r12340 r12595  
    132132        [dynamic (memq 'dynamic options)]
    133133        [dumpnodes #f]
    134         [quiet (memq 'quiet options)]
    135134        [start-time #f]
    136135        (upap #f)
     
    139138    (define (cputime) (##sys#fudge 6))
    140139
     140    (define (dribble fstr . args)
     141      (when verbose (printf "~?~%~!" fstr args)))
     142
    141143    (define (print-header mode dbgmode)
    142       (when verbose (printf "pass: ~a~%~!" mode))
     144      (dribble "pass: ~a" mode)
    143145      (and (memq dbgmode debugging-chicken)
    144146           (begin
     
    242244    (set! disabled-warnings (map string->symbol (collect-options 'disable-warning)))
    243245    (when (memq 'no-warnings options)
    244       (when verbose (printf "Warnings are disabled~%~!"))
     246      (dribble "Warnings are disabled")
    245247      (set! ##sys#warnings-enabled #f) )
    246248    (when (memq 'optimize-leaf-routines options) (set! optimize-leaf-routines #t))
     
    265267              (quit "invalid argument to `-inline-limit' option: `~A'" arg) ) ) ) )
    266268    (when (memq 'case-insensitive options)
    267       (when verbose (printf "Identifiers and symbols are case insensitive~%~!"))
     269      (dribble "Identifiers and symbols are case insensitive")
    268270      (register-feature! 'case-insensitive)
    269271      (case-sensitive #f) )
     
    300302    (set! ##sys#features (cons #:compiler-extension ##sys#features))
    301303    (let ([extends (collect-options 'extend)])
    302       (when verbose
    303         (printf "Loading compiler extensions...~%~!")
    304         (load-verbose #t) )
     304      (dribble "Loading compiler extensions...")
     305      (when verbose (load-verbose #t))
    305306      (for-each
    306307       (lambda (f) (load (##sys#resolve-include-filename f #f #t)))
     
    364365      (set! standard-bindings default-standard-bindings)
    365366      (set! extended-bindings default-extended-bindings) )
    366     (when verbose
    367       (printf "debugging info: ~A~%~!"
    368               (if emit-trace-info
    369                   "calltrace"
    370                   "none") ) )
     367    (dribble "debugging info: ~A"
     368             (if emit-trace-info
     369                 "calltrace"
     370                 "none") )
    371371    (when profile
    372372      (let ([acc (eq? 'accumulate-profile (car profile))])
     
    379379               '((set! ##sys#profile-append-mode #t))
    380380               '() ) ) )
    381         (when verbose
    382           (printf "Generating ~aprofile~%~!" (if acc "accumulated " "")) ) ) )
     381        (dribble "Generating ~aprofile" (if acc "accumulated " "")) ) )
     382
     383    (and-let* ((dbfile (file-exists? (make-pathname (repository-path) "db"))))
     384      (dribble "loading database ~a" dbfile)
     385      (for-each
     386       (lambda (e)
     387         (##sys#put!
     388          (car e) '##core#db
     389          (append (or (##sys#get (car e) '##core#db) '()) (cdr e))) )
     390       (read-file dbfile)))
    383391
    384392    (cond ((memq 'version options)
     
    391399           (newline) )
    392400          ((not filename)
    393            (unless quiet
    394              (print-version #t)
    395              (display "\nEnter \"chicken -help\" for information on how to use it.\n") ) )
     401           (print-version #t)
     402           (display "\nEnter \"chicken -help\" for information on how to use it.\n") )
    396403          (else
    397404
    398405           ;; Display header:
    399            (unless quiet
    400              (printf "compiling `~a' ...~%" filename) )
     406           (dribble "compiling `~a' ..." filename)
    401407           (set! source-filename filename)
    402408           (debugging 'r "options" options)
     
    417423             (let ([proc (user-read-pass)])
    418424               (cond [proc
    419                       (when verbose (printf "User read pass...~%~!"))
     425                      (dribble "User read pass...")
    420426                      (set! forms (proc prelude files postlude)) ]
    421427                     [else
     
    438444           (let ([proc (user-preprocessor-pass)])
    439445             (when proc
    440                (when verbose (printf "User preprocessing pass...~%~!"))
     446               (dribble "User preprocessing pass...")
    441447               (set! forms (map proc forms))))
    442448
     
    499505             (let ([proc (user-pass)])
    500506               (when proc
    501                  (when verbose (printf "User pass...~%~!"))
     507                 (dribble "User pass...")
    502508                 (begin-time)
    503509                 (set! exps (map proc exps))
     
    514520                                       #f #t))
    515521                               ((file-exists? ifile)))
    516                       (when verbose
    517                         (print "Loading inline file " ifile " ..."))
     522                      (dribble "Loading inline file ~a ..." ifile)
    518523                      (load-inline-file ifile)))
    519524                  (concatenate (map cdr req)))))
     
    525530                    [proc (user-pass-2)] )
    526531               (when proc
    527                  (when verbose (printf "Secondary user pass...~%"))
     532                 (dribble "Secondary user pass...")
    528533                 (begin-time)
    529534                 (set! first-analysis #f)
     
    603608                            (when inline-output-file
    604609                              (let ((f inline-output-file))
    605                                 (when verbose
    606                                   (printf "Generating global inline file `~a' ...~%" f))
     610                                (dribble "Generating global inline file `~a' ..." f)
    607611                                (emit-global-inline-file f db) ) )
    608612
     
    623627                                (begin-time)
    624628                                (let ((out (if outfile (open-output-file outfile) (current-output-port))) )
    625                                   (unless quiet
    626                                     (printf "generating `~A' ...~%" outfile) )
     629                                  (dribble "generating `~A' ..." outfile)
    627630                                  (generate-code literals lliterals lambdas out filename dynamic db)
    628631                                  (when outfile (close-output-port out)))
     
    630633                                (when (memq 't debugging-chicken) (##sys#display-times (##sys#stop-timer)))
    631634                                (compiler-cleanup-hook)
    632                                 (when verbose
    633                                   (printf "compilation finished.~%~!") ) ) ) ] ) ) ) ) ) ) ) ) ) ) )
     635                                (dribble "compilation finished.") ) ) ] ) ) ) ) ) ) ) ) ) ) )
  • chicken/trunk/c-platform.scm

    r12301 r12595  
    115115
    116116(define valid-compiler-options
    117   '(-help h help version verbose explicit-use quiet no-trace no-warnings unsafe block
     117  '(-help h help version verbose explicit-use
     118          quiet                         ; DEPRECATED
     119          no-trace no-warnings unsafe block
    118120    check-syntax to-stdout no-usual-integrations case-insensitive no-lambda-info
    119121    profile inline keep-shadowed-macros
  • chicken/trunk/chicken-install.scm

    r12359 r12595  
    293293        (remove-directory tmpdir))))
    294294
     295  (define (update-db files)
     296    (let* ((files (if (null? files)
     297                      (glob (make-pathname (repository-path) "*.import.*"))
     298                      files) )
     299           (dbfile (make-pathname (repository-path) "db")))
     300      (for-each
     301       (lambda (f)
     302         (let ((m (string-match ".*/([^/]+)\\.import\\.(scm|so)" f)))
     303           (eval `(import ,(string->symbol (cadr m))))))
     304       files)
     305      (print "generating database " dbfile)
     306      (let ((db
     307             (sort
     308              (append-map
     309               (lambda (m)
     310                 (let* ((mod (cdr m))
     311                        (mname (##sys#module-name mod)))
     312                   (print "  " mname)
     313                   (let-values (((_ ve se) (##sys#module-exports mod)))
     314                     (append
     315                      (map (lambda (se) (list (car se) 'syntax mname)) se)
     316                      (map (lambda (ve) (list (car ve) 'value mname)) ve)))))
     317               ##sys#module-table)
     318              (lambda (e1 e2)
     319                (string<? (symbol->string (car e1)) (symbol->string (car e2)))))))
     320        (with-output-to-file (make-pathname (repository-path) "db")
     321          (lambda ()
     322            (for-each (lambda (x) (write x) (newline)) db))))))
     323
    295324  (define (usage code)
    296325    (print #<<EOF
     
    312341       -password PASS           set password for transports that require this
    313342  -i   -init DIRECTORY          initialize empty alternative repository
     343  -u   -update-db [FILENAME ...]  update export database
    314344EOF
    315345);|
    316346    (exit code))
    317347
    318   (define *short-options* '(#\h #\k #\l #\t #\s #\p #\r #\n #\v #\i))
     348  (define *short-options* '(#\h #\k #\l #\t #\s #\p #\r #\n #\v #\i #\u))
    319349
    320350  (define (main args)
     
    375405                        (print (chicken-version))
    376406                        (exit 0))
     407                       ((or (string=? arg "-u") (string=? arg "-update-db"))
     408                        (update-db (cdr args))
     409                        (exit 0))
    377410                       ((or (string=? arg "-i") (string=? arg "-init"))
    378411                        (unless (pair? (cdr args)) (usage 1))
  • chicken/trunk/chicken.1

    r12301 r12595  
    355355
    356356.TP
    357 .B \-quiet
    358 Disables output of compile information.
    359 
    360 .TP
    361357.B \-release
    362358Print release number and exit.
  • chicken/trunk/compiler.scm

    r12398 r12595  
    5050; (c-options {<opt>})
    5151; (compile-syntax)
    52 ; (custom-declare (<tag> <name> <filename> <arg> ...) <string> ...)
    5352; (disable-interrupts)
    5453; (disable-warning <class> ...)
     
    276275  installation-home decompose-lambda-list external-to-pointer defconstant-bindings constant-declarations
    277276  copy-node! error-is-extended-binding toplevel-scope toplevel-lambda-id
    278   unit-name insert-timer-checks used-units external-variables require-imports-flag custom-declare-alist
     277  unit-name insert-timer-checks used-units external-variables require-imports-flag
    279278  profile-info-vector-name finish-foreign-result pending-canonicalizations
    280279  foreign-declarations emit-trace-info block-compilation line-number-database-size
     
    314313  undefine-shadowed-macros process-lambda-documentation emit-syntax-trace-info
    315314  generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration
    316   process-custom-declaration do-lambda-lifting file-requirements emit-closure-info
     315  do-lambda-lifting file-requirements emit-closure-info
    317316  foreign-argument-conversion foreign-result-conversion foreign-type-convert-argument foreign-type-convert-result
    318317  big-fixnum? import-libraries unlikely-variables)
     
    426425(define toplevel-scope #t)
    427426(define toplevel-lambda-id #f)
    428 (define custom-declare-alist '())
    429427(define csc-control-file #f)
    430428(define data-declarations '())
     
    839837                                                            (##sys#compiled-module-registration (##sys#current-module)))))))
    840838                                               (else
     839                                                (when (and (pair? body)
     840                                                           (null? xs)
     841                                                           (pair? (car body))
     842                                                           (symbol? (caar body))
     843                                                           (not (eq? 'import (or (lookup (caar body) se) (caar body)))))
     844                                                  (compiler-warning
     845                                                   'syntax
     846                                                   "module `~s' does not begin with `import' form - maybe unintended?"
     847                                                   name))
    841848                                                (loop
    842849                                                 (cdr body)
     
    13291336              (set! foreign-declarations (append foreign-declarations fds))
    13301337              (syntax-error "invalid declaration" spec) ) ) )
    1331        ((custom-declare)
    1332         (if (or (not (list? spec)) (not (list? (cadr spec))) (< (length (cadr spec)) 3))
    1333             (syntax-error "invalid declaration" spec)
    1334             (process-custom-declaration (cadr spec) (cddr spec)) ) )
    13351338       ((c-options)
    13361339        (emit-control-file-item `(c-options ,@(strip (cdr spec)))) )
  • chicken/trunk/csc.scm

    r12301 r12595  
    260260(define shared-library-files default-shared-library-files)
    261261
    262 (define translate-options '("-quiet"))
     262(define translate-options '())
    263263
    264264(define include-dir
     
    760760  (for-each
    761761   (lambda (f)
    762      (let ([cscf (pathname-replace-extension f "csc")])
    763        (when (and (file-exists? cscf)
    764                   (let ([x (with-input-from-file cscf read-line)])
    765                     (or (eof-object? x) (string=? "#%eof" x)) ) )
    766          ($delete-file cscf) )
    767        (let ([fc (pathname-replace-extension
    768                   (if (= 1 (length scheme-files))
    769                       target-filename
    770                       f)
    771                   (cond (cpp-mode "cpp")
    772                         (objc-mode "m")
    773                         (else "c") ) ) ] )
    774          (unless (zero?
    775                   ($system
    776                    (string-intersperse
    777                     (cons* translator (cleanup-filename f)
    778                            (append
    779                             (if to-stdout
    780                                 '("-to-stdout")
    781                                 `("-output-file" ,(cleanup-filename fc)) )
    782                             (if (or static static-libs static-extensions)
    783                                 (map (lambda (e) (conc "-uses " e)) required-extensions)
    784                                 '() )
    785                             (map quote-option (append translate-options translation-optimization-options)) ) )
    786                     " ") ) )
    787            (exit last-exit-code) )
    788          (set! c-files (append (list fc) c-files))
    789          (set! generated-c-files (append (list fc) generated-c-files))
    790          (when (file-exists? cscf)
    791            (with-input-from-file cscf
    792              (lambda ()
    793                (read-line)
    794                (for-each
    795                 (lambda (cmd)
    796                   (unless (list? cmd)
    797                     (error "invalid entry in csc control file" cmd))
    798                   (case (car cmd)
    799                     ((post-process)
    800                      (for-each $system (cdr cmd)))
    801                     ((c-options)
    802                      (set! compile-options (append compile-options (cdr cmd))))
    803                     ((link-options)
    804                      (set! link-options (append link-options (cdr cmd))))
    805                     (else (error "invalid entry in csc control file" cmd))))
    806                 (read-file) ) ) )
    807            ($delete-file cscf) ) ) ) )
     762     (let ([fc (pathname-replace-extension
     763                (if (= 1 (length scheme-files))
     764                    target-filename
     765                    f)
     766                (cond (cpp-mode "cpp")
     767                      (objc-mode "m")
     768                      (else "c") ) ) ] )
     769       (unless (zero?
     770                ($system
     771                 (string-intersperse
     772                  (cons* translator (cleanup-filename f)
     773                         (append
     774                          (if to-stdout
     775                              '("-to-stdout")
     776                              `("-output-file" ,(cleanup-filename fc)) )
     777                          (if (or static static-libs static-extensions)
     778                              (map (lambda (e) (conc "-uses " e)) required-extensions)
     779                              '() )
     780                          (map quote-option (append translate-options translation-optimization-options)) ) )
     781                  " ") ) )
     782         (exit last-exit-code) )
     783       (set! c-files (append (list fc) c-files))
     784       (set! generated-c-files (append (list fc) generated-c-files))))
    808785   scheme-files)
    809786  (unless keep-files (for-each $delete-file generated-scheme-files)) )
  • chicken/trunk/expand.scm

    r12562 r12595  
    12771277  (sexports module-sexports set-module-sexports!) )           ; ((SYMBOL SE TRANSFORMER) ...)
    12781278
     1279(define ##sys#module-name module-name)
     1280
     1281(define (##sys#module-exports m)
     1282  (values
     1283   (module-export-list m)
     1284   (module-vexports m)
     1285   (module-sexports m)))
     1286
    12791287(define (make-module name explist vexports sexports)
    12801288  (%make-module name explist '() '() '() '() '() '() '() vexports sexports))
  • chicken/trunk/extras.scm

    r12559 r12595  
    7676(register-feature! 'extras)
    7777
     78
    7879;;; Read expressions from file:
    7980
     
    9192          (slurp port)
    9293          (call-with-input-file port slurp) ) ) ) )
    93 
    9494
    9595
  • chicken/trunk/manual/Declarations

    r12301 r12595  
    5252
    5353Declares that the given identifiers are always bound to procedure values.
    54 
    55 
    56 === c-options
    57 
    58  [declaration specifier] (c-options STRING ...)
    59 
    60 Declares additional C/C++ compiler options that are to be passed to the subsequent compilation pass
    61 that translates C to machine code. This declaration will only work if the source file is compiled
    62 with the {{csc}} compiler driver.
    6354
    6455
     
    188179
    189180
    190 === link-options
    191 
    192  [declaration specifier] (link-options STRING ...)
    193 
    194 Declares additional linker compiler options that are to be passed to the subsequent compilation pass
    195 that links the generated code into an executable or library.
    196 This declaration will only work if the source file is compiled
    197 with the {{csc}} compiler driver.
    198 
    199 
    200181=== local
    201182
  • chicken/trunk/manual/Using the compiler

    r12308 r12595  
    166166; -prologue FILENAME : Includes the file named {{FILENAME}} at the start of the compiled source file.  The include-path is not searched. This option may be given multiple times.
    167167
    168 ; -quiet : Disables output of compile information.
    169 
    170168; -raw : Disables the generation of any implicit code that uses the Scheme libraries (that is all runtime system files besides {{runtime.c}} and {{chicken.h}}).
    171169
  • chicken/trunk/support.scm

    r12301 r12595  
    3535  standard-bindings-that-never-return-false side-effect-free-standard-bindings-that-never-return-false
    3636  installation-home optimization-iterations compiler-cleanup-hook decompose-lambda-list
    37   file-io-only banner custom-declare-alist disabled-warnings internal-bindings
     37  file-io-only banner disabled-warnings internal-bindings
    3838  unit-name insert-timer-checks used-units source-filename pending-canonicalizations
    3939  foreign-declarations block-compilation line-number-database-size node->sexpr sexpr->node
     
    7070  constant-declarations process-lambda-documentation big-fixnum? sort-symbols
    7171  export-dump-hook intrinsic? node->sexpr emit-global-inline-file inline-max-size
    72   make-random-name foreign-type-convert-result foreign-type-convert-argument process-custom-declaration)
     72  make-random-name foreign-type-convert-result foreign-type-convert-argument)
    7373
    7474
     
    12261226    -release                    print release number and exit
    12271227    -verbose                    display information on compilation progress
    1228     -quiet                      do not display compile information
    12291228
    12301229  File and pathname options:
     
    14451444
    14461445
    1447 ;;; Custom declarations:
    1448 
    1449 (define (process-custom-declaration spec strings)
    1450   (let* ([tag (car spec)]
    1451          [name (cadr spec)]
    1452          [fname (caddr spec)]
    1453          [args (cdddr spec)]
    1454          [id (cons tag name)]
    1455          [a (assoc id custom-declare-alist)] )
    1456     (unless a
    1457       (let ([out (open-output-file fname)])
    1458         (set! a (cons id out))
    1459         (set! custom-declare-alist (cons a custom-declare-alist))
    1460         (set! compiler-cleanup-hook
    1461           (let ([old compiler-cleanup-hook])
    1462             (lambda ()
    1463               (close-output-port out)
    1464               (old) ) ) )
    1465         (emit-control-file-item (cons* tag name fname args)) ) )
    1466     (for-each (cute display <> (cdr a)) strings) ) )
    1467 
    1468 (define (emit-control-file-item item)
    1469   (unless csc-control-file
    1470     (set! csc-control-file (open-output-file (pathname-replace-extension source-filename "csc")))
    1471     (display "#%csc\n" csc-control-file)
    1472     (set! compiler-cleanup-hook
    1473       (let ([old compiler-cleanup-hook])
    1474         (lambda ()
    1475           (close-output-port csc-control-file)
    1476           (old) ) ) ) )
    1477   (fprintf csc-control-file "~S~%" item) )
    1478 
    1479 
    14801446;;; 64-bit fixnum?
    14811447
Note: See TracChangeset for help on using the changeset viewer.