Changeset 12096 in project
- Timestamp:
- 10/02/08 01:53:55 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
chicken/branches/chicken-3/scripts/chicken-bundle.scm
r12053 r12096 14 14 15 15 (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))))))) 16 22 17 23 (define chicken-include-dir (foreign-value "C_INSTALL_INCLUDE_HOME" c-string) ) … … 38 44 ,(args:make-option (repo-dir) (required: "DIR") 39 45 (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")) 40 48 ,(args:make-option (suffix) (required: "STRING") 41 49 (s+ "use given suffix for archive name and top-level directory (default is -bundle)")) … … 97 105 98 106 (define (make-paths-c+h flst) 99 (concatenate (map (lambda (p) (append (map (lambda (f) (s+ ( second p) dirsep f)) (thirdp))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)))) 101 109 flst))) 102 110 103 111 (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))) 105 113 106 114 (define (build-makefile egg-name flst units cc-options) … … 119 127 (display text out)))))) 120 128 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 122 130 chicken-units cc-options exclude) 123 131 (let ((cwd (current-directory)) … … 140 148 (if (member subdir-eggname exclude) 141 149 (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 143 152 c-file-names) flst)))))))) 144 153 (if (null? flst) (error 'build-bundle "no C files found")) … … 155 164 (for-each (lambda (u) (run (cp ,(s+ chicken-dir dirsep u ".c") ,bundle-dir))) chicken-units) 156 165 (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 )))) 168 203 169 204 … … 175 210 (opt_cc-options (or (alist-ref 'cc-options options) *default-cc-options*)) 176 211 (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))) 177 214 (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"))) 179 216 (opt_build-dir (or (alist-ref 'build-dir options) (compute-unique-path "build"))) 180 217 (opt_repo-dir (or (alist-ref 'repo-dir options) (compute-unique-path "repo")))) … … 190 227 (message "Creating directory ~a" opt_repo-dir) 191 228 (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 193 230 opt_chicken-units opt_cc-options opt_exclude )) 194 231 operands)))
Note: See TracChangeset
for help on using the changeset viewer.