1;;; cc-bytecomp.el --- compile time setup for proper compilation -*- lexical-binding: t -*-
2
3;; Copyright (C) 2000-2021 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 <https://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
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) ; Change to ARGS when needed.
89  ;; (declare (debug t))
90  ;;`(message ,@args)
91  )
92
93(defun cc-bytecomp-compiling-or-loading ()
94  ;; Determine whether byte-compilation or loading is currently active,
95  ;; returning 'compiling, 'loading or nil.
96  ;; If both are active, the "innermost" activity counts.  Note that
97  ;; compilation can trigger loading (various `require' type forms)
98  ;; and loading can trigger compilation (the package manager does
99  ;; this).  We walk the lisp stack if necessary.
100  ;; Never native compile to allow cc-defs.el:2345 hack.
101  (declare (speed -1))
102  (cond
103   ((and load-in-progress
104	 (boundp 'byte-compile-dest-file)
105	 (stringp byte-compile-dest-file))
106    (let ((n 0) elt)
107      (while (and
108	      (setq elt (backtrace-frame n))
109	      (not (and (car elt)
110			(memq (cadr elt)
111			      '(load require
112				byte-compile-file byte-recompile-directory
113				batch-byte-compile batch-native-compile)))))
114	(setq n (1+ n)))
115      (cond
116       ((memq (cadr elt) '(load require))
117	'loading)
118       ((memq (cadr elt) '(byte-compile-file
119			   byte-recompile-directory
120			   batch-byte-compile
121			   batch-native-compile))
122	'compiling)
123       (t				; Can't happen.
124	(message "cc-bytecomp-compiling-or-loading: System flags spuriously set")
125	nil))))
126   (load-in-progress
127    ;; Being loaded.
128    'loading)
129   ((and (boundp 'byte-compile-dest-file)
130	 (stringp byte-compile-dest-file))
131    ;; Being compiled.
132    'compiling)
133   (t
134    ;; Being evaluated interactively.
135    nil)))
136
137(defsubst cc-bytecomp-is-compiling ()
138  "Return non-nil if eval'ed during compilation."
139  (eq (cc-bytecomp-compiling-or-loading) 'compiling))
140
141(defsubst cc-bytecomp-is-loading ()
142  "Return non-nil if eval'ed during loading.
143Nil will be returned if we're in a compilation triggered by the loading."
144  (eq (cc-bytecomp-compiling-or-loading) 'loading))
145
146(defun cc-bytecomp-setup-environment ()
147  ;; Eval'ed during compilation to setup variables, functions etc
148  ;; declared with `cc-bytecomp-defvar' et al.
149  (if (not (cc-bytecomp-is-loading))
150      (let (p)
151	(if cc-bytecomp-environment-set
152	    (error "Byte compilation environment already set - \
153perhaps a `cc-bytecomp-restore-environment' is forgotten somewhere"))
154	(setq p cc-bytecomp-unbound-variables)
155	(while p
156	  (if (not (boundp (car p)))
157	      (progn
158		(eval `(defvar ,(car p)))
159		(set (car p) (intern (concat "cc-bytecomp-ignore-var:"
160					     (symbol-name (car p)))))
161		(cc-bytecomp-debug-msg
162		 "cc-bytecomp-setup-environment: Covered variable %s"
163		 (car p))))
164	  (setq p (cdr p)))
165	(setq p cc-bytecomp-original-functions)
166	(while p
167	  (let ((fun (car (car p)))
168		(temp-macro (car (cdr (car p)))))
169	    (if (not (fboundp fun))
170		(if temp-macro
171		    (progn
172		      (eval `(defmacro ,fun ,@temp-macro))
173		      (cc-bytecomp-debug-msg
174		       "cc-bytecomp-setup-environment: Bound macro %s" fun))
175		  (fset fun (intern (concat "cc-bytecomp-ignore-fun:"
176					    (symbol-name fun))))
177		  (cc-bytecomp-debug-msg
178		   "cc-bytecomp-setup-environment: Covered function %s" fun))))
179	  (setq p (cdr p)))
180	(setq p cc-bytecomp-original-properties)
181	(while p
182	  (let ((sym (car (car (car p))))
183		(prop (cdr (car (car p))))
184		(tempdef (car (cdr (car p)))))
185	    (put sym prop tempdef)
186	    (cc-bytecomp-debug-msg
187	     "cc-bytecomp-setup-environment: Bound property %s for %s to %s"
188	     prop sym tempdef))
189	  (setq p (cdr p)))
190	(setq cc-bytecomp-environment-set t)
191	(cc-bytecomp-debug-msg
192	 "cc-bytecomp-setup-environment: Done"))))
193
194(defun cc-bytecomp-restore-environment ()
195  ;; Eval'ed during compilation to restore variables, functions etc
196  ;; declared with `cc-bytecomp-defvar' et al.
197  (if (not (cc-bytecomp-is-loading))
198      (let (p)
199	(setq p cc-bytecomp-unbound-variables)
200	(while p
201	  (let ((var (car p)))
202	    (if (boundp var)
203		(if (eq (intern (concat "cc-bytecomp-ignore-var:"
204					(symbol-name var)))
205			(symbol-value var))
206		    (progn
207		      (makunbound var)
208		      (cc-bytecomp-debug-msg
209		       "cc-bytecomp-restore-environment: Unbound variable %s"
210		       var))
211		  (cc-bytecomp-debug-msg
212		   "cc-bytecomp-restore-environment: Not restoring variable %s"
213		   var))))
214	  (setq p (cdr p)))
215	(setq p cc-bytecomp-original-functions)
216	(while p
217	  (let ((fun (car (car p)))
218		(temp-macro (car (cdr (car p))))
219		(def (car (cdr (cdr (car p))))))
220	    (if (fboundp fun)
221		(if (eq (or temp-macro
222			    (intern (concat "cc-bytecomp-ignore-fun:"
223					    (symbol-name fun))))
224			   (symbol-function fun))
225		    (if (eq def 'unbound)
226			(progn
227			  (fmakunbound fun)
228			  (cc-bytecomp-debug-msg
229			   "cc-bytecomp-restore-environment: Unbound function %s"
230			   fun))
231		      (fset fun def)
232		      (cc-bytecomp-debug-msg
233		       "cc-bytecomp-restore-environment: Restored function %s"
234		       fun))
235		  (cc-bytecomp-debug-msg
236		   "cc-bytecomp-restore-environment: Not restoring function %s"
237		   fun))))
238	  (setq p (cdr p)))
239	(setq p cc-bytecomp-original-properties)
240	(while p
241	  (let ((sym (car (car (car p))))
242		(prop (cdr (car (car p))))
243		(tempdef (car (cdr (car p))))
244		(origdef (cdr (cdr (car p)))))
245	    (if (eq (get sym prop) tempdef)
246		(progn
247		  (put sym prop origdef)
248		  (cc-bytecomp-debug-msg
249		   "cc-bytecomp-restore-environment: Restored property %s for %s to %s"
250		   prop sym origdef))
251	      (cc-bytecomp-debug-msg
252	       "cc-bytecomp-restore-environment: Not restoring property %s for %s"
253	       prop sym)))
254	  (setq p (cdr p)))
255	(setq cc-bytecomp-environment-set nil)
256	(cc-bytecomp-debug-msg
257	 "cc-bytecomp-restore-environment: Done"))))
258
259(defun cc-bytecomp-load (_cc-part)
260  ;; A dummy function which will immediately be overwritten by the
261  ;; following at load time.  This should suppress the byte compiler
262  ;; error that the function is "not known to be defined".
263)
264(eval
265 ;; This eval is to avoid byte compilation of the function below.
266 ;; There's some bug in XEmacs 21.4.6 that can cause it to dump core
267 ;; here otherwise.  My theory is that `cc-bytecomp-load' might be
268 ;; redefined recursively during the `load' inside it, and if it in
269 ;; that case is byte compiled then the byte interpreter gets
270 ;; confused.  I haven't succeeded in isolating the bug, though. /mast
271
272 '(defun cc-bytecomp-load (cc-part)
273    ;; Eval'ed during compilation to load a CC Mode file from the source
274    ;; directory (assuming it's the same as the compiled file
275    ;; destination dir).
276    (if (and (boundp 'byte-compile-dest-file)
277	     (stringp byte-compile-dest-file))
278	(progn
279	  (cc-bytecomp-restore-environment)
280	  (let ((load-path
281		 (cons (file-name-directory byte-compile-dest-file)
282		       load-path))
283		(cc-file (concat cc-part ".el")))
284	    (if (member cc-file cc-bytecomp-loaded-files)
285		()
286	      (setq cc-bytecomp-loaded-files
287		    (cons cc-file cc-bytecomp-loaded-files))
288	      (cc-bytecomp-debug-msg
289	       "cc-bytecomp-load: Loading %S" cc-file)
290	      ;; native-comp may async compile also intalled el.gz
291	      ;; files therefore we may have to load here other el.gz.
292	      (load cc-part nil t)
293	      (cc-bytecomp-debug-msg
294	       "cc-bytecomp-load: Loaded %S" cc-file)))
295	  (cc-bytecomp-setup-environment)
296	  t))))
297
298(defmacro cc-require (cc-part)
299  "Force loading of the corresponding .el file in the current directory
300during compilation, but compile in a `require'.  Don't use within
301`eval-when-compile'.
302
303Having cyclic cc-require's will result in infinite recursion.  That's
304somewhat intentional."
305  (declare (debug t))
306  `(progn
307     (eval-when-compile
308       (cc-bytecomp-load (symbol-name ,cc-part)))
309     (require ,cc-part)))
310
311(defmacro cc-conditional-require (cc-part condition)
312  "If the CONDITION is satisfied at compile time, (i) force the
313file CC-PART.el in the current directory to be loaded at compile
314time, (ii) generate code to load the file at load time.
315
316CC-PART will normally be a quoted name such as \\='cc-fix.
317CONDITION should not be quoted."
318  (declare (debug t))
319  (if (eval condition)
320      (progn
321	(cc-bytecomp-load (symbol-name (eval cc-part)))
322	`(require ,cc-part))
323    '(progn)))
324
325(defmacro cc-conditional-require-after-load (cc-part file condition)
326  "If the CONDITION is satisfied at compile time, (i) force the
327file CC-PART.el in the current directory to be loaded at compile
328time, (ii) generate an `eval-after-load' form to load CC-PART.el
329after the loading of FILE.
330
331CC-PART will normally be a quoted name such as \\='cc-fix.  FILE
332should be a string.  CONDITION should not be quoted."
333  (declare (debug t))
334  (if (eval condition)
335      (progn
336	(cc-bytecomp-load (symbol-name (eval cc-part)))
337	`(eval-after-load ,file
338	   '(require ,cc-part)))
339    '(progn)))
340
341(defmacro cc-provide (feature)
342  "A replacement for `provide' that restores the environment after the compilation.
343Don't use within `eval-when-compile'."
344  (declare (debug t))
345  `(progn
346     (eval-when-compile (cc-bytecomp-restore-environment))
347     (provide ,feature)))
348
349(defmacro cc-load (cc-part)
350  "Force loading of the corresponding .el file in the current directory
351during compilation.  Don't use outside `eval-when-compile' or
352`eval-and-compile'.
353
354Having cyclic cc-load's will result in infinite recursion.  That's
355somewhat intentional."
356  (declare (debug t))
357  `(or (and (featurep 'cc-bytecomp)
358	    (cc-bytecomp-load ,cc-part))
359       (load ,cc-part nil t nil)))
360
361(defmacro cc-require-when-compile (cc-part)
362  "Force loading of the corresponding .el file in the current directory
363during compilation, but do a compile time `require' otherwise.  Don't
364use within `eval-when-compile'."
365  (declare (debug t))
366  `(eval-when-compile
367     (if (and (fboundp 'cc-bytecomp-is-compiling)
368	      (cc-bytecomp-is-compiling))
369	 (if (not (featurep ,cc-part))
370	     (cc-bytecomp-load (symbol-name ,cc-part)))
371       (require ,cc-part))))
372
373(defmacro cc-external-require (feature)
374  "Do a `require' of an external package.
375This restores and sets up the compilation environment before and
376afterwards.  Don't use within `eval-when-compile'."
377  (declare (debug t))
378  `(progn
379     (eval-when-compile (cc-bytecomp-restore-environment))
380     (require ,feature)
381     (eval-when-compile (cc-bytecomp-setup-environment))))
382
383(defmacro cc-bytecomp-defvar (var)
384  "Bind the symbol VAR as a variable during compilation of the file.
385This can be used to silence the byte compiler.  Don't use within
386`eval-when-compile'."
387  (declare (debug nil))
388  `(eval-when-compile
389     (if (boundp ',var)
390	 (cc-bytecomp-debug-msg
391	  "cc-bytecomp-defvar: %s bound already as variable" ',var)
392       (if (not (memq ',var cc-bytecomp-unbound-variables))
393	   (progn
394	     (cc-bytecomp-debug-msg
395	      "cc-bytecomp-defvar: Saving %s (as unbound)" ',var)
396	     (setq cc-bytecomp-unbound-variables
397		   (cons ',var cc-bytecomp-unbound-variables))))
398       (if (cc-bytecomp-is-compiling)
399	   (progn
400	     (defvar ,var)
401	     (set ',var (intern (concat "cc-bytecomp-ignore-var:"
402					(symbol-name ',var))))
403	     (cc-bytecomp-debug-msg
404	      "cc-bytecomp-defvar: Covered variable %s" ',var))))))
405
406(defmacro cc-bytecomp-defun (fun)
407  "Bind the symbol FUN as a function during compilation of the file.
408This can be used to silence the byte compiler.  Don't use within
409`eval-when-compile'.
410
411If the symbol already is bound as a function, it will keep that
412definition.  That means that this macro will not shut up warnings
413about incorrect number of arguments.  It's dangerous to try to replace
414existing functions since the byte compiler might need the definition
415at compile time, e.g. for macros and inline functions."
416  (declare (debug nil))
417  `(eval-when-compile
418     (if (fboundp ',fun)
419	 (cc-bytecomp-debug-msg
420	  "cc-bytecomp-defun: %s bound already as function" ',fun)
421       (if (not (assq ',fun cc-bytecomp-original-functions))
422	   (progn
423	     (cc-bytecomp-debug-msg
424	      "cc-bytecomp-defun: Saving %s (as unbound)" ',fun)
425	     (setq cc-bytecomp-original-functions
426		   (cons (list ',fun nil 'unbound)
427			 cc-bytecomp-original-functions))))
428       (if (cc-bytecomp-is-compiling)
429	   (progn
430	     (fset ',fun (intern (concat "cc-bytecomp-ignore-fun:"
431					 (symbol-name ',fun))))
432	     (cc-bytecomp-debug-msg
433	      "cc-bytecomp-defun: Covered function %s" ',fun))))))
434
435(defmacro cc-bytecomp-put (symbol propname value)
436  "Set a property on SYMBOL during compilation (and evaluation) of the file.
437Don't use outside `eval-when-compile'."
438  (declare (debug t))
439  `(eval-when-compile
440     (if (not (assoc (cons ,symbol ,propname) cc-bytecomp-original-properties))
441	 (progn
442	   (cc-bytecomp-debug-msg
443	    "cc-bytecomp-put: Saving property %s for %s with value %s"
444	    ,propname ,symbol (get ,symbol ,propname))
445	   (setq cc-bytecomp-original-properties
446		 (cons (cons (cons ,symbol ,propname)
447			     (cons ,value (get ,symbol ,propname)))
448		       cc-bytecomp-original-properties))))
449     (put ,symbol ,propname ,value)
450     (cc-bytecomp-debug-msg
451      "cc-bytecomp-put: Bound property %s for %s to %s"
452      ,propname ,symbol ,value)))
453
454(defmacro cc-bytecomp-boundp (symbol)
455  "Return non-nil if SYMBOL is bound as a variable outside the compilation.
456This is the same as using `boundp' but additionally exclude any
457variables that have been bound during compilation with
458`cc-bytecomp-defvar'."
459  (declare (debug t))
460  (if (and (cc-bytecomp-is-compiling)
461	   (memq (car (cdr symbol)) cc-bytecomp-unbound-variables))
462      nil
463    `(boundp ,symbol)))
464
465(defmacro cc-bytecomp-fboundp (symbol)
466  "Return non-nil if SYMBOL is bound as a function outside the compilation.
467This is the same as using `fboundp' but additionally exclude any
468functions that have been bound during compilation with
469`cc-bytecomp-defun'."
470  (declare (debug t))
471  (let (fun-elem)
472    (if (and (cc-bytecomp-is-compiling)
473	     (setq fun-elem (assq (car (cdr symbol))
474				  cc-bytecomp-original-functions))
475	     (eq (elt fun-elem 2) 'unbound))
476	nil
477      `(fboundp ,symbol))))
478
479
480(provide 'cc-bytecomp)
481
482;; Local Variables:
483;; indent-tabs-mode: t
484;; tab-width: 8
485;; End:
486;;; cc-bytecomp.el ends here
487