From 99df26c9e640fc0cb39238dbb52fff0b3fdd3f5a Mon Sep 17 00:00:00 2001 From: Alex Klinkhamer Date: Fri, 13 Jun 2008 21:06:25 -0400 Subject: [PATCH] +Fasl generation, +Selective recompiling Instead of loading the whole source tree every startup and reload, just compare the source file with the corresponding fasl file to see if it needs compiling. Then load regardlessly. --- src/webui/devvars.lisp | 145 +++++++++++++++++++++++++++---------------------- src/webui/reload.lisp | 6 +- src/webui/serv.lisp | 6 +- 3 files changed, 87 insertions(+), 70 deletions(-) rewrite src/webui/devvars.lisp (94%) diff --git a/src/webui/devvars.lisp b/src/webui/devvars.lisp dissimilarity index 94% index 57b6258..6a814fc 100644 --- a/src/webui/devvars.lisp +++ b/src/webui/devvars.lisp @@ -1,64 +1,81 @@ - -(defpackage :lineal.devvars - (:use :cl) - (:export *src-tree* compile-if-new - compile-tree load-tree)) - -(in-package :lineal.devvars) - -(defparameter *src-tree* - '(:relative - ("src" - ("math" "math" "tuples" "matrices" "row-operns" "format") - ("overload" "overload" "numbers" "tuples" - "matrices" "row-operns" "format" "concatenate" "crop") - "globals" - "parser" - "save-restore" - ("overload" "client-fns") - ("webui" "webvars" "compile-ps" "index" "matrixui" - "calcupage" "save-restore" "reload")))) - -(defun load-tree (s &optional (dir nil)) - (if (listp s) - (progn - (setq dir `(,@dir ,(car s))) - (dolist (x (cdr s)) - (load-tree x dir))) - (load (make-pathname - :directory dir :name s)))) - -;;; The below compiling functions aren't used, -;;; they are probably a little bugged as well. -(defun compile-if-new - (str srcdir &optional (or-if-old nil) - &aux src-write fasl-write - (src-name (make-pathname - :directory srcdir - :name (concatenate 'string str ".lisp"))) - (fasl-name (make-pathname - :directory srcdir - :name (concatenate 'string str ".fasl")))) - ;V get source file's write time.V - (with-open-file - (f src-name :if-does-not-exist nil) - (setq src-write (file-write-date f))) - ;V get binary file's write time.V - (with-open-file - (f fasl-name :if-does-not-exist nil) - (when f (setq fasl-write (file-write-date f)))) - ;V if needs refresh, do it.V - (if (or or-if-old (not fasl-write) (not src-write) - (< fasl-write src-write)) - (compile-file src-name) - (load fasl-name))) - -(defun compile-tree (s &optional (comp-old nil) (dir nil)) - (if (listp s) - (progn - (setq dir `(,@dir ,(car s))) - (dolist (x (cdr s)) - (compile-tree x comp-old dir))) - (compile-if-new s dir comp-old))) - - + +(defpackage :lineal.devvars + (:use :cl) + (:export *file-tree* compile-tree compile-lineal)) + +(in-package :lineal.devvars) + +(defparameter *file-tree* + '(("math" "math" "tuples" "matrices" "row-operns" "format") + ("overload" "overload" "numbers" "tuples" + "matrices" "row-operns" "format" "concatenate" "crop") + "globals" + "parser" + "save-restore" + ("overload" "client-fns") + ("webui" "webvars" "compile-ps" "index" "matrixui" + "calcupage" "save-restore" "reload"))) + +(defun compile-if-new + (name src-dir + &optional (fasl-dir src-dir) + compile-all ensure-dirs + &aux + (src-file + (make-pathname :directory src-dir + :name name :type "lisp")) + (fasl-file + (make-pathname :directory fasl-dir + :name name :type "fasl"))) + (unless (and (not compile-all) + (probe-file fasl-file) + (< (file-write-date src-file) + (file-write-date fasl-file))) + (when ensure-dirs + (ensure-directories-exist fasl-file)) + (with-open-file + (fasl-strm fasl-file :direction :output + :if-exists :supersede) + (compile-file src-file :output-file fasl-strm))) + (load fasl-file)) + +(defun compile-tree + (file-tree src-base fasl-base + &optional compile-all + &aux src-dir fasl-dir) + (labels + ((ensure-first + (in-dir set-dirs-fn) + (funcall set-dirs-fn nil) + (recurse (car in-dir) set-dirs-fn t) + (dolist (x (cdr in-dir)) + (recurse x set-dirs-fn nil))) + (recurse + (file-tree set-dirs-fn ensure-dirs) + (if (consp file-tree) + (let ((tmp-src src-dir) + (tmp-fasl fasl-dir) + (dir (car file-tree))) + (ensure-first + (cdr file-tree) + (lambda (rootless) + (funcall set-dirs-fn + (cons dir rootless)))) + (setq src-dir tmp-src + fasl-dir tmp-fasl)) + ;V /file-tree/ is a file's name, V + ;V compile it if necessary. V + (compile-if-new + file-tree src-dir fasl-dir + compile-all ensure-dirs)))) + (ensure-first + file-tree + (lambda (rootless) + (setq src-dir (append src-base rootless) + fasl-dir (append fasl-base rootless)))))) + +(defun compile-lineal () + (compile-tree + *file-tree* '(:relative "src") + '(:relative "fasl"))) + diff --git a/src/webui/reload.lisp b/src/webui/reload.lisp index b78c9b9..9db30d9 100644 --- a/src/webui/reload.lisp +++ b/src/webui/reload.lisp @@ -1,7 +1,7 @@ (in-package :lineal.webui) -(defmacro reserve-shallow-copy ((&body args) . body) +(defmacro bind-reset ((&body args) . body) (let (tmp-lets s-sets) (loop :for a :in args :and b = (gentemp) @@ -17,10 +17,10 @@ ,s-sets)))) (defun fresheval () - (reserve-shallow-copy + (bind-reset (*saved-numbers* *saved-tuples* *saved-matrices*) ;V Do file loading.V - (load-tree *src-tree*) + (compile-lineal) ;V Compile the javascript files.V (recompile-ps))) diff --git a/src/webui/serv.lisp b/src/webui/serv.lisp index 7bb0f01..300e4d7 100644 --- a/src/webui/serv.lisp +++ b/src/webui/serv.lisp @@ -32,9 +32,9 @@ (format t "... ~A loaded.~%" pkg)) (list :hunchentoot :cl-who :parenscript)) -(format t "Loading source tree...~%") -;V Load all files.V -(load-tree *src-tree*) +(format t "Compiling and loading source tree...~%") +;V Compile and Load V +(compile-lineal) (format t "Generating JavaScript files if needed...~%") (lineal.webui::recompile-ps) -- 2.11.4.GIT