;;; -*- Mode: LISP; Package: :cl-user; BASE: 10; Syntax: ANSI-Common-Lisp; -*-
;;;
;;;   Touched: Sat Jan 28 15:03:39 2006 +0530 <enometh@meer.net>
;;;   Time-stamp: <06/01/28 15:54:26 madhu>
;;;
;;; UNSAFE. DO NOT USE.
;;; $Id: dump-constant.lisp,v 1.1 2006/01/28 10:13:53 madhu Exp madhu $
;;; (C) 2004 Madhu. All rights reserved.
;;;
(defpackage "BIN-DUMPER"
  (:use "CL")
  (:export "LOAD-DUMP-CONSTANT"))
(in-package "BIN-DUMPER")

(defun load-dump-constant (dump-source-pathname
			   dump-binary-pathname
			   VAR &optional (KEY #'symbol-value))
  "VARIABLE is a symbol which denotes a special variable whose
 value is dumped as a constant. LOAD-DUMP-CONSTANT will load the
 binary fasl file DUMP-BINARY-PATHNAME if it exists and is newer
 than DUMP-SOURCE-PATHNAME, otherwise it will compile
 DUMP-SOURCE-PATHNAME into into DUMP-BINARY-PATHNAME and load
 it. If DUMP-SOURCE-PATHNAME doesn't exist, VARIABLE is treated
 as a special variable whose value is to be dumped as a constant,
 and LOAD-DUMP-CONSTANT will create DUMP-SOURCE-PATHNAME with a
 defconstant form initialized to the current symbol-value of
 VARIABLE, compile DUMP-SOURCE-PATHNAME into
 DUMP-BINARY-PATHNAME, and load it. (Typically mode of operation
 is to be performed exactly once.)  KEY should be a function
 which takes a symbol and returns the value to be dumped as a
 constant. If supplied, KEY is used to generate the value instead
 of using VAR's symbol-value."
  (check-type var symbol)
  (let (generated-p (*package* (find-package "CL-USER")))
    (unless (and (probe-file dump-binary-pathname)
		 (setq generated-p (probe-file dump-source-pathname))
		 (< (file-write-date dump-source-pathname)
		    (file-write-date dump-binary-pathname)))
      (unless generated-p
	(with-open-file (stream dump-source-pathname :direction :output
				:if-does-not-exist :create
				:if-exists :overwrite)
	  (with-standard-io-syntax 
	    (format stream ";;; -*- Mode: LISP; Package: :cl-user; BASE: 10; Syntax: ANSI-Common-Lisp; -*-
;;;   Touched: ~A  ~A ~A
;;;   (C) Copyright 2006 The Ghost in the lesp machine. All Rights Reserved.
;;;~%(in-package \"~A\")~%(makunbound '~S)~%(defconstant ~S '~S
  \"The constant value of ~A dumped in the file ~A and compiled in the file ~A\")"
		    (user::date :stream nil)
		    (lisp-implementation-type)
		    (lisp-implementation-version)
		    (package-name *package*)
		    var var (funcall KEY var)
		    var dump-source-pathname dump-binary-pathname))))
      (compile-file dump-source-pathname :output-file dump-binary-pathname))
    (load dump-binary-pathname)))

#+nil
(defpackage "FBARF" (:use) (:export "FBARF"))

#+nil
(makunbound 'fbarf:fbarf)

#+nil
(defun fbarf-initializer (var)
  `(10 20 'foobar (30) ,var))

#+nil
(fbarf-initializer 'fbarf:fbarf)			  

#+nil
(progn
(delete-file #p"/tmp/fbarf.l")
(delete-file #p"/tmp/fbarf.x86f"))

#+nil
(load-dump-constant #p"/tmp/fbarf.l"
		    #p"/tmp/fbarf.x86f"
		    'fbarf:fbarf
		    #'fbarf-initializer)