;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - NFS Share File - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Defsys for vags
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package :user)

(defvar *supressed-warnings* nil)

(setq *supressed-warnings*
	'("Variable ~S is bound but not referenced"))

(defmacro with-supressed-warnings (&rest body)
  `(let ((warn-fun #'warn)
	 (ret nil))
     (unwind-protect
	 (progn
	   (setf (symbol-function 'warn)
		 #'(lambda (format &rest args)
		     (if (not (member format *supressed-warnings*
				      :test #'string=))
			 (apply warn-fun (cons format args)))))
	   (setq ret (progn ,@body)))
       (setf (symbol-function 'warn) warn-fun))
     ret))

(defvar *files*
  '("util" "undo" "vag" "vag2"))
	
(defun source-file-name (file)
  (concatenate 'string file ".lisp"))

(defun binary-file-name (file)
  (concatenate 'string file
	       #+lucid ".sbin"
	       #+cmu ".sparcf"
	       #+allegro ".fasl"
	       #+akcl ".o"
	       #-(or lucid cmu allegro akcl) (error "Unknown system type")))

(defun load-files (files &key force-binary)
  (mapc #'(lambda (x)
	    (if force-binary
		(load (binary-file-name x))
		(let ((bin-date (file-write-date (binary-file-name x)))
		      (src-date (file-write-date (source-file-name x))))
		  (if (or (null bin-date)
			  (> src-date bin-date))
		      (progn
			(load (source-file-name x))
			(compile-file (source-file-name x))
			(load (binary-file-name x)))
		  (load x)))))
	files))

(defun compile-files (files)
  (mapc #'(lambda (x)
	    (load (source-file-name x))
	    (compile-file (source-file-name x))
	    (load x))
	files))

(defun load-vag (&key force-binary)
  (with-supressed-warnings
    (load-files *files* :force-binary force-binary)
    (funcall (intern "VAG-INIT" (find-package :vag)))
    t))