compile-stale

#!/usr/bin/env scheme-script

#!r7rs

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Compiles all .sld and .sls files that lie within the directory
;;; (and its subdirectories) from which this Scheme script is invoked.
;;;
;;; Compiling a large number of interdependent source files by
;;; hand is inconvenient because files must be compiled in an
;;; order consistent with their import dependencies:  Every
;;; compiled library must be compiled before any compiled
;;; files that import the library.
;;;
;;; If the files compiled by this script define libraries
;;; that are imported by compiled files that lie outside the
;;; directory from which this Scheme script is invoked, then
;;; those compiled files will become stale, which means those
;;; compiled files should be removed or replaced by freshly
;;; compiled files.
;;;
;;; Larceny refuses to execute compiled code from a stale
;;; file, because the compiled code in stale files may be
;;; dangerously inconsistent with the compiled code of
;;; libraries on which the stale file depends.
;;;
;;; KNOWN BUGS:
;;;
;;;     doesn't handle colon-separated directory lists
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(import (scheme base)
        (scheme cxr)
        (scheme file)
        (scheme process-context)
        (scheme list)
        (larceny compiler)
        (larceny parse-options))

(define cmds (command-line))

(call-with-values
 (lambda ()
   (larceny:parse-options (cddr cmds)
                          '((seq "-I" _)
                            (seq "-A" _)
                            (seq "-D" _))))
 (lambda (files opts-I opts-A opts-D)
   (let ((dirs-I   (map cadr opts-I))
         (dirs-A   (map cadr opts-A))
         (features (map cadr opts-D)))
     (parameterize ((current-require-path
                     (append dirs-I (current-require-path) dirs-A))
                    (larceny:current-declared-features
                     (append (larceny:current-declared-features)
                             features)))
      (if (every file-exists? files)
          (apply compile-stale files)
          (error "compile-stale: can't find some of these files"
                 files))))))