Changeset 12096 in project for chicken/branches/chicken-3


Ignore:
Timestamp:
10/02/08 01:53:55 (12 years ago)
Author:
Ivan Raikov
Message:

Adding latest updates to release-3 branch.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/chicken-3/scripts/chicken-bundle.scm

    r12053 r12096  
    1414
    1515(include "tools.scm")
     16
     17(define (lookup-def k lst . rest)
     18  (let-optionals rest ((default #f))
     19      (let ((kv (assoc k lst)))
     20        (if (not kv) default
     21            (match kv ((k v) v) (else (cdr kv)))))))
    1622
    1723(define chicken-include-dir (foreign-value "C_INSTALL_INCLUDE_HOME" c-string) )
     
    3844    ,(args:make-option (repo-dir)       (required: "DIR")   
    3945                       (s+ "install eggs in directory DIR"))
     46    ,(args:make-option (search-dirs)       (required: "DIR")   
     47                       (s+ "comma-separated directory list where to search for library .scm files"))
    4048    ,(args:make-option (suffix)       (required: "STRING")   
    4149                       (s+ "use given suffix for archive name and top-level directory (default is -bundle)"))
     
    97105
    98106(define (make-paths-c+h flst)
    99   (concatenate (map (lambda (p) (append (map (lambda (f) (s+ (second p) dirsep f)) (third p))
    100                                         (map (lambda (f) (s+ (second p) dirsep f)) (fourth p))))
     107  (concatenate (map (lambda (p) (append (map (lambda (f) (s+ (third p) dirsep f)) (fourth p))
     108                                        (map (lambda (f) (s+ (third p) dirsep f)) (fifth p))))
    101109                    flst)))
    102110
    103111(define (make-paths-c flst)
    104   (concatenate (map (lambda (p) (map (lambda (f) (s+ (second p) dirsep f)) (fourth p))) flst)))
     112  (concatenate (map (lambda (p) (map (lambda (f) (s+ (third p) dirsep f)) (fifth p))) flst)))
    105113
    106114(define (build-makefile egg-name flst units cc-options)
     
    119127        (display text out))))))
    120128
    121 (define (build-bundle egg-name suffix repo-dir build-dir chicken-dir
     129(define (build-bundle egg-name suffix repo-dir build-dir chicken-dir search-dirs
    122130                      chicken-units cc-options exclude)
    123131  (let ((cwd (current-directory))
     
    140148                   (if (member subdir-eggname exclude)
    141149                       (loop (cdr subdirs) flst)
    142                        (loop (cdr subdirs) (cons (list subdir-name bundle-subdir-name h-file-names
     150                       (loop (cdr subdirs) (cons (list subdir-eggname
     151                                                       subdir-name bundle-subdir-name h-file-names
    143152                                                       c-file-names) flst))))))))
    144153      (if (null? flst) (error 'build-bundle "no C files found"))
     
    155164      (for-each (lambda (u) (run (cp ,(s+ chicken-dir dirsep u ".c") ,bundle-dir))) chicken-units)
    156165      (change-directory build-dir)
    157       (for-each (lambda (p) (run (mv ,(first p) ,(s+ bundle-dir dirsep (second p))))) flst)
    158       (let* ((bundle-dir-name (pathname-strip-directory bundle-dir))
    159              (make-bundle-path   (lambda (x) (s+ bundle-dir-name dirsep x)))
    160              (make-bundle-path+c (lambda (x) (s+ bundle-dir-name dirsep x ".c"))))
    161         (run (tar zcf ,bundle-name
    162                   ,@(map make-bundle-path `(Makefile chicken.h runtime.c library.c ))
    163                   ,@(map make-bundle-path  (make-paths-c+h flst))
    164                   ,@(map make-bundle-path+c chicken-units))))
    165       (run (mv ,(s+ build-dir dirsep bundle-name) ,cwd))
    166       (change-directory cwd)
    167       )))
     166      (let ((lib-units
     167             (concatenate
     168              (map (lambda (p)
     169                     (let* ((this-egg (first p))
     170                            (subdir   (second p))
     171                            (cfns     (fifth p))
     172                            (sfns     (map (lambda (x) (pathname-replace-extension x ".scm")) cfns)))
     173                       (fold (lambda (fn ax)
     174                               (let* ((ep   (s+ subdir dirsep fn))
     175                                      (epc  (pathname-replace-extension ep ".c"))
     176                                      (ops  (map (lambda (d) (s+ subdir dirsep d dirsep fn)) search-dirs))
     177                                      (u    (pathname-strip-extension fn))
     178                                      (p    (find file-exists? (cons ep ops))))
     179                                 (if p
     180                                     (begin (run (csc ,@(if (not (string=? u "syntax-case"))
     181                                                            `(-R syntax-case) `())
     182                                                      -I ,subdir -unit ,u -e -t ,p -o ,epc))
     183                                            (if (string=? u egg-name) ax
     184                                                (cons u ax)) )
     185                                     ax)))
     186                             (list) sfns)))
     187                   flst))))
     188        (let* ((egg-entry  (lookup-def egg-name flst))
     189               (subdir     (first egg-entry))
     190               (p          (s+ subdir dirsep egg-name ".scm")))
     191          (run (csc -I ,subdir ,@(map (lambda (u) `(-uses ,u)) lib-units) -t ,p)))
     192        (for-each (lambda (p) (run (mv ,(second p) ,(s+ bundle-dir dirsep (third p))))) flst)
     193        (let* ((bundle-dir-name    (pathname-strip-directory bundle-dir))
     194               (make-bundle-path   (lambda (x) (s+ bundle-dir-name dirsep x)))
     195               (make-bundle-path+c (lambda (x) (s+ bundle-dir-name dirsep x ".c"))))
     196          (run (tar zcf ,bundle-name
     197                    ,@(map make-bundle-path `(Makefile chicken.h runtime.c library.c ))
     198                    ,@(map make-bundle-path  (make-paths-c+h flst))
     199                    ,@(map make-bundle-path+c chicken-units))))
     200        (run (mv ,(s+ build-dir dirsep bundle-name) ,cwd))
     201        (change-directory cwd)
     202        ))))
    168203               
    169204
     
    175210        (opt_cc-options    (or (alist-ref 'cc-options options) *default-cc-options*))
    176211        (opt_chicken-dir   (or (alist-ref 'chicken-dir options) "."))
     212        (opt_search-dirs   (or ((lambda (x) (and x (string-split x ","))) (alist-ref 'search-dirs options))
     213                               (list)))
    177214        (opt_chicken-units (or ((lambda (x) (and x (string-split x ","))) (alist-ref 'chicken-units options))
    178                                (list "data-structures" "utils" "extras" "srfi-1" "srfi-4" "srfi-13" "srfi-14")))
     215                               (list "eval" "data-structures" "ports" "extras" "srfi-69")))
    179216        (opt_build-dir   (or (alist-ref 'build-dir options) (compute-unique-path "build")))
    180217        (opt_repo-dir    (or (alist-ref 'repo-dir options)  (compute-unique-path "repo"))))
     
    190227          (message "Creating directory ~a" opt_repo-dir)
    191228          (create-directory opt_repo-dir)))
    192     (for-each (lambda (x) (build-bundle x opt_suffix opt_repo-dir opt_build-dir opt_chicken-dir
     229    (for-each (lambda (x) (build-bundle x opt_suffix opt_repo-dir opt_build-dir opt_chicken-dir opt_search-dirs
    193230                                        opt_chicken-units opt_cc-options opt_exclude ))
    194231              operands)))
Note: See TracChangeset for help on using the changeset viewer.