code.delx.au - gnu-emacs/blob - lisp/progmodes/cc-bytecomp.el

   1 ;;; cc-bytecomp.el --- compile time setup for proper compilation
   2
   3 ;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
   4
   5 ;; Author:     Martin Stjernholm
   6 ;; Maintainer: bug-cc-mode@gnu.org
   7 ;; Created:    15-Jul-2000
   8 ;; Keywords:   c languages
   9 ;; Package:    cc-mode
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; This file is used to ensure that the CC Mode files are correctly
  29 ;; compiled regardless the environment (e.g. if an older CC Mode with
  30 ;; outdated macros are loaded during compilation).  It also provides
  31 ;; features to defeat the compiler warnings for selected symbols.
  32 ;;
  33 ;; There's really nothing CC Mode specific here; this functionality
  34 ;; ought to be provided by the byte compilers or some accompanying
  35 ;; library.  To use it from some package "foo.el", begin by putting
  36 ;; the following blurb at the top of the file:
  37 ;;
  38 ;;   (eval-when-compile
  39 ;;     (let ((load-path
  40 ;;            (if (and (boundp 'byte-compile-dest-file)
  41 ;;                     (stringp byte-compile-dest-file))
  42 ;;                (cons (file-name-directory byte-compile-dest-file) load-path)
  43 ;;              load-path)))
  44 ;;       (load "cc-bytecomp" nil t))
  45 ;;
  46 ;; This (unfortunately rather clumsy) form will ensure that the
  47 ;; cc-bytecomp.el in the same directory as foo.el is loaded during
  48 ;; byte compilation of the latter.
  49 ;;
  50 ;; At the end of foo.el there should normally be a "(provide 'foo)".
  51 ;; Replace it with "(cc-provide 'foo)"; that is necessary to restore
  52 ;; the environment after the byte compilation.  If you don't have a
  53 ;; `provide' at the end, you have to add the following as the very
  54 ;; last form in the file:
  55 ;;
  56 ;;   (eval-when-compile (cc-bytecomp-restore-environment))
  57 ;;
  58 ;; Now everything is set to use the various functions and macros in
  59 ;; this package.
  60 ;;
  61 ;; If your package is split into several files, you should use
  62 ;; `cc-require', `cc-require-when-compile' or `cc-load' to load them.
  63 ;; That ensures that the files in the same directory always are
  64 ;; loaded, to avoid mixup with other versions of them that might exist
  65 ;; elsewhere in the load path.
  66 ;;
  67 ;; To suppress byte compiler warnings, use the macros
  68 ;; `cc-bytecomp-defun' and `cc-bytecomp-defvar'.
  69 ;;
  70 ;; This file is not used at all after the package has been byte
  71 ;; compiled.  It is however necessary when running uncompiled.
  72
  73 \f
  74 ;;; Code:
  75
  76 (defvar cc-bytecomp-unbound-variables nil)
  77 (defvar cc-bytecomp-original-functions nil)
  78 (defvar cc-bytecomp-original-properties nil)
  79 (defvar cc-bytecomp-loaded-files nil)
  80
  81 (setq cc-bytecomp-unbound-variables nil)
  82 (setq cc-bytecomp-original-functions nil)
  83 (setq cc-bytecomp-original-properties nil)
  84 (setq cc-bytecomp-loaded-files nil)
  85
  86 (defvar cc-bytecomp-environment-set nil)
  87
  88 (defmacro cc-bytecomp-debug-msg (&rest args)
  89   ;;`(message ,@args)
  90   )
  91
  92 (defun cc-bytecomp-compiling-or-loading ()
  93   ;; Determine whether byte-compilation or loading is currently active,
  94   ;; returning 'compiling, 'loading or nil.
  95   ;; If both are active, the "innermost" activity counts.  Note that
  96   ;; compilation can trigger loading (various `require' type forms)
  97   ;; and loading can trigger compilation (the package manager does
  98   ;; this).  We walk the lisp stack if necessary.
  99   (cond
 100    ((and load-in-progress
 101          (boundp 'byte-compile-dest-file)
 102          (stringp byte-compile-dest-file))
 103     (let ((n 0) elt)
 104       (while (and
 105               (setq elt (backtrace-frame n))
 106               (not (and (car elt)
 107                         (memq (cadr elt)
 108                               '(load require
 109                                 byte-compile-file byte-recompile-directory
 110                                 batch-byte-compile)))))
 111         (setq n (1+ n)))
 112       (cond
 113        ((memq (cadr elt) '(load require))
 114         'loading)
 115        ((memq (cadr elt) '(byte-compile-file
 116                            byte-recompile-directory
 117                            batch-byte-compile))
 118         'compiling)
 119        (t                               ; Can't happen.
 120         (message "cc-bytecomp-compiling-or-loading: System flags spuriously set")
 121         nil))))
 122    (load-in-progress
 123     ;; Being loaded.
 124     'loading)
 125    ((and (boundp 'byte-compile-dest-file)
 126          (stringp byte-compile-dest-file))
 127     ;; Being compiled.
 128     'compiling)
 129    (t
 130     ;; Being evaluated interactively.
 131     nil)))
 132
 133 (defsubst cc-bytecomp-is-compiling ()
 134   "Return non-nil if eval'ed during compilation."
 135   (eq (cc-bytecomp-compiling-or-loading) 'compiling))
 136
 137 (defsubst cc-bytecomp-is-loading ()
 138   "Return non-nil if eval'ed during loading.
 139 Nil will be returned if we're in a compilation triggered by the loading."
 140   (eq (cc-bytecomp-compiling-or-loading) 'loading))
 141
 142 (defun cc-bytecomp-setup-environment ()
 143   ;; Eval'ed during compilation to setup variables, functions etc
 144   ;; declared with `cc-bytecomp-defvar' et al.
 145   (if (not (cc-bytecomp-is-loading))
 146       (let (p)
 147         (if cc-bytecomp-environment-set
 148             (error "Byte compilation environment already set - \
 149 perhaps a `cc-bytecomp-restore-environment' is forgotten somewhere"))
 150         (setq p cc-bytecomp-unbound-variables)
 151         (while p
 152           (if (not (boundp (car p)))
 153               (progn
 154                 (eval `(defvar ,(car p)))
 155                 (set (car p) (intern (concat "cc-bytecomp-ignore-var:"
 156                                              (symbol-name (car p)))))
 157                 (cc-bytecomp-debug-msg
 158                  "cc-bytecomp-setup-environment: Covered variable %s"
 159                  (car p))))
 160           (setq p (cdr p)))
 161         (setq p cc-bytecomp-original-functions)
 162         (while p
 163           (let ((fun (car (car p)))
 164                 (temp-macro (car (cdr (car p)))))
 165             (if (not (fboundp fun))
 166                 (if temp-macro
 167                     (progn
 168                       (eval `(defmacro ,fun ,@temp-macro))
 169                       (cc-bytecomp-debug-msg
 170                        "cc-bytecomp-setup-environment: Bound macro %s" fun))
 171                   (fset fun (intern (concat "cc-bytecomp-ignore-fun:"
 172                                             (symbol-name fun))))
 173                   (cc-bytecomp-debug-msg
 174                    "cc-bytecomp-setup-environment: Covered function %s" fun))))
 175           (setq p (cdr p)))
 176         (setq p cc-bytecomp-original-properties)
 177         (while p
 178           (let ((sym (car (car (car p))))
 179                 (prop (cdr (car (car p))))
 180                 (tempdef (car (cdr (car p)))))
 181             (put sym prop tempdef)
 182             (cc-bytecomp-debug-msg
 183              "cc-bytecomp-setup-environment: Bound property %s for %s to %s"
 184              prop sym tempdef))
 185           (setq p (cdr p)))
 186         (setq cc-bytecomp-environment-set t)
 187         (cc-bytecomp-debug-msg
 188          "cc-bytecomp-setup-environment: Done"))))
 189
 190 (defun cc-bytecomp-restore-environment ()
 191   ;; Eval'ed during compilation to restore variables, functions etc
 192   ;; declared with `cc-bytecomp-defvar' et al.
 193   (if (not (cc-bytecomp-is-loading))
 194       (let (p)
 195         (setq p cc-bytecomp-unbound-variables)
 196         (while p
 197           (let ((var (car p)))
 198             (if (boundp var)
 199                 (if (eq (intern (concat "cc-bytecomp-ignore-var:"
 200                                         (symbol-name var)))
 201                         (symbol-value var))
 202                     (progn
 203                       (makunbound var)
 204                       (cc-bytecomp-debug-msg
 205                        "cc-bytecomp-restore-environment: Unbound variable %s"
 206                        var))
 207                   (cc-bytecomp-debug-msg
 208                    "cc-bytecomp-restore-environment: Not restoring variable %s"
 209                    var))))
 210           (setq p (cdr p)))
 211         (setq p cc-bytecomp-original-functions)
 212         (while p
 213           (let ((fun (car (car p)))
 214                 (temp-macro (car (cdr (car p))))
 215                 (def (car (cdr (cdr (car p))))))
 216             (if (fboundp fun)
 217                 (if (eq (or temp-macro
 218                             (intern (concat "cc-bytecomp-ignore-fun:"
 219                                             (symbol-name fun))))
 220                            (symbol-function fun))
 221                     (if (eq def 'unbound)
 222                         (progn
 223                           (fmakunbound fun)
 224                           (cc-bytecomp-debug-msg
 225                            "cc-bytecomp-restore-environment: Unbound function %s"
 226                            fun))
 227                       (fset fun def)
 228                       (cc-bytecomp-debug-msg
 229                        "cc-bytecomp-restore-environment: Restored function %s"
 230                        fun))
 231                   (cc-bytecomp-debug-msg
 232                    "cc-bytecomp-restore-environment: Not restoring function %s"
 233                    fun))))
 234           (setq p (cdr p)))
 235         (setq p cc-bytecomp-original-properties)
 236         (while p
 237           (let ((sym (car (car (car p))))
 238                 (prop (cdr (car (car p))))
 239                 (tempdef (car (cdr (car p))))
 240                 (origdef (cdr (cdr (car p)))))
 241             (if (eq (get sym prop) tempdef)
 242                 (progn
 243                   (put sym prop origdef)
 244                   (cc-bytecomp-debug-msg
 245                    "cc-bytecomp-restore-environment: Restored property %s for %s to %s"
 246                    prop sym origdef))
 247               (cc-bytecomp-debug-msg
 248                "cc-bytecomp-restore-environment: Not restoring property %s for %s"
 249                prop sym)))
 250           (setq p (cdr p)))
 251         (setq cc-bytecomp-environment-set nil)
 252         (cc-bytecomp-debug-msg
 253          "cc-bytecomp-restore-environment: Done"))))
 254
 255 (eval
 256  ;; This eval is to avoid byte compilation of the function below.
 257  ;; There's some bug in XEmacs 21.4.6 that can cause it to dump core
 258  ;; here otherwise.  My theory is that `cc-bytecomp-load' might be
 259  ;; redefined recursively during the `load' inside it, and if it in
 260  ;; that case is byte compiled then the byte interpreter gets
 261  ;; confused.  I haven't succeeded in isolating the bug, though. /mast
 262
 263  '(defun cc-bytecomp-load (cc-part)
 264     ;; Eval'ed during compilation to load a CC Mode file from the source
 265     ;; directory (assuming it's the same as the compiled file
 266     ;; destination dir).
 267     (if (and (boundp 'byte-compile-dest-file)
 268              (stringp byte-compile-dest-file))
 269         (progn
 270           (cc-bytecomp-restore-environment)
 271           (let ((load-path
 272                  (cons (file-name-directory byte-compile-dest-file)
 273                        load-path))
 274                 (cc-file (concat cc-part ".el")))
 275             (if (member cc-file cc-bytecomp-loaded-files)
 276                 ()
 277               (setq cc-bytecomp-loaded-files
 278                     (cons cc-file cc-bytecomp-loaded-files))
 279               (cc-bytecomp-debug-msg
 280                "cc-bytecomp-load: Loading %S" cc-file)
 281               (load cc-file nil t t)
 282               (cc-bytecomp-debug-msg
 283                "cc-bytecomp-load: Loaded %S" cc-file)))
 284           (cc-bytecomp-setup-environment)
 285           t))))
 286
 287 (defvar cc-bytecomp-noruntime-functions nil
 288   "Saved value of `byte-compile-noruntime-functions'.")
 289
 290 (defmacro cc-require (cc-part)
 291   "Force loading of the corresponding .el file in the current directory
 292 during compilation, but compile in a `require'.  Don't use within
 293 `eval-when-compile'.
 294
 295 Having cyclic cc-require's will result in infinite recursion.  That's
 296 somewhat intentional."
 297   `(progn
 298      (eval-when-compile
 299        (if (boundp 'byte-compile-noruntime-functions) ; in case load uncompiled
 300            (setq cc-bytecomp-noruntime-functions
 301                  byte-compile-noruntime-functions))
 302        (cc-bytecomp-load (symbol-name ,cc-part)))
 303      ;; Hack to suppress spurious "might not be defined at runtime" warnings.
 304      ;; The basic issue is that
 305      ;;   (eval-when-compile (require 'foo))
 306      ;;   (require 'foo)
 307      ;; produces bogus noruntime warnings about functions from foo.
 308      (eval-when-compile
 309        (setq byte-compile-noruntime-functions cc-bytecomp-noruntime-functions))
 310      (require ,cc-part)))
 311
 312 (defmacro cc-provide (feature)
 313   "A replacement for the `provide' form that restores the environment
 314 after the compilation.  Don't use within `eval-when-compile'."
 315   `(progn
 316      (eval-when-compile (cc-bytecomp-restore-environment))
 317      (provide ,feature)))
 318
 319 (defmacro cc-load (cc-part)
 320   "Force loading of the corresponding .el file in the current directory
 321 during compilation.  Don't use outside `eval-when-compile' or
 322 `eval-and-compile'.
 323
 324 Having cyclic cc-load's will result in infinite recursion.  That's
 325 somewhat intentional."
 326   `(or (and (featurep 'cc-bytecomp)
 327             (cc-bytecomp-load ,cc-part))
 328        (load ,cc-part nil t nil)))
 329
 330 (defmacro cc-require-when-compile (cc-part)
 331   "Force loading of the corresponding .el file in the current directory
 332 during compilation, but do a compile time `require' otherwise.  Don't
 333 use within `eval-when-compile'."
 334   `(eval-when-compile
 335      (if (and (fboundp 'cc-bytecomp-is-compiling)
 336               (cc-bytecomp-is-compiling))
 337          (if (not (featurep ,cc-part))
 338              (cc-bytecomp-load (symbol-name ,cc-part)))
 339        (require ,cc-part))))
 340
 341 (defmacro cc-external-require (feature)
 342   "Do a `require' of an external package.
 343 This restores and sets up the compilation environment before and
 344 afterwards.  Don't use within `eval-when-compile'."
 345   `(progn
 346      (eval-when-compile (cc-bytecomp-restore-environment))
 347      (require ,feature)
 348      (eval-when-compile (cc-bytecomp-setup-environment))))
 349
 350 (defmacro cc-bytecomp-defvar (var)
 351   "Binds the symbol as a variable during compilation of the file,
 352 to silence the byte compiler.  Don't use within `eval-when-compile'."
 353   `(eval-when-compile
 354      (if (boundp ',var)
 355          (cc-bytecomp-debug-msg
 356           "cc-bytecomp-defvar: %s bound already as variable" ',var)
 357        (if (not (memq ',var cc-bytecomp-unbound-variables))
 358            (progn
 359              (cc-bytecomp-debug-msg
 360               "cc-bytecomp-defvar: Saving %s (as unbound)" ',var)
 361              (setq cc-bytecomp-unbound-variables
 362                    (cons ',var cc-bytecomp-unbound-variables))))
 363        (if (cc-bytecomp-is-compiling)
 364            (progn
 365              (defvar ,var)
 366              (set ',var (intern (concat "cc-bytecomp-ignore-var:"
 367                                         (symbol-name ',var))))
 368              (cc-bytecomp-debug-msg
 369               "cc-bytecomp-defvar: Covered variable %s" ',var))))))
 370
 371 (defmacro cc-bytecomp-defun (fun)
 372   "Bind the symbol as a function during compilation of the file,
 373 to silence the byte compiler.  Don't use within `eval-when-compile'.
 374
 375 If the symbol already is bound as a function, it will keep that
 376 definition.  That means that this macro will not shut up warnings
 377 about incorrect number of arguments.  It's dangerous to try to replace
 378 existing functions since the byte compiler might need the definition
 379 at compile time, e.g. for macros and inline functions."
 380   `(eval-when-compile
 381      (if (fboundp ',fun)
 382          (cc-bytecomp-debug-msg
 383           "cc-bytecomp-defun: %s bound already as function" ',fun)
 384        (if (not (assq ',fun cc-bytecomp-original-functions))
 385            (progn
 386              (cc-bytecomp-debug-msg
 387               "cc-bytecomp-defun: Saving %s (as unbound)" ',fun)
 388              (setq cc-bytecomp-original-functions
 389                    (cons (list ',fun nil 'unbound)
 390                          cc-bytecomp-original-functions))))
 391        (if (cc-bytecomp-is-compiling)
 392            (progn
 393              (fset ',fun (intern (concat "cc-bytecomp-ignore-fun:"
 394                                          (symbol-name ',fun))))
 395              (cc-bytecomp-debug-msg
 396               "cc-bytecomp-defun: Covered function %s" ',fun))))))
 397
 398 (defmacro cc-bytecomp-put (symbol propname value)
 399   "Set a property on a symbol during compilation (and evaluation) of
 400 the file.  Don't use outside `eval-when-compile'."
 401   `(eval-when-compile
 402      (if (not (assoc (cons ,symbol ,propname) cc-bytecomp-original-properties))
 403          (progn
 404            (cc-bytecomp-debug-msg
 405             "cc-bytecomp-put: Saving property %s for %s with value %s"
 406             ,propname ,symbol (get ,symbol ,propname))
 407            (setq cc-bytecomp-original-properties
 408                  (cons (cons (cons ,symbol ,propname)
 409                              (cons ,value (get ,symbol ,propname)))
 410                        cc-bytecomp-original-properties))))
 411      (put ,symbol ,propname ,value)
 412      (cc-bytecomp-debug-msg
 413       "cc-bytecomp-put: Bound property %s for %s to %s"
 414       ,propname ,symbol ,value)))
 415
 416 (defmacro cc-bytecomp-boundp (symbol)
 417   "Return non-nil if the given symbol is bound as a variable outside
 418 the compilation.  This is the same as using `boundp' but additionally
 419 exclude any variables that have been bound during compilation with
 420 `cc-bytecomp-defvar'."
 421   (if (and (cc-bytecomp-is-compiling)
 422            (memq (car (cdr symbol)) cc-bytecomp-unbound-variables))
 423       nil
 424     `(boundp ,symbol)))
 425
 426 (defmacro cc-bytecomp-fboundp (symbol)
 427   "Return non-nil if the given symbol is bound as a function outside
 428 the compilation.  This is the same as using `fboundp' but additionally
 429 exclude any functions that have been bound during compilation with
 430 `cc-bytecomp-defun'."
 431   (let (fun-elem)
 432     (if (and (cc-bytecomp-is-compiling)
 433              (setq fun-elem (assq (car (cdr symbol))
 434                                   cc-bytecomp-original-functions))
 435              (eq (elt fun-elem 2) 'unbound))
 436         nil
 437       `(fboundp ,symbol))))
 438
 439 \f
 440 (provide 'cc-bytecomp)
 441
 442 ;; Local Variables:
 443 ;; indent-tabs-mode: t
 444 ;; tab-width: 8
 445 ;; End:
 446 ;;; cc-bytecomp.el ends here