git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/bytecomp-runtime.el

   1 ;;; bytecomp-runtime.el --- byte-compiler support for inlining
   2
   3 ;; Copyright (C) 1992, 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: Jamie Zawinski <jwz@jwz.org>
   6 ;; Author: Hallvard Furuseth <hbf@ulrik.uio.no>
   7 ;; Maintainer: XEmacs Development Team
   8 ;; Keywords: internal, dumped
   9
  10 ;; This file is part of XEmacs.
  11
  12 ;; XEmacs is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XEmacs is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Synched up with: FSF 19.30.
  28
  29 ;;; Commentary:
  30
  31 ;; This file is dumped with XEmacs.
  32
  33 ;; The code in this file should always be loaded, because it defines things
  34 ;; like "defsubst" which should work interpreted as well.  The code in
  35 ;; bytecomp.el and byte-optimize.el can be loaded as needed.
  36
  37 ;; interface to selectively inlining functions.
  38 ;; This only happens when source-code optimization is turned on.
  39
  40 ;;; Code:
  41
  42 ;; Redefined in byte-optimize.el.
  43 ;; This is not documented--it's not clear that we should promote it.
  44 (fset 'inline 'progn)
  45 (put 'inline 'lisp-indent-hook 0)
  46
  47
  48 ;;; Interface to inline functions.
  49
  50 ;; FSF comments the next two out, but I see no reason to do so. --ben
  51 (defmacro proclaim-inline (&rest fns)
  52   "Cause the named functions to be open-coded when called from compiled code.
  53 They will only be compiled open-coded when `byte-optimize' is true."
  54   (cons 'eval-and-compile
  55         (apply
  56          'nconc
  57          (mapcar
  58           #'(lambda (x)
  59               `((or (memq (get ',x 'byte-optimizer)
  60                           '(nil byte-compile-inline-expand))
  61                     (error
  62                      "%s already has a byte-optimizer, can't make it inline"
  63                      ',x))
  64                 (put ',x 'byte-optimizer 'byte-compile-inline-expand)))
  65           fns))))
  66
  67
  68 (defmacro proclaim-notinline (&rest fns)
  69   "Cause the named functions to no longer be open-coded."
  70   (cons 'eval-and-compile
  71         (apply
  72          'nconc
  73          (mapcar
  74           #'(lambda (x)
  75               `((if (eq (get ',x 'byte-optimizer)
  76                         'byte-compile-inline-expand)
  77                     (put ',x 'byte-optimizer nil))))
  78           fns))))
  79
  80 ;; This has a special byte-hunk-handler in bytecomp.el.
  81 (defmacro defsubst (name arglist &rest body)
  82   "Define an inline function.  The syntax is just like that of `defun'."
  83   (or (memq (get name 'byte-optimizer)
  84             '(nil byte-compile-inline-expand))
  85       (error "`%s' is a primitive" name))
  86   (list 'prog1
  87         (cons 'defun (cons name (cons arglist body)))
  88         (list 'proclaim-inline name)))
  89 ; Instead of the above line, FSF has this:
  90 ;       (list 'eval-and-compile
  91 ;             (list 'put (list 'quote name)
  92 ;                   ''byte-optimizer ''byte-compile-inline-expand))))
  93
  94 (defun make-obsolete (fn new &optional when)
  95   "Make the byte-compiler warn that function FN is obsolete.
  96 The warning will say that NEW should be used instead.
  97 If NEW is a string, that is the `use instead' message.
  98 If provided, WHEN should be a string indicating when the function
  99 was first made obsolete, for example a date or a release number."
 100   (interactive "aMake function obsolete: \nxObsoletion replacement: ")
 101   (let ((handler (get fn 'byte-compile)))
 102     (if (eq 'byte-compile-obsolete handler)
 103         (setcar (get fn 'byte-obsolete-info) new)
 104       (put fn 'byte-obsolete-info (cons new handler))
 105       (put fn 'byte-compile 'byte-compile-obsolete)))
 106   fn)
 107
 108 (defun make-obsolete-variable (var new &optional when)
 109   "Make the byte-compiler warn that variable VAR is obsolete,
 110 and NEW should be used instead.  If NEW is a string, then that is the
 111 `use instead' message.
 112 If provided, WHEN should be a string indicating when the variable
 113 was first made obsolete, for example a date or a release number."
 114   (interactive
 115    (list
 116     (let ((str (completing-read "Make variable obsolete: " obarray 'boundp t)))
 117       (if (equal str "") (error ""))
 118       (intern str))
 119     (car (read-from-string (read-string "Obsoletion replacement: ")))))
 120   (put var 'byte-obsolete-variable new)
 121   var)
 122
 123 ;; By overwhelming demand, we separate out truly obsolete symbols from
 124 ;; those that are present for GNU Emacs compatibility.
 125 (defun make-compatible (fn new)
 126   "Make the byte-compiler know that function FN is provided for compatibility.
 127 The warning will say that NEW should be used instead.
 128 If NEW is a string, that is the `use instead' message."
 129   (interactive "aMake function compatible: \nxCompatible replacement: ")
 130   (let ((handler (get fn 'byte-compile)))
 131     (if (eq 'byte-compile-compatible handler)
 132         (setcar (get fn 'byte-compatible-info) new)
 133       (put fn 'byte-compatible-info (cons new handler))
 134       (put fn 'byte-compile 'byte-compile-compatible)))
 135   fn)
 136
 137 (defun make-compatible-variable (var new)
 138   "Make the byte-compiler know that variable VAR is provided for compatibility,
 139 and NEW should be used instead.  If NEW is a string, then that is the
 140 `use instead' message."
 141   (interactive
 142    (list
 143     (let ((str (completing-read "Make variable compatible: "
 144                                 obarray 'boundp t)))
 145       (if (equal str "") (error ""))
 146       (intern str))
 147     (car (read-from-string (read-string "Compatible replacement: ")))))
 148   (put var 'byte-compatible-variable new)
 149   var)
 150
 151 (put 'dont-compile 'lisp-indent-hook 0)
 152 (defmacro dont-compile (&rest body)
 153   "Like `progn', but the body always runs interpreted (not compiled).
 154 If you think you need this, you're probably making a mistake somewhere."
 155   (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body)))))
 156
 157 \f
 158 ;;; interface to evaluating things at compile time and/or load time
 159 ;;; these macro must come after any uses of them in this file, as their
 160 ;;; definition in the file overrides the magic definitions on the
 161 ;;; byte-compile-macro-environment.
 162
 163 (put 'eval-when-compile 'lisp-indent-hook 0)
 164 (defmacro eval-when-compile (&rest body)
 165   "Like `progn', but evaluates the body at compile time.
 166 The result of the body appears to the compiler as a quoted constant."
 167   ;; Not necessary because we have it in b-c-initial-macro-environment
 168   ;; (list 'quote (eval (cons 'progn body)))
 169   (cons 'progn body))
 170
 171 (put 'eval-and-compile 'lisp-indent-hook 0)
 172 (defmacro eval-and-compile (&rest body)
 173   "Like `progn', but evaluates the body at compile time and at load time."
 174   ;; Remember, it's magic.
 175   (cons 'progn body))
 176
 177 ;;; From Emacs 20.
 178 (put 'eval-when-feature 'lisp-indent-hook 1)
 179 (defmacro eval-when-feature (feature &rest body)
 180   "Run the body forms when FEATURE is featurep, be it now or later.
 181 Called (eval-when-feature (FEATURE [. FILENAME]) BODYFORMS...).
 182 If (featurep 'FEATURE), evals now; otherwise adds an elt to
 183 `after-load-alist' (which see), using FEATURE as filename if FILENAME is nil."
 184   (let ((file (or (cdr feature) (symbol-name (car feature)))))
 185     `(let ((bodythunk #'(lambda () ,@body)))
 186        (if (featurep ',(car feature))
 187            (funcall bodythunk)
 188          (setq after-load-alist (cons '(,file . (list 'lambda '() bodythunk))
 189                                       after-load-alist))))))
 190
 191
 192 \f
 193 ;;; Interface to file-local byte-compiler parameters.
 194 ;;; Redefined in bytecomp.el.
 195
 196 ;;; The great RMS speaketh:
 197 ;;;
 198 ;;; I nuked this because it's not a good idea for users to think of
 199 ;;; using it.  These options are a matter of installation preference,
 200 ;;; and have nothing to do with particular source files; it's a
 201 ;;; mistake to suggest to users that they should associate these with
 202 ;;; particular source files.  There is hardly any reason to change
 203 ;;; these parameters, anyway.  --rms.
 204 ;;;
 205 ;;; But I'll leave this stuff alone. --ben
 206
 207 (put 'byte-compiler-options 'lisp-indent-hook 0)
 208 (defmacro byte-compiler-options (&rest args)
 209   "Set some compilation-parameters for this file.
 210 This will affect only the file in which it appears; this does nothing when
 211 evaluated, or when loaded from a .el file.
 212
 213 Each argument to this macro must be a list of a key and a value.
 214
 215   Keys:           Values:               Corresponding variable:
 216
 217   verbose         t, nil                byte-compile-verbose
 218   optimize        t, nil, source, byte  byte-optimize
 219   warnings        list of warnings      byte-compile-warnings
 220   file-format     emacs19, emacs20      byte-compile-emacs19-compatibility
 221
 222 The value specified with the `warnings' option must be a list, containing
 223 some subset of the following flags:
 224
 225   free-vars     references to variables not in the current lexical scope.
 226   unused-vars   references to non-global variables bound but not referenced.
 227   unresolved    calls to unknown functions.
 228   callargs      lambda calls with args that don't match the definition.
 229   redefine      function cell redefined from a macro to a lambda or vice
 230                 versa, or redefined to take a different number of arguments.
 231
 232 If the first element if the list is `+' or `-' then the specified elements
 233 are added to or removed from the current set of warnings, instead of the
 234 entire set of warnings being overwritten.
 235
 236 For example, something like this might appear at the top of a source file:
 237
 238     (byte-compiler-options
 239       (optimize t)
 240       (warnings (- callargs))           ; Don't warn about arglist mismatch
 241       (warnings (+ unused-vars))        ; Do warn about unused bindings
 242       (file-format emacs19))"
 243   nil)
 244
 245 ;;; bytecomp-runtime.el ends here