;; loaded by loadup.el that uses declarations in macros.
;; Add any new entries to info node `(elisp)Declare Form'.
-(defvar defun-declarations-alist
- (list
- ;; We can only use backquotes inside the lambdas and not for those
- ;; properties that are used by functions loaded before backquote.el.
- (list 'advertised-calling-convention
- #'(lambda (f _args arglist when)
- (list 'set-advertised-calling-convention
- (list 'quote f) (list 'quote arglist) (list 'quote when))))
- (list 'obsolete
- #'(lambda (f _args new-name when)
- (list 'make-obsolete
- (list 'quote f) (list 'quote new-name) (list 'quote when))))
- (list 'interactive-only
- #'(lambda (f _args instead)
- (list 'function-put (list 'quote f)
- ''interactive-only (list 'quote instead))))
- ;; FIXME: Merge `pure' and `side-effect-free'.
- (list 'pure
- #'(lambda (f _args val)
- (list 'function-put (list 'quote f)
- ''pure (list 'quote val)))
- "If non-nil, the compiler can replace calls with their return value.
+(eval-and-compile
+ (defvar defun-declarations-alist
+ (list
+ ;; We can only use backquotes inside the lambdas and not for those
+ ;; properties that are used by functions loaded before backquote.el.
+ (list 'advertised-calling-convention
+ #'(lambda (f _args arglist when)
+ (list 'set-advertised-calling-convention
+ (list 'quote f) (list 'quote arglist) (list 'quote when))))
+ (list 'obsolete
+ #'(lambda (f _args new-name when)
+ (list 'make-obsolete
+ (list 'quote f) (list 'quote new-name) (list 'quote when))))
+ (list 'interactive-only
+ #'(lambda (f _args instead)
+ (list 'function-put (list 'quote f)
+ ''interactive-only (list 'quote instead))))
+ ;; FIXME: Merge `pure' and `side-effect-free'.
+ (list 'pure
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''pure (list 'quote val)))
+ "If non-nil, the compiler can replace calls with their return value.
This may shift errors from run-time to compile-time.")
- (list 'side-effect-free
- #'(lambda (f _args val)
- (list 'function-put (list 'quote f)
- ''side-effect-free (list 'quote val)))
- "If non-nil, calls can be ignored if their value is unused.
+ (list 'side-effect-free
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''side-effect-free (list 'quote val)))
+ "If non-nil, calls can be ignored if their value is unused.
If `error-free', drop calls even if `byte-compile-delete-errors' is nil.")
- (list 'compiler-macro
- #'(lambda (f args compiler-function)
- `(eval-and-compile
- (function-put ',f 'compiler-macro
- ,(if (eq (car-safe compiler-function) 'lambda)
- `(lambda ,(append (cadr compiler-function) args)
- ,@(cddr compiler-function))
- `#',compiler-function)))))
- (list 'doc-string
- #'(lambda (f _args pos)
- (list 'function-put (list 'quote f)
- ''doc-string-elt (list 'quote pos))))
- (list 'indent
- #'(lambda (f _args val)
- (list 'function-put (list 'quote f)
- ''lisp-indent-function (list 'quote val)))))
- "List associating function properties to their macro expansion.
+ (list 'compiler-macro
+ #'(lambda (f args compiler-function)
+ `(eval-and-compile
+ (function-put ',f 'compiler-macro
+ ,(if (eq (car-safe compiler-function) 'lambda)
+ `(lambda ,(append (cadr compiler-function) args)
+ ,@(cddr compiler-function))
+ `#',compiler-function)))))
+ (list 'doc-string
+ #'(lambda (f _args pos)
+ (list 'function-put (list 'quote f)
+ ''doc-string-elt (list 'quote pos))))
+ (list 'indent
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''lisp-indent-function (list 'quote val)))))
+ "List associating function properties to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is
a function. For each (PROP . VALUES) in a function's declaration,
the FUN corresponding to PROP is called with the function name,
This is used by `declare'.")
-(defvar macro-declarations-alist
- (cons
- (list 'debug
- #'(lambda (name _args spec)
- (list 'progn :autoload-end
- (list 'put (list 'quote name)
- ''edebug-form-spec (list 'quote spec)))))
- defun-declarations-alist)
- "List associating properties of macros to their macro expansion.
+ (defvar macro-declarations-alist
+ (cons
+ (list 'debug
+ #'(lambda (name _args spec)
+ (list 'progn :autoload-end
+ (list 'put (list 'quote name)
+ ''edebug-form-spec (list 'quote spec)))))
+ defun-declarations-alist)
+ "List associating properties of macros to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is a function.
For each (PROP . VALUES) in a macro's declaration, the FUN corresponding
to PROP is called with the macro name, the macro's arglist, and the VALUES
and should return the code to use to set this property.
-This is used by `declare'.")
+This is used by `declare'."))
(defalias 'defmacro
(cons
(message "Warning: Unknown macro property %S in %S"
(car x) name))))
decls)))
- (if declarations
- (cons 'prog1 (cons def declarations))
- def))))))
+ (list 'eval-when '(:compile-toplevel :load-toplevel :execute)
+ (if declarations
+ (cons 'prog1 (cons def declarations))
+ def)))))))
;; Now that we defined defmacro we can use it!
(defmacro defun (name arglist &optional docstring &rest body)
((and (featurep 'cl)
(memq (car x) ;C.f. cl-do-proclaim.
'(special inline notinline optimize warn)))
- (push (list 'declare x)
- (if (stringp docstring)
- (if (eq (car-safe (cadr body)) 'interactive)
- (cddr body)
- (cdr body))
- (if (eq (car-safe (car body)) 'interactive)
- (cdr body)
- body)))
+ (setq body (cons (list 'declare x) body))
nil)
(t (message "Warning: Unknown defun property `%S' in %S"
(car x) name)))))
(list 'function
(cons 'lambda
(cons arglist body))))))
- (if declarations
- (cons 'prog1 (cons def declarations))
- def))))
-
+ (list 'prog1
+ (if declarations
+ (cons 'prog1 (cons def declarations))
+ def)
+ (list 'funcall
+ (list '@ '(guile) 'set-procedure-property!)
+ (list 'symbol-function (list 'quote name))
+ (list 'quote 'name)
+ (list 'quote name))))))
\f
;; Redefined in byte-optimize.el.
;; This is not documented--it's not clear that we should promote it.
-(fset 'inline 'progn)
+
+(defmacro inline (&rest body)
+ (cons 'progn body))
;;; Interface to inline functions.
;; (list 'put x ''byte-optimizer nil)))
;; fns)))
-(defmacro defsubst (name arglist &rest body)
- "Define an inline function. The syntax is just like that of `defun'.
-\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
- (declare (debug defun) (doc-string 3))
- (or (memq (get name 'byte-optimizer)
- '(nil byte-compile-inline-expand))
- (error "`%s' is a primitive" name))
- `(prog1
- (defun ,name ,arglist ,@body)
- (eval-and-compile
- (put ',name 'byte-optimizer 'byte-compile-inline-expand))))
-
(defvar advertised-signature-table (make-hash-table :test 'eq :weakness 'key))
(defun set-advertised-calling-convention (function signature _when)
HCoop / bpt / emacs.git / blobdiff