;;; dynlib-cmp.el --- compiling Emacs Lisp packages into dynamic libraries

;; Copyright (C) 1994 Hans Chalupsky

;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
;; Created: 26 Feb 1994
;; Version: dynlib-cmp.el,v 1.2 1994/11/21 10:51:09 hans Exp
;; Keywords: lisp, internal

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; A copy of the GNU General Public License can be obtained from this
;; program's author (send electronic mail to hans@cs.buffalo.edu) or from
;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;; 02139, USA.


;;; Commentary:

;; This file contains the extensions to the byte compiler to compile
;; Emacs Lisp files into dynamic libraries.  The standard compilation
;; facilities will remain available unchanged, hence, even after loading
;; this file you will still be able to produce standard byte-compiled
;; files by calling `byte-compile-file' and friends.

;; The Dynlib user interface is comprised of the following functions:

;; - dynlib-compile-file
;; - dynlib-compile-to-target
;; - batch-dynlib-compile
;; - batch-dynlib-compile-to-target

;; Check out their documentation strings to see how to use them.
;; `dynlib-compile-file' and `batch-dynlib-compile' are the Dynlib
;; equivalents to `byte-compile-file' and `batch-byte-compile'.  The batch
;; functions cannot be used interactively.  Also, to be able to use them you
;; have to make sure that the Dynlib run-time and compile-time support gets
;; loaded into your Emacs batch invocation, i.e., you might have to do
;; something like

;;    emacs -batch -l ./dynlib-run.elc -l ./dynlib-cmp.elc \
;;          -f batch-dynlib-compile yourfile.el

;; unless your site-local Emacs setup already contains the proper autoload
;; and `load-path' definitions.

;; When you Dynlib-compile a file, say `foo.el', you get two output files:

;; (1) The stub file `foo.elc' which you will load as usual, and
;; (2) the library file `foo.ell' which contains all the actual definitions.

;; These files are assumed to reside in the same directory.  This means you
;; can move them from a compilation directory to an installation directory,
;; but you have to move them together.  If you do move them then it is
;; mandatory that they wind up in a directory that is somewhere in the
;; `load-path', because otherwise the function `dynlib-find-library' won't
;; be able to find the library file that is associated with the moved stub
;; file.  If you keep them in the compilation directory you can load the
;; stub file with its full pathname without having to add that directory
;; to the `load-path'.


;; Installation:

;; See commentary in `dynlib-run.el'.  Once you have loaded `dynlib-run'
;; this file can either be autoloaded by calling one of its top-level
;; entry points, or it will be loaded automatically after you load the
;; standard byte compiler.


;; To do:

;; - More extensive documentation.
;; - Deal with buffer-size limit of `get_doc_string function', e.g., the size
;;   of the calendar-mode docstring is already 13k.  Right now just signal
;;   an error.
;; - Library files should be protected against accidental loading.
;; - Have a variable `dynlib-dont-stubify' or whatever that contains a list
;;   of functions that won't get converted into stubs during compilation.
;;   This would allow one to optimize dylib-compiled files to contain all
;;   the definitions of the functions which need to be available immediately
;;   after loading. 
;; - Test with X/Lemacs.  Handle `defalias' unavailability.  Check whether the
;;   defmumble used there is actually the same as used in here.



;;; Code:

;; Provide this right here so we'll avoid recursive loading due to the
;; after-load form for the byte compiler established in `dynlib-run':
(provide 'dynlib-cmp)

(require 'byte-compile "bytecomp")
;; Needed because of the advice to `byte-compile-inline-expand':
(require 'byte-optimize "byte-opt")
(require 'advice)
(require 'dynlib-run)


(defvar dynlib-compile-library-buffer nil)
(defvar dynlib-compile-library-file-var nil)
(defvar dynlib-compile-offset 0)
(defvar dynlib-compile-initial-stub-forms nil)

;(defun dynlib-compile-make-library-file-var (file)
;  ;; Creates a (hopefully) unique variable symbol for every library FILE.
;  ;; That variable will be used to hold the file name of the actual library
;  ;; file as it gets determined at load time with `dynlib-find-library'.
;  (setq file (file-name-nondirectory file))
;  (intern (concat "dynlib-" file "-" (nth 1 (current-time)))))

(defun dynlib-compile-make-library-file-var (file)
  ;; Creates a (hopefully) unique variable symbol for every library FILE.
  ;; That variable will be used to hold the file name of the actual library
  ;; file as it gets determined at load time with `dynlib-find-library'.
  ;; The trick is to create a unique variable for every file that stays
  ;; the same for every invocation of this function (needed if we compile
  ;; multiple source files into a single target library), hence, what better
  ;; name is there to choose than the full file name itself? The only drawback
  ;; is that this creates pretty big variable names, oh well.
  (intern (concat "dynlib-" (expand-file-name file))))

(defun dynlib-compile-read-file-name (prompt &optional default)
  ;; Reads a source file name with proper DEFAULT, prompting with PROMPT.
  (if (setq default
	    (or default
		(and (eq (cdr (assq 'major-mode (buffer-local-variables)))
			 'emacs-lisp-mode)
		     buffer-file-name)))
      (read-file-name
       (format "%s(default %s) " prompt (file-name-nondirectory default))
       (file-name-directory default)
       default)
    (read-file-name prompt)))

;;;###autoload    
(defun dynlib-compile-file (source-file &optional load)
  "Compile a file of Lisp code named SOURCE-FILE into a dynamic library.
This is the Dynlib equivalent to `byte-compile-file' (which see).
The output stub file name is made by appending `c' to the end of SOURCE-FILE,
and the output library file's name is made by appending `l'.
With a prefix arg (noninteractively: 2nd arg), load the file after compiling."
  (interactive
     (list (dynlib-compile-read-file-name
	    (if current-prefix-arg
		"Compile and load file: "
	      "Compile file: "))
	   current-prefix-arg))
  (dynlib-compile-file-internal source-file nil nil load))

;;;###autoload
(defun batch-dynlib-compile ()
  "Run `dynlib-compile-file' on the files remaining on the command line.
This is the Dynlib equivalent to `batch-byte-compile' (which see).
Use this from the command line, with `-batch'; it won't work in an interactive
Emacs.  Each file is processed even if an error occurred previously.
For example, invoke `emacs -batch -f batch-dynlib-compile $emacs/ ~/*.el\'."
  (if (not noninteractive)
      (error "`batch-dynlib-compile' is to be used only with -batch")
    (fset 'byte-compile-file 'dynlib-compile-file)
    (batch-byte-compile)))

(defvar dynlib-compile-last-target-file nil)

;;;###autoload
(defun dynlib-compile-to-target (source-file target-file &optional append)
  "Compile SOURCE-FILE into a dynamic library named TARGET-FILE.
Both the stub file and the library file will be named after TARGET-FILE.
With a prefix arg (noninteractively: 3rd arg) append the output to 
TARGET-FILE which does not need to exist already.  This function can be used
to compile a multi-file package into a single TARGET-FILE.{elc,ell} pair.
The compilation order must represent a proper loading order for the individual
files, otherwise the combined TARGET-FILE.elc will not load properly."
  (interactive
   (list (dynlib-compile-read-file-name "Compile file: ")
	 (dynlib-compile-read-file-name
	  (if current-prefix-arg
	      "Append to target library: "
	    "Target library: ")
	  (and current-prefix-arg
	       dynlib-compile-last-target-file))
	 current-prefix-arg))
  (setq dynlib-compile-last-target-file target-file)
  (dynlib-compile-file-internal source-file target-file append))

;;;###autoload
(defun batch-dynlib-compile-to-target ()
  "Run `dynlib-compile-to-target' on the files remaining on the command line.
The first file will not be compiled but used as the name of the target library.
Use this from the command line, with `-batch'; it won't work in an interactive
Emacs.  For example, invoke 
   `emacs -batch -f batch-dynlib-compile-to-target out ~/*.el'."
  (if (not noninteractive)
      (error "`batch-dynlib-compile-to-target' is to be used only with -batch")
    ;; avoid `undefined variable' warning:
    (defvar command-line-args-left)
    (let ((target-file (car command-line-args-left)))
      (message "Compiling to target library `%s'..." target-file)
      (setq command-line-args-left (cdr command-line-args-left))
      ;; Redefine `batch-byte-compile-file', because in
      ;; this case we do want to stop if an error occurs:
      (fset 'batch-byte-compile-file
	    (function (lambda (source-file)
			(dynlib-compile-to-target
			 source-file target-file 'append))))
      (batch-byte-compile))))

(defun dynlib-compile-file-internal (source-file
				      &optional target-file append load)
  ;; activate the various advised functions:
  (dynlib-compile-start)

  (setq source-file (expand-file-name source-file))

  ;; If we're compiling a file that's in a buffer and is modified,
  ;; offer to save it first:
  (or noninteractive
      (let ((b (get-file-buffer source-file)))
	(if (and b (buffer-modified-p b)
		 (y-or-n-p (format "save buffer %s first? " (buffer-name b))))
	    (save-excursion (set-buffer b) (save-buffer)))))

  ;; setup `byte-compile-file' variables:
  (let ((filename source-file)
	(byte-compile-current-file (file-name-nondirectory source-file))
	input-buffer output-buffer)
    (if byte-compile-verbose
	(message "Compiling %s..." source-file))

    ;; setup input-buffer:
    (save-excursion
      (setq input-buffer (get-buffer-create " *Compiler Input*"))
      (set-buffer input-buffer)
      (erase-buffer)
      (insert-file-contents source-file)
      ;; Run hooks including the uncompression hook.
      ;; If they change the file name, then change it for the output also.
      (let ((buffer-file-name source-file))
        (set-auto-mode)
        (setq source-file buffer-file-name)))

    (setq target-file
	  (expand-file-name
	   (file-name-sans-versions
	    (or target-file source-file))))
    ;; strip off .el/.elc/.ell extensions:
    (setq target-file
	  (substring
	   target-file 0 (string-match "\\.el[cl]?$" target-file)))

    ;; setup of `dynlib-compile-file-internal' variables:
    (let* (dynlib-compile-library-buffer
	   (stub-file (concat target-file ".elc"))
	   (library-file (concat target-file ".ell"))
	   (dynlib-compile-library-file-var
	    (dynlib-compile-make-library-file-var target-file))
	   (dynlib-compile-offset
	    (if append
		;; should I check for -1 if file is already too big?
		(or (nth 7 (file-attributes library-file)) 0)
	      0))
	   (dynlib-compile-initial-stub-forms
	    (if (= dynlib-compile-offset 0)
		;; write out the library variable definition which
		;; will contain the library file name as its value:
		;; Use `defconst' to make sure the value will change:
		(` ((defconst (, dynlib-compile-library-file-var)
		      (dynlib-find-library (, library-file)))))
	      ;; if we append just `defvar' it so we won't get a warning:
	      (` ((defvar (, dynlib-compile-library-file-var) nil))))))

      ;; setup library-buffer similar to what's done in `bc-from-buffer':
      (save-excursion
	(setq dynlib-compile-library-buffer
	      (set-buffer (get-buffer-create " *Compiler Library Output*")))
	(erase-buffer)
	(setq case-fold-search nil)
	(setq overwrite-mode 'overwrite-mode-binary)
	(byte-compile-insert-header source-file)
	(goto-char (point-max)))

      ;; compile the sucker:
      (setq byte-compiler-error-flag nil)
      (setq output-buffer (byte-compile-from-buffer input-buffer source-file))

      (if byte-compiler-error-flag
	  nil
	(dynlib-compile-write-output-buffer output-buffer stub-file append)
	(dynlib-compile-write-output-buffer
	 dynlib-compile-library-buffer library-file append)
	(if load
	    (load stub-file)))
      t)))

(defun dynlib-compile-write-output-buffer (output-buffer
					    file &optional append)
  (save-excursion
    (set-buffer output-buffer)
    (goto-char (point-max))
    (insert "\n")
    (let ((vms-stmlf-recfm t))
      (if (file-writable-p file)
	  (let ((kanji-flag nil))	; for nemacs, from Nakagawa Takayuki
	    (write-region 1 (point-max) file append))
	;; This is just to give a better error message than
	;; write-region
	(signal 'file-error
		(list "Opening output file"
		      (if (file-exists-p file)
			  "cannot overwrite file"
			"directory not writable or nonexistent")
		      file))))
    (kill-buffer (current-buffer))))

(defadvice byte-compile-insert-header (around dynlib-compile 1 act pre comp)
  ;; advised so we can do something different for intermediate headers:
  (let ((outbuffer (if (eq dynlib-compile-library-buffer (current-buffer))
		       (current-buffer)
		     outbuffer)))
    (if (and dynlib-compile-library-buffer (> dynlib-compile-offset 0))
	;; handle intermediate headers if we are appending:
	(save-excursion
	
	  (set-buffer outbuffer)
	  (goto-char 1)
	  (insert "\n;;; compiled by " (user-login-name) "@" (system-name)
		  " on " (current-time-string)
		  "\n;;; from file " filename "\n")
	  (insert ";;; emacs version " emacs-version ".\n")
	  (insert ";;; bytecomp version " byte-compile-version "\n;;; "
		  (cond
		   ((eq byte-optimize 'source)
		    "source-level optimization only")
		   ((eq byte-optimize 'byte)
		    "byte-level optimization only")
		   (byte-optimize
		    "optimization is on")
		   (t "optimization is off")))
	  (insert "\n"))
      ad-do-it)))

(defun dynlib-compile-file-form-defmumble (form macrop)
  ;; An abridged version of the original `byte-compile-file-form-defmumble'.
  ;; It does all the initial checking and environment book keeping, but then
  ;; simply returns the code generated by `byte-compile-lambda' instead of
  ;; writing things to the `outbuffer'.  It also assumes Emacs-19 or Lemacs.
  ;; It would have been nice to be able to do this with Advice, but it's
  ;; difficult to change the behavior somewhere in the middle of a function.
  (let* ((name (car (cdr form)))
	 (this-kind (if macrop 'byte-compile-macro-environment
		      'byte-compile-function-environment))
	 (that-kind (if macrop 'byte-compile-function-environment
		      'byte-compile-macro-environment))
	 (this-one (assq name (symbol-value this-kind)))
	 (that-one (assq name (symbol-value that-kind)))
	 (byte-compile-free-references nil)
	 (byte-compile-free-assignments nil))

    ;; When a function or macro is defined, add it to the call tree so that
    ;; we can tell when functions are not used.
    (if byte-compile-generate-call-tree
	(or (assq name byte-compile-call-tree)
	    (setq byte-compile-call-tree
		  (cons (list name nil nil) byte-compile-call-tree))))

    (setq byte-compile-current-form name) ; for warnings
    (if (memq 'redefine byte-compile-warnings)
	(byte-compile-arglist-warn form macrop))
    (if byte-compile-verbose
	(message "Compiling %s (%s)..." (or filename "") (nth 1 form)))
    (cond (that-one
	   (if (and (memq 'redefine byte-compile-warnings)
		    ;; don't warn when compiling the stubs in byte-run...
		    (not (assq (nth 1 form)
			       byte-compile-initial-macro-environment)))
	       (byte-compile-warn
		"%s defined multiple times, as both function and macro"
		(nth 1 form)))
	   (setcdr that-one nil))
	  (this-one
	   (if (and (memq 'redefine byte-compile-warnings)
		    ;; hack: don't warn when compiling the magic internal
		    ;; byte-compiler macros in byte-run.el...
		    (not (assq (nth 1 form)
			       byte-compile-initial-macro-environment)))
	       (byte-compile-warn "%s %s defined multiple times in this file"
				  (if macrop "macro" "function")
				  (nth 1 form))))
	  ((and (fboundp name)
		(eq (car-safe (symbol-function name))
		    (if macrop 'lambda 'macro)))
	   (if (memq 'redefine byte-compile-warnings)
	       (byte-compile-warn "%s %s being redefined as a %s"
				  (if macrop "function" "macro")
				  (nth 1 form)
				  (if macrop "macro" "function")))
	   ;; shadow existing definition
	   (set this-kind
		(cons (cons name nil) (symbol-value this-kind))))
	  )
    (let ((body (nthcdr 3 form)))
      (if (and (stringp (car body))
	       (symbolp (car-safe (cdr-safe body)))
	       (car-safe (cdr-safe body))
	       (stringp (car-safe (cdr-safe (cdr-safe body)))))
	  (byte-compile-warn "Probable `\"' without `\\' in doc string of %s"
			     (nth 1 form))))
    (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
	   (code (byte-compile-byte-code-maker new-one)))
      (if this-one
	  (setcdr this-one new-one)
	(set this-kind
	     (cons (cons name new-one) (symbol-value this-kind))))
      ;; Simply return the generated compiled code:
      new-one)))

(defvar dynlib-compile-end-marker (make-marker))

(defun dynlib-compile-quote-region (buffer start end)
  ;; Quotes `C-@' and `C-_' chars in BUFFER between START and END.
  ;; They get replaced with character syntax which will result in
  ;; the original character when the string is read.
  (move-marker dynlib-compile-end-marker end)
  (setq end dynlib-compile-end-marker)
  (save-excursion
    (set-buffer buffer)
    (save-excursion
      (goto-char start)
      (while (search-forward "\C-@" end t)
	(replace-match "\\C-@" t t))
      (goto-char start)
      (while (search-forward "\C-_" end t)
	(replace-match "\\C-_" t t)))))

;; `get_doc_string' can only handle objects of less than 16k.
(defvar dynlib-compile-max-object-size 16380)

(defun dynlib-compile-output-library-object (object &optional readably)
  ;; Writes OBJECT to the library buffer.  READABLY if that was t.
  ;; The start position of the OBJECT will be returned.  If the object was
  ;; bigger than `dynlib-compile-max-object-size' an error will be raised.
  (let (start)
    (save-excursion
      (set-buffer dynlib-compile-library-buffer)
      (goto-char (point-max))
      (setq start (point))
      (princ "\n" dynlib-compile-library-buffer)
      (cond (readably
	     (prin1 object dynlib-compile-library-buffer)
	     (dynlib-compile-quote-region
	      dynlib-compile-library-buffer start (point-max)))
	    (t (princ object dynlib-compile-library-buffer)))
      ;; write object terminator:
      (princ "\C-_" dynlib-compile-library-buffer)
      ;; `get_doc_string' can only handle objects that are < 16k.
      ;; Right now simply signal an error, maybe do something useful later:
      (if (> (- (point-max) start) dynlib-compile-max-object-size)
	  (error "dynlib-compile: Code or docstring exceeds 16k.")
	(+ start dynlib-compile-offset)))))

(defmacro dynlib-compile-get-docstring (form)
  ;; Returns the docstring of an uncompiled FORM.
  ;; This works for all of these:
  ;; (defun defmacro defsubst defvar defconst autoload)
  (` (and (stringp (nth 3 (, form)))
	  (nth 3 (, form)))))

;; If we save the docstring to the library file we have to replace
;; it with a library pointer which occupies 1 cons cell (8 bytes?)
;; + 1 index number (4 bytes?).  The library filename string is allocated
;; only once per stub file.  Assuming some other unspecified overhead we
;; set the threshold to 16.
(defvar dynlib-compile-docstring-threshold 16)

(defun dynlib-compile-save-docstring-p (form)
  ;; Returns non-nil if the docstring of FORM is worth saving.
  (let* ((docstring (dynlib-compile-get-docstring form)))
    (and (stringp docstring)
	 (>= (length docstring) dynlib-compile-docstring-threshold))))

(defun dynlib-compile-remove-docstring (form)
  ;; Destructively removes the docstring of FORM if it is worth saving.
  ;; Returns t if id did modify FORM, nil otherwise.
  (let* ((type (car form))
	 ;; this actually starts with the element before the docstring:
	 (docstring-plus-body
	  (nthcdr 2 form)))
    (cond ((dynlib-compile-save-docstring-p form)
	   (if (memq type '(defun defmacro defsubst defvar defconst))
	       (setcdr docstring-plus-body (cdr (cdr docstring-plus-body))))
	   (if (eq type 'autoload)
	       (setcar (cdr docstring-plus-body) nil))
	   t))))

(defun dynlib-compile-keep-pending (form)
  ;; A wrapper around `byte-compile-keep-pending' that makes sure things get
  ;; flushed once in a while.  Since during library compilation we don't have
  ;; many big forms with docstrings this function gives us a chance to
  ;; modify the "flushing" behavior according to the needs of Dynlib.
  (cond (dynlib-compile-initial-stub-forms
	 (byte-compile-keep-pending
	  (` (progn (,@ dynlib-compile-initial-stub-forms))))
	 (setq dynlib-compile-initial-stub-forms nil)))
  (if (nthcdr 500 byte-compile-output)
      (byte-compile-flush-pending))
  (byte-compile-keep-pending form))

;; Save real version of `make-byte-code' because we will temporarily
;; rebind it to add a library pointer as a documentation object (this
;; way I don't have to keep my own copy of `byte-compile-lambda' around):
(if (not (fboundp 'dynlib-compile-real-make-byte-code))
    (fset 'dynlib-compile-real-make-byte-code
	  (symbol-function 'make-byte-code)))

(defun dynlib-compile-make-byte-code-with-doc-pointer (&rest args)
  ;; Generates a byte-code object with a library pointer as documentation.
  (if (>= (length args) 5)
      (setcar (nthcdr 4 args) (dynlib-make-library-pointer nil nil))
    (nconc args (list (dynlib-make-library-pointer nil nil))))
  (apply 'dynlib-compile-real-make-byte-code args))

(defun dynlib-compile-make-defining-form (name code macro-p)
  ;; Creates a defining form for the function (or macro) NAME with CODE.
  ;; Don't use `defalias', because the load-file association has to be
  ;; done by the `defstub's.  The cases where we don't create a stub
  ;; function will (for now) be simply ignored.
  (cond (macro-p
	 (` (fset '(, name) '(, (ad-macrofy code)))))
	((atom code)
	 (` (fset '(, name) (, code))))
	(t (` (fset '(, name) '(, code))))))

;; The size of an average stub function is computed as follows:
;; - An average 5 array elements for the byte-code object (20 bytes?)
;; - 3 array elements for the constants vector (12 bytes?)
;; - 1 definition library pointer (12 bytes?)
;; - The argument list, codestring, and library filename string are widely
;;   shared, hence, their individual cost per function is very small.
;; To determine whether an actual function definition occupies more than
;; its stub, we have to check whether the argument list plus the constant
;; vector of the actual function use more space than the constant vector
;; plus the library pointer of the stub (24 bytes).  This is a bit tricky,
;; because we could have a very small function that just defines one huge
;; constant which it always returns.  Maybe later.

(defun dynlib-compile-make-stub-p (code)
  ;; Returns t if CODE should be written to the library file and replaced
  ;; by a stub function.  Eventually, this will do some slightly more
  ;; sophisticated analysis.  For now just return t.
  t)

;; General policy on writing out forms with docstrings: Since the bulk of the
;; docstrings of a given file will be written to the library file, there is
;; no need to write the few forms with short docstrings that didn't get saved
;; in the verbose format that is understood by `make-docfile'.  The efficiency
;; is already gained by the dynamic library approach, so, even if somebody
;; decides to preload a stub file, there is no point in writing the few short
;; docstrings to the DOC file.

;; The rest of the defmumble modification is done via advice:
(defadvice byte-compile-file-form-defmumble
  (around dynlib-compile first preact act comp)
  (if dynlib-compile-library-buffer
      (let* ((form (ad-get-arg 0))
	     (macro-p (ad-get-arg 1))
	     (name (car (cdr form)))
	     (docstring (dynlib-compile-get-docstring form))
	     (save-docstring-p (dynlib-compile-remove-docstring form))
	     docindex defindex code)
	(ad-with-originals (make-byte-code)
	  ;; If we save the documentation to the library file we
	  ;; need a library pointer in the generated byte-code:
	  (if save-docstring-p
	      (fset 'make-byte-code
		    'dynlib-compile-make-byte-code-with-doc-pointer))
	  (setq code (dynlib-compile-file-form-defmumble form macro-p)))
	;; Decide whether we should create a stub function or not:
	(cond ((ad-lambda-p code)
	       ;; The function was trivial, don't create a stub:
	       (dynlib-compile-keep-pending
		(dynlib-compile-make-defining-form
		 name
		 (cond (save-docstring-p
			;; If it had its docstring removed we have to splice
			;; it back in because in interpreted definitions we
			;; cannot have library pointers as documentation:
			(setq save-docstring-p nil)
			(append
			 (list 'lambda (nth 1 code) docstring)
			 (nthcdr 2 code)))
		       (t code))
		 macro-p))
	       (setq code nil))
	      (t;; we have compiled code:
	       (cond ((dynlib-compile-make-stub-p code)
		      (if macro-p
			  (setq code (ad-macrofy code))))
		     ;; Note that even if we don't make a stub we might
		     ;; still save the docstring if it was big enough:
		     (t (dynlib-compile-keep-pending
			 (dynlib-compile-make-defining-form
			  name code macro-p))
			(setq code nil)))))
	;; Here `code' is either a definition which should be written
	;; to the library file, or it is nil because it was kept pending:
	(if save-docstring-p
	    (setq docindex (dynlib-compile-output-library-object docstring)))
	(if code
	    (dynlib-compile-make-stubfn-entry
	     name
	     ;; write actual code to the library file:
	     (dynlib-compile-output-library-object code t)
	     (or docindex docstring)
	     (ad-interactive-p (cons 'lambda (cdr (cdr form))))
	     macro-p))
	(setq ad-return-value nil))
    ad-do-it))

(defun dynlib-compile-make-stubfn-entry
  (name defindex documentation interactive-p macro-p)
  (dynlib-compile-keep-pending
   (if interactive-p
       (` (defstubfi
	    '(, name) (, dynlib-compile-library-file-var) (, defindex)
	    (,@ (if documentation (list documentation)))))
     (if macro-p
	 (` (defstubm
	      '(, name) (, dynlib-compile-library-file-var) (, defindex)
	      (,@ (if documentation (list documentation)))))
       (` (defstubf
	    '(, name) (, dynlib-compile-library-file-var) (, defindex)
	    (,@ (if documentation (list documentation)))))))))

;; Compiling the stub-functions directly into the stub file seems to be less
;; efficient than the `defstub' approach.  This is probably mainly due to the
;; fact that the stub file gets much bigger that way.

;(fset 'dynlib-def 'dynlib-define-function)
;
;(defun dynlib-compile-make-stubfn-entry
;  (name defindex docindex stubdoc interactive-p macro-p)
;  (dynlib-compile-keep-pending
;   (` (dynlib-set-stub-info
;       '(, name) (, dynlib-compile-library-file-var)
;        (, docindex) (, defindex))))
;  (let ((form
;	 (byte-compile-lambda
;	  (` (lambda (&rest dynlib-Args)
;	       (,@ (if stubdoc (list stubdoc)))
;	       (,@ (if interactive-p '((interactive))))
;	       (dynlib-def
;		'(, name) args
;		(,@ (if interactive-p '((interactive-p))))))))))
;    (dynlib-compile-keep-pending
;     (` (fset
;	 '(, name)
;	 (, (if macro-p
;		(list 'quote (ad-macrofy form))
;	      form)))))))

(defadvice byte-compile-file-form-defvar
  ;; Handles docstrings of `defvar/defconst's.
  (around dynlib-compile first preact act comp)
  (if dynlib-compile-library-buffer
      (let* ((form (ad-get-arg 0))
	     (name (car (cdr form)))
	     (docstring (dynlib-compile-get-docstring form))
	     (docindex (if (dynlib-compile-remove-docstring form)
			   (dynlib-compile-output-library-object docstring))))
	;; Don't bother writing the `defvar' verbosely even if
	;; it had a short docstring which we didn't save:
	(dynlib-compile-keep-pending form)
	(if docindex
	    (dynlib-compile-keep-pending
	     (` (defdocv
		  '(, name)
		  (, dynlib-compile-library-file-var)
		  (, docindex))))))
    ad-do-it))

(defadvice byte-compile-file-form-autoload
  ;; Handles docstrings of `autoload's.
  (around dynlib-compile first preact act comp)
  (if dynlib-compile-library-buffer
      (let* ((form (ad-get-arg 0))
	     (name (car (cdr form)))
	     (docstring (dynlib-compile-get-docstring form))
	     (docindex (if (and
			    ;; make sure we have a constant for a name:
			    (consp name)
			    (eq (car name) 'quote)
			    (dynlib-compile-remove-docstring form))
			   (dynlib-compile-output-library-object docstring))))
	;; Don't bother writing the `autoload' verbosely even if
	;; it had a short docstring which we didn't save:
	(dynlib-compile-keep-pending form)
	;; This has to be done after the autoload definition was compiled,
	;; because we need an actual definition whose docstring can be changed:
	(if docindex
	    (dynlib-compile-keep-pending
	     (` (defdoca
		  (, name)
		  (, dynlib-compile-library-file-var)
		  (, docindex))))))
    ad-do-it))


;; Automatic stub loading during compilation:

;; Stub functions look like actual functions to the inline-expander of the
;; compiler.  That's why we have to make sure that a `defsubst' which is still
;; a stub gets loaded before it is used by `byte-compile-inline-expand'.
;; This is also needed during plain compilation once we have stubs around:
(defadvice byte-compile-inline-expand
  (before dynlib-compile first preact act comp)
  (let ((name (car (ad-get-arg 0))))
    (and
     ;; If we already have a definition in the function environment then we
     ;; don't have to worry, because it shadows the stub function anyway:
     (not (cdr (assq name byte-compile-function-environment)))
     (fboundp name)
     (dynlib-stub-definition-p (symbol-function name))
     (fset name (dynlib-lookup-definition-from-stub (symbol-function name))))))

;; Stub definitions are different from autoload definitions, because they
;; get created when a library file gets loaded, hence, whoever loaded it
;; will assume that the functions are defined and all the important information
;; such as type, argument list, etc., is available.  The following assumes that
;; no file will ever contain a `defun/defmacro' definition whose resulting code
;; will make `dynlib-stub-definition-p' return t.  Maybe that's too risky?
;; In that case we can check whether the defined name is part of the
;; environment.  Too expensive right now.

;; A consequence of the advice below is that if we recompile a previously
;; loaded stub file, all functions defined in that file will get actually
;; defined during the compilation!!

(defadvice byte-compile-fdefinition
  (after dynlib-compile first preact act comp)
  (cond ((dynlib-stub-definition-p ad-return-value)
	 (setq ad-return-value
	       (dynlib-lookup-definition-from-stub ad-return-value))
	 (fset (ad-get-arg 0) ad-return-value)
	 (if (ad-macro-p ad-return-value)
	     (setq ad-return-value (ad-lambdafy ad-return-value))))))

(defvar dynlib-advised-byte-compilers
  '(byte-compile-insert-header
    byte-compile-file-form-defmumble
    byte-compile-file-form-defvar
    byte-compile-file-form-autoload
    byte-compile-inline-expand
    byte-compile-fdefinition))

(defun dynlib-compile-start ()
  ;;(interactive)
  (ad-dolist (byte-compiler dynlib-advised-byte-compilers)
    (ad-activate byte-compiler)))

(defun dynlib-compile-stop ()
  ;;(interactive)
  (ad-dolist (byte-compiler dynlib-advised-byte-compilers)
    (ad-deactivate byte-compiler)))

(provide 'dynlib-cmp)

;;; dynlib-cmp.el ends here

