Changeset 12052 in project

Timestamp:

10/01/08 00:53:27 (12 years ago)

Author:

Ivan Raikov

Message:

Some bug fixes to chicken-bundle.

File:

• chicken/trunk/scripts/chicken-bundle.scm (modified) (6 diffs)

chicken/trunk/scripts/chicken-bundle.scm

@@ -17 +17 @@
 (define chicken-include-dir (foreign-value "C_INSTALL_INCLUDE_HOME" c-string) )
 
-(define s+ string-append)
+(define (s+ . lst)    (apply string-append (map ->string lst)))
+
 (define (sl\ p lst)   (string-intersperse (map ->string lst) p))
 
@@ -28 +29 @@
     ,(args:make-option (chicken-dir)       (required: "DIR")    
                        (s+ "directory where Chicken C files can be found"))
-    ,(args:make-option (chicken-units)       (required: "DIR")    
+    ,(args:make-option (chicken-units)       (required: "LIST")    
                        (s+ "Chicken units to be included with the bundle (comma-separated list)"))
+    ,(args:make-option (exclude)       (required: "LIST")    
+                       (s+ "libraries to be excluded from bundling (comma-separated list)"))
     ,(args:make-option (repo-dir)       (required: "DIR")    
                        (s+ "install eggs in directory DIR"))
+    ,(args:make-option (suffix)       (required: "STRING")    
+                       (s+ "use given suffix for archive name and top-level directory (default is -bundle)"))
     ,(args:make-option (verbose)       #:none
                        (s+ "enable verbose mode")
@@ -65 +70 @@
 (define (read-c-files path)
   (find-files path ".*.c" cons (list) 0))
+(define (read-h-files path)
+  (find-files path ".*.h" cons (list) 0))
 
 (define tmpdir-prefix
@@ -86 +93 @@
       (if (file-exists? path) (loop (random 10000)) path))))
 
-(define (fnxp flst)
-  (concatenate (map (lambda (p) (map (lambda (f) (s+ (second p) "/" f)) (third p))) flst)))
+(define (chxp flst)
+  (concatenate (map (lambda (p) (append (map (lambda (f) (s+ (second p) dirsep f)) (third p))
+                                        (map (lambda (f) (s+ (second p) dirsep f)) (fourth p))))
+                    flst)))
+
+(define (cxp flst)
+  (concatenate (map (lambda (p) (map (lambda (f) (s+ (second p) dirsep f)) (fourth p))) flst)))
 
 (define (build-makefile egg-name flst units cc-options)
+  (message "Creating Makefile" )
   (call-with-output-file "Makefile"
     (lambda (out)
       (let ((text #<#EOF
-## This file was generated by chicken-bundle, do not edit or your changes might be lost
+## This file was generated by chicken-bundle
 ##
-#(s+ egg-name ": ") runtime.c library.c #(sl\ " " (map (lambda (u) (s+ u ".c")) units)) #(sl\ " " (fnxp flst))
-#(list->string (list #\tab)) $(CC) #(identity cc-options) -o #(s+ egg-name) $^
+#(s+ egg-name ": ") runtime.c library.c #(sl\ " " (map (lambda (u) (s+ u ".c")) units)) #(sl\ " " (cxp flst))
+#(list->string (list #\tab)) $(CC) #(identity cc-options) -o $@ $^
 EOF
 ))
         (display text out)))))
 
-(define (build-bundle egg-name repo-dir build-dir chicken-dir chicken-units cc-options)
-  (let ((cwd (current-directory)))
-    (run (rm -rf ,(s+ build-dir "/*")))
-    (run (rm -rf ,(s+ repo-dir "/*")))
-    (run (chicken-setup -d ,(if *verbose* "-v" "") -k -build-prefix ,build-dir -repository ,repo-dir ,egg-name))
-    (let ((bundle-name  (s+ egg-name "-bundle.tar.gz") )
-           (flst
-            (let loop ((subdirs (read-subdirs build-dir))  (flst (list)))
-              (if (null? subdirs) flst
-                  (let* ((subdir (car subdirs))
-                         (c-files (read-c-files subdir))
-                         (subdir-name (pathname-strip-directory subdir))
-                         (c-file-names (map pathname-strip-directory c-files))
-                         (bundle-subdir-name (third (string-split subdir-name "."))))
-                    (loop (cdr subdirs) (cons (list subdir-name bundle-subdir-name c-file-names) flst)))))))
+(define (build-bundle egg-name suffix repo-dir build-dir chicken-dir 
+                      chicken-units cc-options exclude)
+  (let ((cwd (current-directory))
+        (bundle-dir   (s+ build-dir dirsep egg-name suffix))
+        (bundle-name  (s+ egg-name suffix ".tar.gz") ))
+    (run (rm -rf ,(s+ build-dir dirsep "*")))
+    (run (rm -rf ,(s+ repo-dir dirsep "*")))
+    (run (chicken-setup ,(if *verbose* "-v" "") -d -k -build-prefix ,build-dir -repository ,repo-dir ,egg-name))
+    (let ((flst
+           (let loop ((subdirs (read-subdirs build-dir))  (flst (list)))
+             (if (null? subdirs) flst
+                 (let* ((subdir (car subdirs))
+                        (c-files (read-c-files subdir))
+                        (h-files (read-h-files subdir))
+                        (subdir-name (pathname-strip-directory subdir))
+                        (subdir-eggname (third (string-split subdir-name ".")))
+                        (bundle-subdir-name (s+ subdir-eggname ".dir"))
+                        (c-file-names (map pathname-strip-directory c-files))
+                        (h-file-names (map pathname-strip-directory h-files)))
+                   (if (member subdir-eggname exclude)
+                       (loop (cdr subdirs) flst)
+                       (loop (cdr subdirs) (cons (list subdir-name bundle-subdir-name h-file-names
+                                                       c-file-names) flst))))))))
       (if (null? flst) (error 'build-bundle "no C files found"))
-      (run (cp ,(s+ chicken-include-dir "/chicken.h") ,build-dir))
-      (run (cp ,(s+ chicken-dir "/runtime.c") ,build-dir))
-      (run (cp ,(s+ chicken-dir "/library.c") ,build-dir))
-      (for-each (lambda (u) (run (cp ,(s+ chicken-dir "/" u ".c") ,build-dir))) chicken-units)
+      (if (not (file-exists? bundle-dir))
+          (begin
+            (message "Creating directory ~a" bundle-dir)
+            (create-directory bundle-dir)))
+      (run (rm -rf ,(s+ bundle-dir dirsep "*")))
+      (change-directory bundle-dir)
+      (build-makefile egg-name flst chicken-units cc-options)
+      (run (cp ,(s+ chicken-include-dir dirsep "chicken.h") ,bundle-dir))
+      (run (cp ,(s+ chicken-dir dirsep "runtime.c") ,bundle-dir))
+      (run (cp ,(s+ chicken-dir dirsep "library.c") ,bundle-dir))
+      (for-each (lambda (u) (run (cp ,(s+ chicken-dir dirsep u ".c") ,bundle-dir))) chicken-units)
       (change-directory build-dir)
-      (build-makefile egg-name flst chicken-units cc-options)
-      (for-each (lambda (p) (run (mv ,(first p) ,(second p)))) flst)
-      (run (tar zcf ,bundle-name Makefile chicken.h runtime.c library.c
-                ,@(map (lambda (u) (s+ u ".c")) chicken-units) 
-                ,@(fnxp flst)))
-      (run (mv ,(s+ build-dir "/" bundle-name) ,cwd))
+      (for-each (lambda (p) (run (mv ,(first p) ,(s+ bundle-dir dirsep (second p))))) flst)
+      (let* ((bundle-dir-name (pathname-strip-directory bundle-dir))
+             (mkbp  (lambda (x) (s+ bundle-dir-name dirsep x)))
+             (mkbpu (lambda (x) (s+ bundle-dir-name dirsep x ".c"))))
+        (run (tar zcf ,bundle-name 
+                  ,@(map mkbp `(Makefile chicken.h runtime.c library.c ))
+                  ,@(map mkbp (chxp flst)) ,@(map mkbpu chicken-units))))
+      (run (mv ,(s+ build-dir dirsep bundle-name) ,cwd))
       (change-directory cwd)
       )))
@@ -134 +164 @@
 
 (define (main options operands)
-  (let ((opt_cc-options   (or (alist-ref 'cc-options options) ""))
+  (let ((opt_exclude       (or ((lambda (x) (and x (string-split x ","))) (alist-ref 'exclude options))
+                               (list)))
+        (opt_suffix        (or (alist-ref 'suffix options) "-bundle"))
+        (opt_cc-options    (or (alist-ref 'cc-options options) "-g -O2"))
         (opt_chicken-dir   (or (alist-ref 'chicken-dir options) "."))
         (opt_chicken-units (or ((lambda (x) (and x (string-split x ","))) (alist-ref 'chicken-units options))
-                               (list "utils" "extras" "srfi-1" "srfi-13" "srfi-14")))
+                               (list "data-structures" "utils" "extras" "srfi-1" "srfi-4" "srfi-13" "srfi-14")))
         (opt_build-dir   (or (alist-ref 'build-dir options) (compute-unique-path "build")))
         (opt_repo-dir    (or (alist-ref 'repo-dir options)  (compute-unique-path "repo"))))
@@ -151 +184 @@
           (message "Creating directory ~a" opt_repo-dir)
           (create-directory opt_repo-dir)))
-    (for-each (lambda (x) (build-bundle x opt_repo-dir opt_build-dir opt_chicken-dir opt_chicken-units opt_cc-options ))
+    (for-each (lambda (x) (build-bundle x opt_suffix opt_repo-dir opt_build-dir opt_chicken-dir 
+                                        opt_chicken-units opt_cc-options opt_exclude ))
               operands)))