~ chicken-core (master) /egg-compile.scm
Trap1;;;; egg-info processing and compilation2;3; Copyright (c) 2017-2022, The CHICKEN Team4; All rights reserved.5;6; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following7; conditions are met:8;9; Redistributions of source code must retain the above copyright notice, this list of conditions and the following10; disclaimer.11; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following12; disclaimer in the documentation and/or other materials provided with the distribution.13; Neither the name of the author nor the names of its contributors may be used to endorse or promote14; products derived from this software without specific prior written permission.15;16; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS17; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY18; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR19; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR20; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR21; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY22; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR23; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE24; POSSIBILITY OF SUCH DAMAGE.252627(define default-extension-options '())28(define default-program-options '())29(define default-static-program-link-options '())30(define default-dynamic-program-link-options '())31(define default-static-extension-link-options '())32(define default-dynamic-extension-link-options '())33(define default-static-compilation-options '("-O2" "-d1"))34(define default-dynamic-compilation-options '("-O2" "-d1"))35(define default-import-library-compilation-options '("-O2" "-d0"))3637(define default-program-linkage38 (if staticbuild '(static) '(dynamic)))3940(define default-extension-linkage41 (if staticbuild '(static) '(static dynamic)))4243(define +unix-executable-extension+ "")44(define +windows-executable-extension+ ".exe")45(define +link-file-extension+ ".link")4647(define keep-generated-files #f)48(define dependency-targets '())495051;;; some utilities5253(define override-prefix54 (let ((prefix (get-environment-variable "CHICKEN_INSTALL_PREFIX")))55 (lambda (dir default)56 (if prefix57 (string-append prefix dir)58 default))))5960(define (object-extension platform) ".o")61(define (archive-extension platform) ".a")6263(define (executable-extension platform)64 (case platform65 ((unix) +unix-executable-extension+)66 ((windows) +windows-executable-extension+)))6768(define (copy-directory-command platform)69 "cp -r")7071(define (copy-file-command platform)72 "cp")7374(define (mkdir-command platform)75 "mkdir -p")7677(define (install-executable-command platform)78 (string-append default-install-program " "79 default-install-program-executable-flags))8081(define (install-file-command platform)82 (string-append default-install-program " "83 default-install-program-data-flags))8485(define (remove-file-command platform)86 "rm -f")8788(define (cd-command platform)89 "cd")9091(define (uses-compiled-import-library? mode)92 (not (and (eq? mode 'host) staticbuild)))9394;; this one overrides "destination-repository" in egg-environment to allow use of95;; CHICKEN_INSTALL_PREFIX (via "override-prefix")96(define (effective-destination-repository mode #!optional run)97 (if (eq? 'target mode)98 (if run target-run-repo target-repo)99 (or (get-environment-variable "CHICKEN_INSTALL_REPOSITORY")100 (override-prefix (string-append "/lib/chicken/" (number->string binary-version))101 host-repo))))102103;;; topological sort with cycle check104105(define (sort-dependencies dag eq)106 (condition-case (topological-sort dag eq)107 ((exn runtime cycle)108 (error "cyclic dependencies" dag))))109110111;;; collect import libraries for all modules112113(define (import-libraries mods dest rtarget mode)114 (define (implib name)115 (conc dest "/" name ".import."116 (if (uses-compiled-import-library? mode)117 "so"118 "scm")))119 (if mods120 (map implib mods)121 (list (implib rtarget))))122123124;;; normalize target path for "random files" (data, c-include, scheme-include)125126(define (normalize-destination dest mode)127 (let ((dest* (normalize-pathname dest)))128 (if (irregex-search '(: bos ".." ("\\/")) dest*)129 (error "destination must be relative to CHICKEN install prefix" dest)130 (normalize-pathname131 (make-pathname (if (eq? mode 'target)132 default-prefix133 (override-prefix "/" host-prefix))134 dest*)))))135136137;;; check condition in conditional clause138139(define (check-condition tst mode link)140 (define (fail x)141 (error "invalid conditional expression in `cond-expand' clause"142 x))143 (let walk ((x tst))144 (cond ((and (list? x) (pair? x))145 (cond ((and (eq? (car x) 'not) (= 2 (length x)))146 (not (walk (cadr x))))147 ((eq? 'and (car x)) (every walk (cdr x)))148 ((eq? 'or (car x)) (any walk (cdr x)))149 (else (fail x))))150 ((memq x '(dynamic static)) (memq x link))151 ((memq x '(target host)) (memq x mode))152 ((symbol? x) (feature? x))153 (else (fail x)))))154155156;;; parse custom configuration information from script157158(define (parse-custom-config eggfile arg)159 (define (read-all)160 (let loop ((lst '()))161 (let ((x (read)))162 (if (eof-object? x)163 (reverse lst)164 (loop (append (reverse (flatten x)) lst))))))165 (if (and (list? arg) (eq? 'custom-config (car arg)))166 (let* ((args (cdr arg))167 (in (with-input-from-pipe168 (string-intersperse169 (append170 (list default-csi "-s"171 (make-pathname (pathname-directory eggfile)172 (->string (car args))))173 (cdr args))174 " ")175 read-all)))176 (map ->string in))177 (list arg)))178179180;;; compile an egg-information tree into abstract build/install operations181182(define (compile-egg-info eggfile info version platform mode)183 (let ((exts '())184 (prgs '())185 (objs '())186 (data '())187 (genfiles '())188 (cinc '())189 (scminc '())190 (target #f)191 (src #f)192 (files '())193 (ifiles '())194 (cbuild #f)195 (oname #f)196 (link '())197 (dest #f)198 (sdeps '())199 (cdeps '())200 (lopts '())201 (opts '())202 (mods #f)203 (lobjs '())204 (tfile #f)205 (ptfile #f)206 (ifile #f)207 (install #t)208 (custom-egg-build #f)209 (eggfile (locate-egg-file eggfile))210 (objext (object-extension platform))211 (arcext (archive-extension platform))212 (exeext (executable-extension platform)))213 (define (check-target t lst)214 (when (member t lst)215 (error "target multiply defined" t))216 t)217 (define (addfiles . filess)218 (set! ifiles (concatenate (cons ifiles filess)))219 files)220 (define (checkfiles files target)221 (when (null? files)222 (warning "target has no files" target)))223 (define (compile-component info)224 (case (car info)225 ((extension)226 (fluid-let ((target (check-target (cadr info) exts))227 (cdeps '())228 (sdeps '())229 (src #f)230 (cbuild #f)231 (link (if (null? link) default-extension-linkage link))232 (tfile #f)233 (ptfile #f)234 (ifile #f)235 (lopts lopts)236 (lobjs '())237 (oname #f)238 (mods #f)239 (opts opts))240 (for-each compile-extension/program (cddr info))241 (let ((dest (effective-destination-repository mode #t))242 ;; Respect install-name if specified243 (rtarget (or oname target)))244 (when (eq? #t tfile) (set! tfile rtarget))245 (when (eq? #t ifile) (set! ifile rtarget))246 (addfiles247 (if (memq 'static link)248 (list (conc dest "/" rtarget249 (if (null? lobjs)250 objext251 arcext))252 (conc dest "/" rtarget +link-file-extension+))253 '())254 (if (memq 'dynamic link) (list (conc dest "/" rtarget ".so")) '())255 (if tfile256 (list (conc dest "/" tfile ".types"))257 '())258 (if ifile259 (list (conc dest "/" ifile ".inline"))260 '())261 (import-libraries mods dest rtarget mode))262 (set! exts263 (cons (list target264 dependencies: cdeps265 source: src options: opts266 link-options: lopts linkage: link custom: cbuild267 mode: mode types-file: tfile inline-file: ifile268 predefined-types: ptfile eggfile: eggfile269 modules: (or mods (list rtarget))270 source-dependencies: sdeps271 link-objects: lobjs custom-egg-build: custom-egg-build272 output-file: rtarget)273 exts)))))274 ((installed-c-object c-object)275 (fluid-let ((target (check-target (cadr info) exts))276 (cdeps '())277 (sdeps '())278 (src #f)279 (cbuild #f)280 (link (if (null? link) default-extension-linkage link))281 (oname #f)282 (mods #f)283 (install (eq? 'installed-c-object (car info)))284 (opts opts))285 (for-each compile-extension/program (cddr info))286 (let ((dest (effective-destination-repository mode #t))287 ;; Respect install-name if specified288 (rtarget (or oname target)))289 (when install290 (addfiles (list (conc dest "/" rtarget objext))))291 (set! objs292 (cons (list target dependencies: cdeps source: src293 options: opts294 linkage: link custom: cbuild295 mode: mode296 install: install297 eggfile: eggfile custom-egg-build: custom-egg-build298 source-dependencies: sdeps299 output-file: rtarget)300 objs)))))301 ((data)302 (fluid-let ((target (check-target (cadr info) data))303 (dest #f)304 (files '()))305 (for-each compile-data/include (cddr info))306 (checkfiles files target)307 (let* ((dest (or (and dest (normalize-destination dest mode))308 (if (eq? mode 'target)309 default-sharedir310 (override-prefix "/share" host-sharedir))))311 (dest (normalize-pathname (conc dest "/"))))312 (addfiles (map (cut conc dest <>) files)))313 (set! data314 (cons (list target dependencies: '() files: files315 destination: dest mode: mode)316 data))))317 ((generated-source-file)318 (fluid-let ((target (check-target (cadr info) data))319 (src #f)320 (cbuild #f)321 (sdeps '())322 (cdeps '()))323 (for-each compile-extension/program (cddr info))324 (unless cbuild325 (error "generated source files need a custom build step" target))326 (set! genfiles327 (cons (list target dependencies: cdeps source: src328 custom: cbuild source-dependencies: sdeps329 eggfile: eggfile custom-egg-build: custom-egg-build)330 genfiles))))331 ((c-include)332 (fluid-let ((target (check-target (cadr info) cinc))333 (dest #f)334 (files '()))335 (for-each compile-data/include (cddr info))336 (checkfiles files target)337 (let* ((dest (or (and dest (normalize-destination dest mode))338 (if (eq? mode 'target)339 default-incdir340 (override-prefix "/include" host-incdir))))341 (dest (normalize-pathname (conc dest "/"))))342 (addfiles (map (cut conc dest <>) files)))343 (set! cinc344 (cons (list target dependencies: '() files: files345 destination: dest mode: mode)346 cinc))))347 ((scheme-include)348 (fluid-let ((target (check-target (cadr info) scminc))349 (dest #f)350 (files '()))351 (for-each compile-data/include (cddr info))352 (checkfiles files target)353 (let* ((dest (or (and dest (normalize-destination dest mode))354 (if (eq? mode 'target)355 default-sharedir356 (override-prefix "/share" host-sharedir))))357 (dest (normalize-pathname (conc dest "/"))))358 (addfiles (map (cut conc dest <>) files)))359 (set! scminc360 (cons (list target dependencies: '() files: files361 destination: dest mode: mode)362 scminc))))363 ((program)364 (fluid-let ((target (check-target (cadr info) prgs))365 (cdeps '())366 (sdeps '())367 (cbuild #f)368 (src #f)369 (link (if (null? link) default-program-linkage link))370 (lobjs '())371 (lopts lopts)372 (oname #f)373 (opts opts))374 (for-each compile-extension/program (cddr info))375 (let ((dest (if (eq? mode 'target)376 default-bindir377 (override-prefix "/bin" host-bindir)))378 ;; Respect install-name if specified379 (rtarget (or oname target)))380 (addfiles (list (conc dest "/" rtarget exeext)))381 (set! prgs382 (cons (list target dependencies: cdeps383 source: src options: opts384 link-options: lopts linkage: link385 custom: cbuild386 mode: mode output-file: rtarget387 source-dependencies: sdeps388 link-objects: lobjs389 eggfile: eggfile custom-egg-build: custom-egg-build)390 prgs)))))391 (else (compile-common info compile-component 'component))))392 (define (compile-extension/program info)393 (case (car info)394 ((linkage)395 (set! link (cdr info)))396 ((types-file)397 (set! tfile398 (cond ((null? (cdr info)) #t)399 ((not (pair? (cadr info)))400 (arg info 1 name?))401 (else402 (set! ptfile #t)403 (set! tfile404 (or (null? (cdadr info))405 (arg (cadr info) 1 name?)))))))406 ((objects)407 (let ((los (map ->string (cdr info))))408 (set! lobjs (append lobjs los))409 (set! cdeps (append cdeps (map ->dep los)))))410 ((inline-file)411 (set! ifile (or (null? (cdr info)) (arg info 1 name?))))412 ((custom-build)413 (set! cbuild (->string (arg info 1 name?))))414 ((csc-options)415 (set! opts416 (apply append417 opts418 (map (cut parse-custom-config eggfile <>) (cdr info)))))419 ((link-options)420 (set! lopts421 (apply append422 lopts423 (map (cut parse-custom-config eggfile <>) (cdr info)))))424 ((source)425 (set! src (->string (arg info 1 name?))))426 ((install-name)427 (set! oname (->string (arg info 1 name?))))428 ((modules)429 (set! mods (map library-id (cdr info))))430 ((component-dependencies)431 (set! cdeps (append cdeps (map ->dep (cdr info)))))432 ((source-dependencies)433 (set! sdeps (append sdeps (map ->dep (cdr info)))))434 (else (compile-common info compile-extension/program 'extension/program))))435 (define (compile-common info walk context)436 (case (car info)437 ((target)438 (when (eq? mode 'target)439 (for-each walk (cdr info))))440 ((host)441 (when (eq? mode 'host)442 (for-each walk (cdr info))))443 ((error)444 (apply error (cdr info)))445 ((cond-expand)446 (compile-cond-expand info walk))447 (else448 (fprintf (current-error-port) "\nWarning (~a): property `~a' invalid or in wrong context (~a)\n\n" eggfile (car info) context))))449 (define (compile-data/include info)450 (case (car info)451 ((destination)452 (set! dest (->string (arg info 1 name?))))453 ((files)454 (set! files (append files (map ->string (cdr info)))))455 (else (compile-common info compile-data/include 'data/include))))456 (define (compile-options info)457 (define (custom info)458 (map (cut parse-custom-config eggfile <>) info))459 (case (car info)460 ((csc-options) (set! opts (apply append opts (custom (cdr info)))))461 ((link-options) (set! lopts (apply append lopts (custom (cdr info)))))462 ((linkage) (set! link (apply append link (custom (cdr info)))))463 (else (error "invalid component-options specification" info))))464 (define (compile-cond-expand info walk)465 (let loop ((clauses (cdr info)))466 (cond ((null? clauses)467 (error "no matching clause in `cond-expand' form"468 info))469 ((or (eq? 'else (caar clauses))470 (check-condition (caar clauses) mode link))471 (for-each walk (cdar clauses)))472 (else (loop (cdr clauses))))))473 (define (->dep x)474 (if (name? x)475 (if (symbol? x) x (string->symbol x))476 (error "invalid dependency" x)))477 (define (compile info)478 (case (car info)479 ((synopsis dependencies test-dependencies category version author maintainer480 license build-dependencies foreign-dependencies platform481 distribution-files) #f)482 ((custom-build)483 (set! custom-egg-build (arg info 1 name?)))484 ((components) (for-each compile-component (cdr info)))485 ((component-options)486 (for-each compile-options (cdr info)))487 (else (compile-common info compile 'toplevel))))488 (define (arg info n #!optional (pred (constantly #t)))489 (when (< (length info) n)490 (error "missing argument" info n))491 (let ((x (list-ref info n)))492 (unless (pred x)493 (error "argument has invalid type" x))494 x))495 (define (name? x) (or (string? x) (symbol? x)))496 (define dep=? equal?)497 (define (filter pred lst)498 (cond ((null? lst) '())499 ((pred (car lst)) (cons (car lst) (filter pred (cdr lst))))500 (else (filter pred (cdr lst)))))501 (define (filter-deps name deps)502 (filter (lambda (dep)503 (and (symbol? dep)504 (or (assq dep exts)505 (assq dep objs)506 (assq dep data)507 (assq dep cinc)508 (assq dep scminc)509 (assq dep genfiles)510 (assq dep prgs)511 (error "unknown component dependency" dep))))512 deps))513 ;; collect information514 (for-each compile info)515 ;; sort topologically, by dependencies516 (let* ((all (append prgs exts objs genfiles))517 (order (reverse (sort-dependencies518 (map (lambda (dep)519 (cons (car dep)520 (filter-deps (car dep)521 (get-keyword dependencies: (cdr dep)))))522 all)523 dep=?))))524 ;; generate + return build/install commands525 (values526 ;; build commands527 (if custom-egg-build528 (list (lambda _ (print "\nsh " (qs* custom-egg-build))))529 (append-map530 (lambda (id)531 (cond ((assq id exts) =>532 (lambda (data)533 (let ((link (get-keyword linkage: (cdr data)))534 (mods (get-keyword modules: (cdr data))))535 (append (if (memq 'dynamic link)536 (list (apply compile-dynamic-extension data))537 '())538 (if (memq 'static link)539 ;; if compiling both static + dynamic, override540 ;; modules/types-file/inline-file properties to541 ;; avoid generating things twice:542 (list (apply compile-static-extension543 (if (memq 'dynamic link)544 (cons (car data)545 (append '(modules: #f546 types-file: #f547 inline-file: #f)548 (cdr data)))549 data)))550 '())551 (if (uses-compiled-import-library? mode)552 (map (lambda (mod)553 (apply compile-import-library554 mod (cdr data))) ; override name555 mods)556 '())))))557 ((assq id prgs) =>558 (lambda (data)559 (let ((link (get-keyword linkage: (cdr data))))560 (append (if (memq 'dynamic link)561 (list (apply compile-dynamic-program data))562 '())563 (if (memq 'static link)564 (list (apply compile-static-program data))565 '())))))566 ((assq id objs) =>567 (lambda (data)568 (let ((link (get-keyword linkage: (cdr data))))569 (append (if (memq 'dynamic link)570 (list (apply compile-dynamic-object data))571 '())572 (if (memq 'static link)573 (list (apply compile-static-object data))574 '())))))575 ((assq id genfiles) =>576 (lambda (data)577 (list (apply compile-generated-file data))))578 ((or (assq id data)579 (assq id cinc)580 (assq id scminc))581 '()) ;; nothing to build for data components582 (else (error "Error in chicken-install, don't know how to build component" id))))583 order))584 ;; installation commands585 (append586 (append-map587 (lambda (ext)588 (let ((link (get-keyword linkage: (cdr ext)))589 (mods (get-keyword modules: (cdr ext))))590 (append591 (if (memq 'static link)592 (list (apply install-static-extension ext))593 '())594 (if (memq 'dynamic link)595 (list (apply install-dynamic-extension ext))596 '())597 (if (and (memq 'dynamic link)598 (uses-compiled-import-library? (get-keyword mode: ext)))599 (map (lambda (mod)600 (apply install-import-library601 mod (cdr ext))) ; override name602 mods)603 (map (lambda (mod)604 (apply install-import-library-source605 mod (cdr ext))) ; s.a.606 mods))607 (if (get-keyword types-file: (cdr ext))608 (list (apply install-types-file ext))609 '())610 (if (get-keyword inline-file: (cdr ext))611 (list (apply install-inline-file ext))612 '()))))613 exts)614 (map (lambda (obj) (apply install-object obj)) objs)615 (map (lambda (prg) (apply install-program prg)) prgs)616 (map (lambda (data) (apply install-data data)) data)617 (map (lambda (cinc) (apply install-c-include cinc)) cinc)618 (map (lambda (scminc) (apply install-data scminc)) scminc))619 ;; augmented egg-info620 (append `((installed-files ,@ifiles))621 (if version `((version ,version)) '())622 info)))))623624625;;; shell code generation - build operations626627(define ((compile-static-extension name #!key mode dependencies628 source-dependencies629 source (options '())630 predefined-types eggfile custom-egg-build631 link-objects modules632 custom types-file inline-file)633 srcdir platform)634 (let* ((cmd (or (custom-cmd custom srcdir platform)635 default-csc))636 (sname (prefix srcdir name))637 (tfile (prefix srcdir (conc types-file ".types")))638 (ifile (prefix srcdir (conc inline-file ".inline")))639 (lfile (conc sname +link-file-extension+))640 (opts (append (if (null? options)641 default-static-compilation-options642 options)643 (if (and types-file644 (not predefined-types))645 (list "-emit-types-file" tfile)646 '())647 (if inline-file648 (list "-emit-inline-file" ifile)649 '())))650 (out1 (conc sname ".static"))651 (out2 (target-file (conc out1652 (object-extension platform))653 mode))654 (out3 (if (null? link-objects)655 out2656 (target-file (conc out1657 (archive-extension platform))658 mode)))659 (imps (map (lambda (m)660 (prefix srcdir (conc m ".import.scm")))661 (or modules '())))662 (targets (append (list out3 lfile)663 (maybe types-file tfile)664 (maybe inline-file ifile)665 imps))666 (src (or source (conc name ".scm"))))667 (when custom668 (prepare-custom-command cmd platform))669 (print-build-command targets670 `(,@(filelist srcdir source-dependencies) ,src ,eggfile671 ,@(if custom-egg-build (list custom-egg-build) '())672 ,@(if custom (list cmd) '())673 ,@(get-dependency-targets dependencies))674 `(,@(if custom '("sh") '())675 ,cmd ,@(if keep-generated-files '("-k") '())676 "-regenerate-import-libraries"677 ,@(if modules '("-J") '()) "-M"678 "-setup-mode" "-static" "-I" ,srcdir679 "-emit-link-file" ,lfile680 ,@(if (eq? mode 'host) '("-host") '())681 "-D" "compiling-extension"682 "-c" "-unit" ,name683 "-D" "compiling-static-extension"684 "-C" ,(conc "-I" srcdir)685 ,@opts ,src "-o" ,out2)686 platform)687 (when (pair? link-objects)688 (let ((lobjs (filelist srcdir689 (map (cut conc <> ".static" (object-extension platform))690 link-objects))))691 (print-build-command (list out3)692 `(,out2 ,@lobjs)693 `(,target-librarian ,target-librarian-options ,out3 ,out2 ,@lobjs)694 platform)))695 (print-end-command platform)))696697(define ((compile-dynamic-extension name #!key mode mode dependencies698 source (options '())699 (link-options '())700 predefined-types eggfile custom-egg-build701 link-objects702 source-dependencies modules703 custom types-file inline-file)704 srcdir platform)705 (let* ((cmd (or (custom-cmd custom srcdir platform)706 default-csc))707 (sname (prefix srcdir name))708 (tfile (prefix srcdir (conc types-file ".types")))709 (ifile (prefix srcdir (conc inline-file ".inline")))710 (opts (append (if (null? options)711 default-dynamic-compilation-options712 options)713 (if (and types-file714 (not predefined-types))715 (list "-emit-types-file" tfile)716 '())717 (if inline-file718 (list "-emit-inline-file" ifile)719 '())))720 (out (target-file (conc sname ".so") mode))721 (src (or source (conc name ".scm")))722 (lobjs (map (lambda (lo)723 (target-file (conc lo724 (object-extension platform))725 mode))726 link-objects))727 (imps (map (lambda (m)728 (prefix srcdir (conc m ".import.scm")))729 modules))730 (targets (append (list out)731 (maybe inline-file ifile)732 (maybe (and types-file733 (not predefined-types)) tfile)734 imps)))735 (add-dependency-target name out)736 (when custom737 (prepare-custom-command cmd platform))738 (print-build-command targets739 `(,src ,eggfile ,@(if custom (list cmd) '())740 ,@(if custom-egg-build (list custom-egg-build) '())741 ,@(filelist srcdir lobjs)742 ,@(filelist srcdir source-dependencies)743 ,@(get-dependency-targets dependencies))744 `(,@(if custom '("sh") '())745 ,cmd ,@(if keep-generated-files '("-k") '())746 ,@(if (eq? mode 'host) '("-host") '())747 "-D" "compiling-extension"748 "-J" "-s" "-regenerate-import-libraries"749 "-setup-mode" "-I" ,srcdir750 "-C" ,(conc "-I" srcdir)751 ,@opts752 ,@link-options753 ,src754 ,@(filelist srcdir lobjs)755 "-o" ,out)756 platform)757 (print-end-command platform)))758759(define ((compile-import-library name #!key mode760 source-dependencies761 (options '()) (link-options '()))762 srcdir platform)763 (let* ((cmd default-csc)764 (sname (prefix srcdir name))765 (opts (if (null? options)766 default-import-library-compilation-options767 options))768 (out (target-file (conc sname ".import.so") mode))769 (src (conc name ".import.scm")))770 (print-build-command (list out)771 ;; TODO: eggfile not part of dependencies?772 `(,src #;,eggfile ,@(filelist srcdir source-dependencies))773 `(,cmd ,@(if keep-generated-files '("-k") '())774 "-setup-mode" "-s"775 ,@(if (eq? mode 'host) '("-host") '())776 "-I" ,srcdir "-C" ,(conc "-I" srcdir)777 ,@opts ,@link-options778 ,src779 "-o" ,out)780 platform)781 (print-end-command platform)))782783(define ((compile-static-object name #!key mode dependencies784 source-dependencies785 source (options '())786 eggfile custom-egg-build custom)787 srcdir platform)788 (let* ((cmd (or (custom-cmd custom srcdir platform)789 default-csc))790 (sname (prefix srcdir name))791 (ssname (and source (prefix srcdir source)))792 (opts (if (null? options)793 default-static-compilation-options794 options))795 (out (target-file (conc sname796 ".static"797 (object-extension platform))798 mode))799 (src (or ssname (conc sname ".c"))))800 (when custom801 (prepare-custom-command cmd platform))802 (print-build-command (list out)803 `(,@(filelist srcdir source-dependencies) ,src ,eggfile804 ,@(if custom-egg-build (list custom-egg-build) '())805 ,@(if custom (list cmd) '())806 ,@(get-dependency-targets dependencies))807 `(,@(if custom '("sh") '())808 ,cmd "-setup-mode" "-static" "-I" ,srcdir809 ,@(if (eq? mode 'host) '("-host") '())810 "-c" "-C" ,(conc "-I" srcdir)811 ,@opts ,src "-o" ,out)812 platform)813 (print-end-command platform)))814815(define ((compile-dynamic-object name #!key mode mode dependencies816 source (options '())817 eggfile custom-egg-build818 source-dependencies819 custom)820 srcdir platform)821 (let* ((cmd (or (custom-cmd custom srcdir platform)822 default-csc))823 (opts (if (null? options)824 default-dynamic-compilation-options825 options))826 (sname (prefix srcdir name))827 (ssname (and source (prefix srcdir source)))828 (out (target-file (conc sname829 (object-extension platform))830 mode))831 (src (or ssname (conc sname ".c"))))832 (add-dependency-target name out)833 (when custom834 (prepare-custom-command cmd platform))835 (print-build-command (list out)836 `(,src ,eggfile ,@(if custom (list cmd) '())837 ,@(if custom-egg-build (list custom-egg-build) '())838 ,@(filelist srcdir source-dependencies)839 ,@(get-dependency-targets dependencies))840 `(,@(if custom '("sh") '())841 ,cmd "-setup-mode"842 ,@(if (eq? mode 'host) '("-host") '())843 "-s" "-c" "-C" ,(conc "-I" srcdir)844 ,@opts ,src "-o" ,out)845 platform)846 (print-end-command platform)))847848(define ((compile-dynamic-program name #!key source mode dependencies849 (options '()) (link-options '())850 source-dependencies custom-egg-build851 custom eggfile link-objects)852 srcdir platform)853 (let* ((cmd (or (custom-cmd custom srcdir platform)854 default-csc))855 (sname (prefix srcdir name))856 (opts (if (null? options)857 default-dynamic-compilation-options858 options))859 (out (target-file (conc sname860 (executable-extension platform))861 mode))862 (lobjs (map (lambda (lo)863 (target-file (conc lo864 (object-extension platform))865 mode))866 link-objects))867 (src (or source (conc name ".scm"))))868 (when custom869 (prepare-custom-command cmd platform))870 (print-build-command (list out)871 `(,src ,eggfile ,@(if custom (list cmd) '())872 ,@(if custom-egg-build (list custom-egg-build) '())873 ,@(filelist srcdir source-dependencies)874 ,@(filelist srcdir lobjs)875 ,@(get-dependency-targets dependencies))876 `(,@(if custom '("sh") '())877 ,cmd ,@(if keep-generated-files '("-k") '())878 "-setup-mode"879 ,@(if (eq? mode 'host) '("-host") '())880 "-I" ,srcdir881 "-C" ,(conc "-I" srcdir)882 ,@opts ,@link-options ,src883 ,@(filelist srcdir lobjs)884 "-o" ,out)885 platform)886 (print-end-command platform)))887888(define ((compile-static-program name #!key source dependencies889 (options '()) (link-options '())890 source-dependencies custom-egg-build891 custom mode eggfile link-objects)892 srcdir platform)893 (let* ((cmd (or (custom-cmd custom srcdir platform)894 default-csc))895 (sname (prefix srcdir name))896 (opts (if (null? options)897 default-static-compilation-options898 options))899 (out (target-file (conc sname900 (executable-extension platform))901 mode))902 (lobjs (map (lambda (lo)903 (target-file (conc lo904 (object-extension platform))905 mode))906 link-objects))907 (src (or source (conc name ".scm"))))908 (when custom909 (prepare-custom-command cmd platform))910 (print-build-command (list out)911 `(,src ,eggfile ,@(if custom (list cmd) '())912 ,@(if custom-egg-build (list custom-egg-build) '())913 ,@(filelist srcdir lobjs)914 ,@(filelist srcdir source-dependencies)915 ,@(get-dependency-targets dependencies))916 `(,@(if custom '("sh") '())917 ,cmd ,@(if keep-generated-files '("-k") '())918 ,@(if (eq? mode 'host) '("-host") '())919 "-static" "-setup-mode" "-I" ,srcdir920 "-C" ,(conc "-I" srcdir)921 ,@opts ,@link-options ,src922 ,@(filelist srcdir lobjs)923 "-o" ,out)924 platform)925 (print-end-command platform)))926927(define ((compile-generated-file name #!key source custom dependencies928 source-dependencies eggfile custom-egg-build)929 srcdir platform)930 (let ((cmd (custom-cmd custom srcdir platform))931 (out (or source name)))932 (add-dependency-target name out)933 (prepare-custom-command cmd platform)934 (print-build-command (list out)935 (append936 (if custom-egg-build (list custom-egg-build) '())937 (filelist srcdir source-dependencies)938 (get-dependency-targets dependencies))939 `("sh" ,cmd ,eggfile)940 platform)941 (print-end-command platform)))942943944;; installation operations945946(define ((install-static-extension name #!key mode output-file947 link-objects)948 srcdir platform)949 (let* ((cmd (install-file-command platform))950 (mkdir (mkdir-command platform))951 (ext (if (null? link-objects)952 (object-extension platform)953 (archive-extension platform)))954 (sname (prefix srcdir name))955 (out (qs* (target-file (conc sname ".static" ext) mode)))956 (outlnk (qs* (conc sname +link-file-extension+)))957 (dest (effective-destination-repository mode))958 (dfile (qs* dest))959 (ddir (shell-variable "DESTDIR")))960 (print "\n" mkdir " " ddir dfile)961 (print cmd " " out " " ddir962 (qs* (conc dest "/" output-file ext)))963 (print cmd " " outlnk " " ddir964 (qs* (conc dest "/" output-file +link-file-extension+)))965 (print-end-command platform)))966967(define ((install-dynamic-extension name #!key mode (ext ".so")968 output-file)969 srcdir platform)970 (let* ((cmd (install-executable-command platform))971 (mkdir (mkdir-command platform))972 (sname (prefix srcdir name))973 (out (qs* (target-file (conc sname ext) mode)))974 (dest (effective-destination-repository mode))975 (dfile (qs* dest))976 (ddir (shell-variable "DESTDIR"))977 (destf (qs* (conc dest "/" output-file ext))))978 (print "\n" mkdir " " ddir dfile)979 (print cmd " " out " " ddir destf)980 (print-end-command platform)))981982(define ((install-import-library name #!key mode)983 srcdir platform)984 ((install-dynamic-extension name mode: mode ext: ".import.so"985 output-file: name)986 srcdir platform))987988(define ((install-import-library-source name #!key mode)989 srcdir platform)990 (let* ((cmd (install-file-command platform))991 (mkdir (mkdir-command platform))992 (sname (prefix srcdir name))993 (out (qs* (target-file (conc sname ".import.scm") mode)))994 (dest (effective-destination-repository mode))995 (dfile (qs* dest))996 (ddir (shell-variable "DESTDIR")))997 (print "\n" mkdir " " ddir dfile)998 (print cmd " " out " " ddir999 (qs* (conc dest "/" name ".import.scm")))1000 (print-end-command platform)))10011002(define ((install-types-file name #!key mode types-file)1003 srcdir platform)1004 (let* ((cmd (install-file-command platform))1005 (mkdir (mkdir-command platform))1006 (out (qs* (prefix srcdir (conc types-file ".types"))))1007 (dest (effective-destination-repository mode))1008 (dfile (qs* dest))1009 (ddir (shell-variable "DESTDIR")))1010 (print "\n" mkdir " " ddir dfile)1011 (print cmd " " out " " ddir1012 (qs* (conc dest "/" types-file ".types")))1013 (print-end-command platform)))10141015(define ((install-inline-file name #!key mode inline-file)1016 srcdir platform)1017 (let* ((cmd (install-file-command platform))1018 (mkdir (mkdir-command platform))1019 (out (qs* (prefix srcdir (conc inline-file ".inline"))))1020 (dest (effective-destination-repository mode))1021 (dfile (qs* dest))1022 (ddir (shell-variable "DESTDIR")))1023 (print "\n" mkdir " " ddir dfile)1024 (print cmd " " out " " ddir1025 (qs* (conc dest "/" inline-file ".inline")))1026 (print-end-command platform)))10271028(define ((install-program name #!key mode output-file) srcdir platform)1029 (let* ((cmd (install-executable-command platform))1030 (mkdir (mkdir-command platform))1031 (ext (executable-extension platform))1032 (sname (prefix srcdir name))1033 (out (qs* (target-file (conc sname ext) mode)))1034 (dest (if (eq? mode 'target)1035 default-bindir1036 (override-prefix "/bin" host-bindir)))1037 (dfile (qs* dest))1038 (ddir (shell-variable "DESTDIR"))1039 (destf (qs* (conc dest "/" output-file ext))))1040 (print "\n" mkdir " " ddir dfile)1041 (print cmd " " out " " ddir destf)1042 (print-end-command platform)))10431044(define ((install-object name #!key mode output-file install) srcdir platform)1045 (when install1046 (let* ((cmd (install-file-command platform))1047 (mkdir (mkdir-command platform))1048 (ext (object-extension platform))1049 (sname (prefix srcdir name))1050 (out (qs* (target-file (conc sname ext) mode)))1051 (dest (effective-destination-repository mode))1052 (dfile (qs* dest))1053 (ddir (shell-variable "DESTDIR")))1054 (print "\n" mkdir " " ddir dfile)1055 (print cmd " " out " " ddir1056 (qs* (conc dest "/" output-file ext)))1057 (print-end-command platform))))10581059(define (install-random-files dest files mode srcdir platform)1060 (let* ((fcmd (install-file-command platform))1061 (dcmd (copy-directory-command platform))1062 (root (string-append srcdir "/"))1063 (mkdir (mkdir-command platform))1064 (sfiles (map (cut prefix srcdir <>) files))1065 (dfile (qs* dest))1066 (ddir (shell-variable "DESTDIR")))1067 (print "\n" mkdir " " ddir dfile)1068 (let-values (((ds fs) (partition directory? sfiles)))1069 (for-each1070 (lambda (d)1071 (let* ((ds (strip-dir-prefix srcdir d))1072 (fdir (pathname-directory ds)))1073 (when fdir1074 (print mkdir " " ddir1075 (qs* (make-pathname dest fdir))))1076 (print dcmd " " (qs* d)1077 " " ddir1078 (if fdir1079 (qs* (make-pathname dest fdir))1080 dfile))1081 (print-end-command platform)))1082 ds)1083 (when (pair? fs)1084 (for-each1085 (lambda (f)1086 (let* ((fs (strip-dir-prefix srcdir f))1087 (fdir (pathname-directory fs)))1088 (when fdir1089 (print mkdir " " ddir1090 (qs* (make-pathname dest fdir))))1091 (print fcmd " " (qs* f)1092 " " ddir1093 (if fdir1094 (qs* (make-pathname dest fdir))1095 dfile)))1096 (print-end-command platform))1097 fs)))))10981099(define ((install-data name #!key files destination mode)1100 srcdir platform)1101 (install-random-files (or destination1102 (if (eq? mode 'target)1103 default-sharedir1104 (override-prefix "/share"1105 host-sharedir)))1106 files mode srcdir platform))11071108(define ((install-c-include name #!key deps files destination mode)1109 srcdir platform)1110 (install-random-files (or destination1111 (if (eq? mode 'target)1112 default-incdir1113 (override-prefix "/include"1114 host-incdir)))1115 files mode srcdir platform))11161117;; manage dependency-targets11181119(define (add-dependency-target target output)1120 (cond ((assq target dependency-targets) =>1121 (lambda (a)1122 (set-cdr! a output)))1123 (else (set! dependency-targets1124 (cons (cons target output) dependency-targets)))))11251126(define (get-dependency-targets targets)1127 (append-map1128 (lambda (t)1129 (cond ((assq t dependency-targets) => (lambda (a) (list (cdr a))))1130 (else '())))1131 targets))113211331134;;; Generate shell or batch commands from abstract build/install operations11351136(define (generate-shell-commands platform cmds dest srcdir prefix suffix keep)1137 (fluid-let ((keep-generated-files keep))1138 (with-output-to-file dest1139 (lambda ()1140 (prefix platform)1141 (print (cd-command platform) " " (qs* srcdir))1142 (for-each1143 (lambda (cmd) (cmd srcdir platform))1144 cmds)1145 (suffix platform)))))114611471148;;; affixes for build- and install-scripts11491150(define ((build-prefix mode name info) platform)1151 (printf #<<EOF1152#!/bin/sh~%1153set -e1154PATH=~a:$PATH1155export CHICKEN_CC=~a1156export CHICKEN_CXX=~a1157export CHICKEN_CSC=~a1158export CHICKEN_CSI=~a11591160EOF1161 (qs* default-bindir) (qs* default-cc)1162 (qs* default-cxx) (qs* default-csc)1163 (qs* default-csi)))11641165(define ((build-suffix mode name info) platform)1166 (printf #<<EOF1167EOF1168 ))11691170(define ((install-prefix mode name info) platform)1171 (printf #<<EOF1172#!/bin/sh~%1173set -e11741175EOF1176 ))11771178(define ((install-suffix mode name info) platform)1179 (let* ((infostr (with-output-to-string (cut pp info)))1180 (dcmd (remove-file-command platform))1181 (mkdir (mkdir-command platform))1182 (dir (destination-repository mode))1183 (qdir (qs* dir))1184 (dest (qs* (make-pathname dir name +egg-info-extension+)))1185 (ddir (shell-variable "DESTDIR")))1186 (printf #<<EOF11871188~a ~a~a1189~a ~a~a1190cat >~a~a <<'ENDINFO'1191~aENDINFO~%1192EOF1193 mkdir ddir qdir1194 dcmd ddir dest1195 ddir dest infostr)))11961197;;; some utilities for mangling + quoting11981199(define (qs* arg)1200 (qs (->string arg)))12011202(define (prefix dir name)1203 (make-pathname dir (->string name)))12041205(define (system+ str platform)1206 (system (if (eq? platform 'windows)1207 (string-append "sh -c \"" str "\"")1208 str)))12091210(define (target-file fname mode)1211 (if (eq? mode 'target) (string-append fname ".target") fname))12121213(define (joins strs platform)1214 (string-intersperse (map qs* strs) " "))12151216(define (filelist dir lst)1217 (map (cut prefix dir <>) lst))12181219(define (shell-variable var)1220 (string-append "\"${" var "}\""))12211222(define prepare-custom-command void)12231224(define (custom-cmd custom srcdir platform)1225 (and custom (prefix srcdir custom)))12261227(define (print-build-command targets sources command-and-args platform)1228 (print "\n" (qs* default-builder) " "1229 (joins targets platform)1230 " : " (joins sources platform) " "1231 " : " (joins command-and-args platform)))12321233(define print-end-command void)12341235(define (strip-dir-prefix prefix fname)1236 (let* ((plen (string-length prefix))1237 (p1 (substring fname 0 plen)))1238 (assert (string=? prefix p1) "wrong prefix" prefix p1)1239 (substring fname (add1 plen))))12401241(define (maybe f x) (if f (list x) '()))12421243(define (ensure-line-limit str lim)1244 (when (>= (string-length str) lim)1245 (error "line length exceeds platform limit: " str))1246 str)