src/devvars.lisp

   1
   2 ;V Just make the package exist here,     V
   3 ;V define its guts later in globals.lisp V
   4 (make-package :lineal)
   5
   6 (defpackage :lineal.devvars
   7   (:use :cl)
   8   (:export *src-tree* compile-if-new
   9            compile-tree load-tree))
  10
  11 (in-package :lineal.devvars)
  12
  13 (defparameter *src-tree*
  14   '(:relative
  15      ("math" "math" "tuples" "matrices" "row-operns" "format")
  16      ("overload" "overload" "numbers" "tuples"
  17       "matrices" "row-operns" "format" "concatenate" "crop")
  18      "globals"
  19      "parser"
  20      "save-restore"
  21                  ("overload" "client-fns")
  22      ("webui" "webvars" "compile-ps" "index" "matrixui"
  23       "calcupage" "save-restore" "reload")))
  24
  25 (defun load-tree (s &optional (dir nil))
  26         (if (listp s)
  27                 (progn
  28                         (setq dir `(,@dir ,(car s)))
  29                         (dolist (x (cdr s))
  30                                 (load-tree x dir)))
  31                 (load (make-pathname
  32             :directory dir :name s))))
  33
  34 (defun compile-if-new
  35         (str srcdir &optional (or-if-old nil)
  36                          &aux src-write fasl-write
  37                          (src-name (make-pathname
  38                    :directory srcdir
  39                    :name (concatenate 'string str ".lisp")))
  40                          (fasl-name (make-pathname
  41                     :directory srcdir
  42                     :name (concatenate 'string str ".fasl"))))
  43         ;V get source file's write time.V
  44         (with-open-file
  45                 (f src-name :if-does-not-exist nil)
  46                 (setq src-write (file-write-date f)))
  47         ;V get binary file's write time.V
  48         (with-open-file
  49                 (f fasl-name :if-does-not-exist nil)
  50                 (when f (setq fasl-write (file-write-date f))))
  51         ;V if needs refresh, do it.V
  52         (if (or or-if-old (not fasl-write) (not src-write)
  53                                         (< fasl-write src-write))
  54                 (compile-file src-name)
  55                 (load fasl-name)))
  56
  57 (defun compile-tree (s &optional (comp-old nil) (dir nil))
  58         (if (listp s)
  59                 (progn
  60                         (setq dir `(,@dir ,(car s)))
  61                         (dolist (x (cdr s))
  62                                 (compile-tree x comp-old dir)))
  63                 (compile-if-new s dir comp-old)))
  64
  65