~ chicken-core (master) /scripts/makedist.scm

  1;;;; makedist.scm - Make distribution tarballs
  2
  3
  4(import (chicken file)
  5        (chicken fixnum)
  6        (chicken format)
  7        (chicken io)
  8        (chicken irregex)
  9        (chicken pathname)
 10        (chicken platform)
 11        (chicken process)
 12        (chicken process-context)
 13        (chicken string))
 14
 15(include "mini-srfi-1.scm")
 16
 17(define *release* #f)
 18(define *help* #f)
 19
 20(define BUILDVERSION (with-input-from-file "buildversion" read))
 21
 22(define *platform*
 23  (let ((sv (symbol->string (software-version))))
 24    (cond ((irregex-match ".*bsd" sv) "bsd")
 25	  (else sv))))
 26
 27(define *make*
 28  (cond ((string=? "bsd" *platform*) "gmake")
 29	(else "make")))
 30
 31(define (prefix dir . files)
 32  (if (null? files)
 33      (pathname-directory dir)
 34      (let ((files2 (map (cut make-pathname dir <>) (normalize files))))
 35	(if (or (pair? (cdr files)) (pair? (car files)))
 36	    files2
 37	    (car files2) ) ) ) )
 38
 39(define (normalize fs)
 40  (delete-duplicates
 41   (map ->string
 42	(if (pair? fs)
 43	    (flatten fs)
 44	    (list fs) ) )
 45   equal?) )
 46
 47(define (run . args)
 48  (let ((cmd (apply format args)))
 49    (display cmd (current-error-port))
 50    (newline (current-error-port))
 51    (system* cmd)))
 52
 53(define (release full?)
 54  (let* ((files (with-input-from-file "distribution/manifest" read-lines))
 55	 (distname (conc "chicken-" BUILDVERSION))
 56	 (distfiles (map (cut prefix distname <>) files))
 57	 (tgz (conc distname ".tar.gz")))
 58    (run "rm -fr ~a ~a" distname tgz)
 59    (create-directory distname)
 60    (for-each
 61     (lambda (d)
 62       (let ((d (make-pathname distname d)))
 63	 (unless (file-exists? d)
 64	   (print "creating " d)
 65	   (create-directory d 'with-parents))))
 66     (delete-duplicates (filter-map prefix files) string=?))
 67    (let ((missing
 68	   (foldl (lambda (missing f)
 69		    (cond
 70		     ((file-exists? f)
 71		      (run "cp -p ~a ~a" (qs f) (qs (make-pathname distname f)))
 72		      missing)
 73		     (else (cons f missing))))
 74		  '() files)))
 75      (unless (null? missing)
 76	(warning "files missing" missing) ) )
 77    (run "tar cfz ~a ~a" (conc distname ".tar.gz") distname)
 78    (run "rm -fr ~a" distname)))
 79
 80(define (usage)
 81  (print "usage: makedist [-release] [-make PROGRAM] [--platform=PLATFORM] MAKEOPTION ...")
 82  (exit))
 83
 84(define *makeargs*
 85  (let loop ((args (command-line-arguments)))
 86    (if (null? args)
 87	'()
 88	(let ((arg (car args)))
 89	  (cond ((string=? "-release" arg)
 90		 (set! *release* #t)
 91		 (loop (cdr args)))
 92		((string=? "-make" arg)
 93		 (set! *make* (cadr args))
 94		 (loop (cddr args)))
 95		((string=? "-help" arg)
 96		 (usage))
 97		((string=? "-platform" arg)
 98		 (set! *platform* (cadr args))
 99		 (loop (cddr args)))
100		(else (cons arg (loop (cdr args)))))))))
101
102(run "~a -f Makefile.~a distfiles ~a" *make* *platform* (string-intersperse *makeargs*))
103
104(release *release*)