src/devvars.lisp

   1
   2 (defpackage :lineal.devvars
   3   (:use :cl)
   4   (:export *file-tree* compile-if-new compile-lineal))
   5
   6 (in-package :lineal.devvars)
   7
   8 ;;; When extending lineal, add files to this list.
   9 (defparameter *file-tree*
  10   '(("math" "math";<  :lineal.math
  11      :lineal.math "counting" "tuples"
  12      "matrices" "row-operns" "format")
  13     ("overload" "overload";<  :lineal.overload
  14      :lineal.overload "numbers" "tuples" "matrices")
  15     :lineal.overload
  16     ("util" "tails-do")
  17     ("overload" "concatenate" "crop" "row-operns" "format")
  18     "globals";<  :lineal
  19     :lineal
  20     "prefix-parser"
  21     "infix-parser"
  22     "save-restore"
  23     ("overload" :lineal.overload "client-fns")
  24     ))
  25
  26 (defun compile-if-new
  27   (name src-dir &key (fasl-dir src-dir)
  28         compile-all (load-all t) ensure-dirs
  29         &aux
  30         (src-file
  31           (make-pathname :directory src-dir
  32                          :name name :type "lisp"))
  33         (fasl-file
  34           (make-pathname :directory fasl-dir
  35                          :name name :type "fasl")))
  36   (if (and (not compile-all)
  37            (probe-file fasl-file)
  38            (< (file-write-date src-file)
  39               (file-write-date fasl-file)))
  40     (when load-all (load fasl-file))
  41     (progn
  42       (when ensure-dirs
  43         (ensure-directories-exist fasl-dir))
  44       (with-open-file
  45         (fasl-strm fasl-file :direction :output
  46                    :if-exists :supersede)
  47         (compile-file src-file :output-file fasl-strm))
  48       (load fasl-file))))
  49
  50 (defun compile-tree
  51   (file-tree src-dir fasl-dir
  52              &key compile-all (load-all t)
  53              &aux (src-tail (last src-dir))
  54              (fasl-tail (last fasl-dir)))
  55   (labels
  56     ((ensure-first
  57        (in-dir)
  58        (ensure-directories-exist
  59          (make-pathname :directory fasl-dir))
  60        (let ((*package* *package*))
  61          (dolist (x in-dir)
  62            (recurse x))))
  63      (recurse
  64        (file-tree)
  65        (ctypecase file-tree
  66          (cons
  67            ;; We have a new directory to recurse.
  68            (let ((tmp-src-tail src-tail)
  69                  (tmp-fasl-tail fasl-tail)
  70                  (dirtail (list (car file-tree))))
  71              (setq src-tail (setf (cdr src-tail) dirtail)
  72                    fasl-tail (setf (cdr fasl-tail) dirtail))
  73              (ensure-first (cdr file-tree))
  74              (setq src-tail (rplacd tmp-src-tail nil)
  75                    fasl-tail (rplacd tmp-fasl-tail nil))))
  76          (symbol
  77            ;; Use a different package
  78            ;; for loading subsequent files.
  79            (setq *package* (find-package file-tree)))
  80          (string
  81            ;; /file-tree/ is a file's name,
  82            ;; compile it if necessary.
  83            (compile-if-new
  84              file-tree src-dir
  85              :fasl-dir fasl-dir
  86              :compile-all compile-all
  87              :load-all load-all)))))
  88     (ensure-first file-tree)))
  89
  90 ;;; Just compile the whole program.
  91 (defun compile-lineal (&key compile-all (load-all t))
  92   (compile-tree
  93     *file-tree* '(:relative "src")
  94     '(:relative "fasl")
  95     :compile-all compile-all
  96     :load-all load-all))
  97