#!/usr/bin/csi -s (use extras posix matchable) (import (only setup-api remove-directory)) (include "chicken-env") (define (printf-error msg . args) (display "ERROR: " (current-error-port)) (apply fprintf (current-error-port) msg args) (newline (current-error-port))) (define (printf-newline msg . args) (apply printf msg args) (newline)) (define (usage #!optional (print printf-newline)) (print "Usage: ~A [OPTION ...] NAME Build Chicken in current directory and install it to $CHICKENS/NAME. Options: -b, --bootstrap build and use a bootstrap Chicken -c, --chicken CHICKEN_NAME use $CHICKENS/CHICKEN_NAME/bin/chicken for compiling -d, --debug make a debug build -h, --help show this help" (pathname-file (program-name)))) (define build-boot-chicken? #f) (define debug-build? #f) (define chicken-name #f) (define chicken-bin #f) (when (null? (command-line-arguments)) (usage fail)) (let loop ((args (command-line-arguments))) (match args (((or "-b" "--bootstrap") rest ...) (set! build-boot-chicken? #t) (loop rest)) (((or "-d" "--debug") rest ...) (set! debug-build? #t) (loop rest)) (((or "-c" "--chicken") rest ...) (when (null? rest) (printf-error "Missing argument for -c~%") (usage fail)) (set! chicken-bin (make-pathname chicken-coop (car rest))) (loop (cdr rest))) (((or "-h" "--help") rest ...) (usage) (exit)) ((name) (=> skip) (if (equal? #\- (string-ref name 0)) (skip) (set! chicken-name name))) (rest (unless (null? rest) (printf-error "Invalid arguments: ~S~%" rest) (usage fail))))) (assert-chicken-coop-exists) (unless chicken-name (printf-error "Missing NAME~%") (usage fail)) (when (and build-boot-chicken? chicken-bin) (printf-error "Can't set both -b and -c at the same time ") (exit 1)) (when (equal? chicken-link chicken-name) (printf-error "Invalid installation name: ~S" chicken-name) (exit 1)) (define chicken-path (normalize-pathname (make-pathname chicken-coop chicken-name))) (define (run name . args) (receive (pid success? status) (process-wait (process-run name args)) (unless (and success? (zero? status)) (exit 1)))) (define purge? #f) (when (file-exists? chicken-path) (printf "Chicken already exists: ~A" chicken-path) (if (yes-or-no? "Continue? This will purge the existing directory before installation." #f #f exit) (set! purge? #t) (exit))) (when build-boot-chicken? (run "make" "boot-chicken") (setenv "CHICKEN" "./chicken-boot")) (when chicken-bin (setenv "CHICKEN" chicken-bin)) (when debug-build? (setenv "DEBUGBUILD" "1")) (setenv "PREFIX" chicken-path) (run "make") (when purge? (remove-directory chicken-path)) (create-directory chicken-path) (run "make" "install")