compile.lsp

(define basic-load load)

(define (file-exists? name)
  (let ((f (open-input-file name)))
    (when f
      (close-port f)
      #t)))

(define (load name)
  (let ((off (string-search "." name)))
    (if off
      (let ((ext (substring name off)))
        (if (string-ci=? ext ".fsl")
          (load-fasl-file name)
          (basic-load name)))
      (let ((full-name (string-append name ".fsl")))
        (if (file-exists? full-name)
          (load-fasl-file full-name)
          (basic-load (string-append name ".lsp")))))))
 
(define (compile-file name)
  (let* ((iname (string-append name ".lsp"))
         (oname (string-append name ".fsl"))
         (if (open-input-file iname))
         (of (open-output-file oname))
         (sts #f))
    (when (and if of)
      (let loop ((expr (read if)))
        (when (not (eof-object? expr))
          (let ((compiled-expr (compile expr)))
            (fasl-write-procedure compiled-expr of))
          (loop (read if))))
      (set! sts #t))
    (when if (close-port if))
    (when of (close-port of))
    sts))

(define (load-fasl-file name)
  (let ((if (open-input-file name)))
    (when if
      (let loop ((proc (fasl-read-procedure if)))
        (when (not (eof-object? proc))
          (proc)
          (loop (fasl-read-procedure if))))
      (close-port if)
      #t)))