Changeset 12052 in project

10/01/08 00:53:27 (13 years ago)
Ivan Raikov

Some bug fixes to chicken-bundle.

1 edited


  • chicken/trunk/scripts/chicken-bundle.scm

    r12050 r12052  
    1717(define chicken-include-dir (foreign-value "C_INSTALL_INCLUDE_HOME" c-string) )
    19 (define s+ string-append)
     19(define (s+ . lst)    (apply string-append (map ->string lst)))
    2021(define (sl\ p lst)   (string-intersperse (map ->string lst) p))
    2829    ,(args:make-option (chicken-dir)       (required: "DIR")   
    2930                       (s+ "directory where Chicken C files can be found"))
    30     ,(args:make-option (chicken-units)       (required: "DIR")   
     31    ,(args:make-option (chicken-units)       (required: "LIST")   
    3132                       (s+ "Chicken units to be included with the bundle (comma-separated list)"))
     33    ,(args:make-option (exclude)       (required: "LIST")   
     34                       (s+ "libraries to be excluded from bundling (comma-separated list)"))
    3235    ,(args:make-option (repo-dir)       (required: "DIR")   
    3336                       (s+ "install eggs in directory DIR"))
     37    ,(args:make-option (suffix)       (required: "STRING")   
     38                       (s+ "use given suffix for archive name and top-level directory (default is -bundle)"))
    3439    ,(args:make-option (verbose)       #:none
    3540                       (s+ "enable verbose mode")
    6570(define (read-c-files path)
    6671  (find-files path ".*.c" cons (list) 0))
     72(define (read-h-files path)
     73  (find-files path ".*.h" cons (list) 0))
    6875(define tmpdir-prefix
    8693      (if (file-exists? path) (loop (random 10000)) path))))
    88 (define (fnxp flst)
    89   (concatenate (map (lambda (p) (map (lambda (f) (s+ (second p) "/" f)) (third p))) flst)))
     95(define (chxp flst)
     96  (concatenate (map (lambda (p) (append (map (lambda (f) (s+ (second p) dirsep f)) (third p))
     97                                        (map (lambda (f) (s+ (second p) dirsep f)) (fourth p))))
     98                    flst)))
     100(define (cxp flst)
     101  (concatenate (map (lambda (p) (map (lambda (f) (s+ (second p) dirsep f)) (fourth p))) flst)))
    91103(define (build-makefile egg-name flst units cc-options)
     104  (message "Creating Makefile" )
    92105  (call-with-output-file "Makefile"
    93106    (lambda (out)
    94107      (let ((text #<#EOF
    95 ## This file was generated by chicken-bundle, do not edit or your changes might be lost
     108## This file was generated by chicken-bundle
    97 #(s+ egg-name ": ") runtime.c library.c #(sl\ " " (map (lambda (u) (s+ u ".c")) units)) #(sl\ " " (fnxp flst))
    98 #(list->string (list #\tab)) $(CC) #(identity cc-options) -o #(s+ egg-name) $^
     110#(s+ egg-name ": ") runtime.c library.c #(sl\ " " (map (lambda (u) (s+ u ".c")) units)) #(sl\ " " (cxp flst))
     111#(list->string (list #\tab)) $(CC) #(identity cc-options) -o $@ $^
    101114        (display text out)))))
    103 (define (build-bundle egg-name repo-dir build-dir chicken-dir chicken-units cc-options)
    104   (let ((cwd (current-directory)))
    105     (run (rm -rf ,(s+ build-dir "/*")))
    106     (run (rm -rf ,(s+ repo-dir "/*")))
    107     (run (chicken-setup -d ,(if *verbose* "-v" "") -k -build-prefix ,build-dir -repository ,repo-dir ,egg-name))
    108     (let ((bundle-name  (s+ egg-name "-bundle.tar.gz") )
    109            (flst
    110             (let loop ((subdirs (read-subdirs build-dir))  (flst (list)))
    111               (if (null? subdirs) flst
    112                   (let* ((subdir (car subdirs))
    113                          (c-files (read-c-files subdir))
    114                          (subdir-name (pathname-strip-directory subdir))
    115                          (c-file-names (map pathname-strip-directory c-files))
    116                          (bundle-subdir-name (third (string-split subdir-name "."))))
    117                     (loop (cdr subdirs) (cons (list subdir-name bundle-subdir-name c-file-names) flst)))))))
     116(define (build-bundle egg-name suffix repo-dir build-dir chicken-dir
     117                      chicken-units cc-options exclude)
     118  (let ((cwd (current-directory))
     119        (bundle-dir   (s+ build-dir dirsep egg-name suffix))
     120        (bundle-name  (s+ egg-name suffix ".tar.gz") ))
     121    (run (rm -rf ,(s+ build-dir dirsep "*")))
     122    (run (rm -rf ,(s+ repo-dir dirsep "*")))
     123    (run (chicken-setup ,(if *verbose* "-v" "") -d -k -build-prefix ,build-dir -repository ,repo-dir ,egg-name))
     124    (let ((flst
     125           (let loop ((subdirs (read-subdirs build-dir))  (flst (list)))
     126             (if (null? subdirs) flst
     127                 (let* ((subdir (car subdirs))
     128                        (c-files (read-c-files subdir))
     129                        (h-files (read-h-files subdir))
     130                        (subdir-name (pathname-strip-directory subdir))
     131                        (subdir-eggname (third (string-split subdir-name ".")))
     132                        (bundle-subdir-name (s+ subdir-eggname ".dir"))
     133                        (c-file-names (map pathname-strip-directory c-files))
     134                        (h-file-names (map pathname-strip-directory h-files)))
     135                   (if (member subdir-eggname exclude)
     136                       (loop (cdr subdirs) flst)
     137                       (loop (cdr subdirs) (cons (list subdir-name bundle-subdir-name h-file-names
     138                                                       c-file-names) flst))))))))
    118139      (if (null? flst) (error 'build-bundle "no C files found"))
    119       (run (cp ,(s+ chicken-include-dir "/chicken.h") ,build-dir))
    120       (run (cp ,(s+ chicken-dir "/runtime.c") ,build-dir))
    121       (run (cp ,(s+ chicken-dir "/library.c") ,build-dir))
    122       (for-each (lambda (u) (run (cp ,(s+ chicken-dir "/" u ".c") ,build-dir))) chicken-units)
     140      (if (not (file-exists? bundle-dir))
     141          (begin
     142            (message "Creating directory ~a" bundle-dir)
     143            (create-directory bundle-dir)))
     144      (run (rm -rf ,(s+ bundle-dir dirsep "*")))
     145      (change-directory bundle-dir)
     146      (build-makefile egg-name flst chicken-units cc-options)
     147      (run (cp ,(s+ chicken-include-dir dirsep "chicken.h") ,bundle-dir))
     148      (run (cp ,(s+ chicken-dir dirsep "runtime.c") ,bundle-dir))
     149      (run (cp ,(s+ chicken-dir dirsep "library.c") ,bundle-dir))
     150      (for-each (lambda (u) (run (cp ,(s+ chicken-dir dirsep u ".c") ,bundle-dir))) chicken-units)
    123151      (change-directory build-dir)
    124       (build-makefile egg-name flst chicken-units cc-options)
    125       (for-each (lambda (p) (run (mv ,(first p) ,(second p)))) flst)
    126       (run (tar zcf ,bundle-name Makefile chicken.h runtime.c library.c
    127                 ,@(map (lambda (u) (s+ u ".c")) chicken-units)
    128                 ,@(fnxp flst)))
    129       (run (mv ,(s+ build-dir "/" bundle-name) ,cwd))
     152      (for-each (lambda (p) (run (mv ,(first p) ,(s+ bundle-dir dirsep (second p))))) flst)
     153      (let* ((bundle-dir-name (pathname-strip-directory bundle-dir))
     154             (mkbp  (lambda (x) (s+ bundle-dir-name dirsep x)))
     155             (mkbpu (lambda (x) (s+ bundle-dir-name dirsep x ".c"))))
     156        (run (tar zcf ,bundle-name
     157                  ,@(map mkbp `(Makefile chicken.h runtime.c library.c ))
     158                  ,@(map mkbp (chxp flst)) ,@(map mkbpu chicken-units))))
     159      (run (mv ,(s+ build-dir dirsep bundle-name) ,cwd))
    130160      (change-directory cwd)
    131161      )))
    135165(define (main options operands)
    136   (let ((opt_cc-options   (or (alist-ref 'cc-options options) ""))
     166  (let ((opt_exclude       (or ((lambda (x) (and x (string-split x ","))) (alist-ref 'exclude options))
     167                               (list)))
     168        (opt_suffix        (or (alist-ref 'suffix options) "-bundle"))
     169        (opt_cc-options    (or (alist-ref 'cc-options options) "-g -O2"))
    137170        (opt_chicken-dir   (or (alist-ref 'chicken-dir options) "."))
    138171        (opt_chicken-units (or ((lambda (x) (and x (string-split x ","))) (alist-ref 'chicken-units options))
    139                                (list "utils" "extras" "srfi-1" "srfi-13" "srfi-14")))
     172                               (list "data-structures" "utils" "extras" "srfi-1" "srfi-4" "srfi-13" "srfi-14")))
    140173        (opt_build-dir   (or (alist-ref 'build-dir options) (compute-unique-path "build")))
    141174        (opt_repo-dir    (or (alist-ref 'repo-dir options)  (compute-unique-path "repo"))))
    151184          (message "Creating directory ~a" opt_repo-dir)
    152185          (create-directory opt_repo-dir)))
    153     (for-each (lambda (x) (build-bundle x opt_repo-dir opt_build-dir opt_chicken-dir opt_chicken-units opt_cc-options ))
     186    (for-each (lambda (x) (build-bundle x opt_suffix opt_repo-dir opt_build-dir opt_chicken-dir
     187                                        opt_chicken-units opt_cc-options opt_exclude ))
    154188              operands)))
Note: See TracChangeset for help on using the changeset viewer.