source: project/bloom-filter/setup-header.scm @ 5443

;;;; setup-header.scm
;;;; Kon Lovett, May '06

(required-chicken-version 2.5)

;;; Constants & Procedures

(define REPOSITORY-DIRECTORY (repository-path))

(define *version* (if (file-exists? "version") (string-chomp (read-all "version") "\n") "trunk"))

;; These must be kept in synch w/ testbase-results.scm!

(define TESTBASE-DIRECTORY (make-pathname REPOSITORY-DIRECTORY "testbase"))

(define (->symbol obj)
  (cond
    [(symbol? obj)  obj]
    [(string? obj)  (string->symbol obj)]
    [else           (string->symbol (->string obj))]) )

;; Pathname Constructors

(define (make-filename bn . en)
  (apply make-pathname #f (->string bn) en) )

(define (make-docu-filename bn)
  (make-filename bn "html") )

(define (make-dynld-filename bn)
  (make-filename bn ##sys#load-dynamic-extension) )

(define (make-static-filename bn)
  (make-filename bn "o") )

(define (make-source-filename bn)
  (make-filename bn "scm") )

(define (make-exports-filename bn)
  (make-filename bn "exports") )

(define (make-program-filename bn)
  (make-filename bn (and (eq? 'windows (software-type)) ".exe")) )

(define (make-repository-pathname bn)
  (make-pathname REPOSITORY-DIRECTORY bn) )

(define (make-program-pathname dn pn)
  (make-pathname dn (make-program-filename pn)) )

;;

#;
(define (installed-program-exists? bn)
  (or (file-exists? (make-program-pathname (program-path) bn))
      (file-exists? (make-program-pathname (installation-prefix) bn))) )

;; File Copy Operations

(define (*file-copy fn dn)
  (let ([fn (->string fn)])
    (copy-file fn (make-pathname dn fn)) ) )

(define (copy-to-repository fn)
  (*file-copy (->string fn) REPOSITORY-DIRECTORY) )

(define (copy-to-shared fn)
  (*file-copy (->string fn) (chicken-home)) )

(define (copy-file-to-test-repository fn)
  (*file-copy (->string fn) TESTBASE-DIRECTORY) )

(define (copy-testbase-file bn)
  (copy-file-to-test-repository (make-pathname "tests" (->string bn))) )

;; Install TestBase related file(s)

(define (install-test . flnms)
  (newline)
  (print "* Installing TestBase Test-Files in " TESTBASE-DIRECTORY #\:)
  (for-each
    (lambda (x)
      (if (list? x)
        ; then has extra files (probably test data)
        (for-each copy-testbase-file x)
        ; else test is self contained
        (copy-testbase-file x) ) )
    flnms) )

;; Options Parsing

(define (parse-install-arguments ver opt)
  ;
  (set! ver
    (cond
      [(string? ver)  ver]
      [(symbol? ver)  (eval ver)]
      [(number? ver)  (number->string ver)]
      [else           (error "invalid install version argument" ver)]))
  ;
  (let ([cmp-args '()] [rqr@run '()] [opt-args '()])
    (let loop ([lst opt])
      (if (null? lst)
        (values ver (reverse cmp-args) rqr@run opt-args)
        (let ([itm (car lst)])
          (cond
            [(pair? itm)
              (if (eq? 'require-at-runtime (car itm))
                (set! rqr@run (append (cdr itm) rqr@run))
                (set! opt-args (cons itm opt-args)) )]
            [(symbol? itm)
              (let ([str (symbol->string itm)])
                (if (char=? #\+ (string-ref str 0))
                  (set! cmp-args
                    (append
                      `(,(string->symbol (substring str 1)) -extend)
                      cmp-args))
                  (set! cmp-args (cons itm cmp-args)) ) )]
            [(atom? itm)
              (set! cmp-args (cons itm cmp-args))]
            [else
              (set! opt-args (cons itm opt-args))])
          (loop (cdr lst)) )) ) ) )

;;; Operation Macros

;; Note that these can accept quasi-stuff in OPT

(define-macro (compile-dynld DYNFIL . OPT)
  `(compile
    -s
    -O2 -d1
    ,(make-source-filename DYNFIL)
    -o ,(make-dynld-filename DYNFIL)
    -check-imports -emit-exports ,(make-exports-filename DYNFIL)
    ,@OPT) )

(define-macro (compile-dynld/rename SRCDYNFIL OUTDYNFIL . OPT)
  `(compile
    -s
    -O2 -d1
    ,(make-source-filename SRCDYNFIL)
    -o ,(make-dynld-filename OUTDYNFIL)
    -check-imports -emit-exports ,(make-exports-filename OUTDYNFIL)
    ,@OPT) )

(define-macro (compile-static SRCSTAFIL . OPT)
  `(compile
    -c
    -O2 -d1
    ,(make-source-filename SRCSTAFIL)
    -unit ,SRCSTAFIL
    -o ,(make-static-filename SRCSTAFIL)
    -check-imports -emit-exports ,(make-exports-filename SRCSTAFIL)
    ,@OPT) )

(define-macro (compile-static/rename SRCSTAFIL OUTSTAFIL . OPT)
  `(compile
    -c
    -O2 -d1
    ,(make-source-filename SRCSTAFIL)
    -unit ,OUTSTAFIL
    -o ,(make-static-filename OUTSTAFIL)
    -check-imports -emit-exports ,(make-exports-filename OUTSTAFIL)
    ,@OPT) )

;; Note that these cannot accept quasi-stuff in OPT

(define-macro (install-dynld DYNFIL VER . OPT)
  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
    `(begin
      (compile-dynld ,DYNFIL ,@CMP-ARGS)
      (install-extension ',(->symbol DYNFIL)
        '(,(make-dynld-filename DYNFIL) )
        '(,@OPT-ARGS
          ,@(if (null? RQR@RUN) '() `((require-at-runtime ,@RQR@RUN)))
          (version ,VERSTR)
          (exports ,(make-exports-filename DYNFIL)) ) ) ) ) )

(define-macro (install-dynld+docu DYNFIL VER . OPT)
  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
    `(begin
      (compile-dynld ,DYNFIL ,@CMP-ARGS)
      (install-extension ',(->symbol DYNFIL)
        '(,(make-dynld-filename DYNFIL)
          ,(make-docu-filename DYNFIL) )
        '(,@OPT-ARGS
          ,@(if (null? RQR@RUN) '() `((require-at-runtime ,@RQR@RUN)))
          (documentation ,(make-docu-filename DYNFIL))
          (version ,VERSTR)
          (exports ,(make-exports-filename DYNFIL)) ) ) ) ) )

(define-macro (install-dynld+source DYNFIL VER . OPT)
  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
    `(begin
      (compile-dynld ,DYNFIL ,@CMP-ARGS)
      (install-extension ',(->symbol DYNFIL)
        '(,(make-dynld-filename DYNFIL)
          ,(make-source-filename DYNFIL) )
        '(,@OPT-ARGS
          ,@(if (null? RQR@RUN) '() `((require-at-runtime ,@RQR@RUN)))
          (version ,VERSTR)
          (exports ,(make-exports-filename DYNFIL)) ) ) ) ) )

(define-macro (install-dynld+source+docu DYNFIL VER . OPT)
  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
    `(begin
      (compile-dynld ,DYNFIL ,@CMP-ARGS)
      (install-extension ',(->symbol DYNFIL)
        '(,(make-dynld-filename DYNFIL)
          ,(make-source-filename DYNFIL)
          ,(make-docu-filename DYNFIL) )
        '(,@OPT-ARGS
          ,@(if (null? RQR@RUN) '() `((require-at-runtime ,@RQR@RUN)))
          (documentation ,(make-docu-filename DYNFIL))
          (version ,VERSTR)
          (exports ,(make-exports-filename DYNFIL)) ) ) ) ) )

(define-macro (install-syntax SYNFIL VER . OPT)
  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
    `(install-extension ',(->symbol SYNFIL)
      '(,(make-source-filename SYNFIL) )
      '(,@OPT-ARGS
        ,@(if (null? RQR@RUN) '() `((require-at-runtime ,@RQR@RUN)))
        (version ,VERSTR)
        (syntax) ) ) ) )

(define-macro (install-syntax+docu SYNFIL VER . OPT)
  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
    `(install-extension ',(->symbol SYNFIL)
      '(,(make-source-filename SYNFIL)
        ,(make-docu-filename SYNFIL) )
      '(,@OPT-ARGS
        ,@(if (null? RQR@RUN) '() `((require-at-runtime ,@RQR@RUN)))
        (version ,VERSTR)
        (documentation ,(make-docu-filename SYNFIL))
        (syntax) ) ) ) )

(define-macro (install-dynld+syntax SYNFIL DYNFIL VER . OPT)
  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
    `(begin
      (compile-dynld ,DYNFIL ,@CMP-ARGS)
      (install-extension ',(->symbol SYNFIL)
        '(,(make-source-filename SYNFIL)
          ,(make-dynld-filename DYNFIL) )
        '(,@OPT-ARGS
          (syntax)
          (require-at-runtime ,(->symbol DYNFIL) ,@RQR@RUN)
          (version ,VERSTR)
          (exports ,(make-exports-filename DYNFIL)) ) ) ) ) )

(define-macro (install-dynld+syntax+docu SYNFIL DYNFIL VER . OPT)
  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
    `(begin
      (compile-dynld ,DYNFIL ,@CMP-ARGS)
      (install-extension ',(->symbol SYNFIL)
        '(,(make-docu-filename SYNFIL)
          ,(make-source-filename SYNFIL)
          ,(make-dynld-filename DYNFIL) )
        '(,@OPT-ARGS
          (documentation ,(make-docu-filename SYNFIL))
          (syntax)
          (require-at-runtime ,(->symbol DYNFIL) ,@RQR@RUN)
          (version ,VERSTR)
          (exports ,(make-exports-filename DYNFIL)) ) ) ) ) )