guile-elisp defsubst

[bpt/emacs.git] / lisp / emacs-lisp / byte-run.el

diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 0edcf61..68f541a 100644 (file)
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -81,52 +81,53 @@ The return value of this function is not used."
 ;; loaded by loadup.el that uses declarations in macros.
 
 ;; Add any new entries to info node `(elisp)Declare Form'.
 ;; 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.")
 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.")
 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,
 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,


@@ -135,21 +136,21 @@ to set this property.
 
 This is used by `declare'.")
 
 
 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.
 
 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
 
 (defalias 'defmacro
   (cons


@@ -192,9 +193,10 @@ The return value is undefined.
                          (message "Warning: Unknown macro property %S in %S"
                                   (car x) name))))
                  decls)))
                          (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)
 
 ;; Now that we defined defmacro we can use it!
 (defmacro defun (name arglist &optional docstring &rest body)


@@ -231,14 +233,7 @@ The return value is undefined.
                    ((and (featurep 'cl)
                          (memq (car x)  ;C.f. cl-do-proclaim.
                                '(special inline notinline optimize warn)))
                    ((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)))))
                     nil)
                    (t (message "Warning: Unknown defun property `%S' in %S"
                                (car x) name)))))


@@ -248,14 +243,21 @@ The return value is undefined.
                      (list 'function
                            (cons 'lambda
                                  (cons arglist body))))))
                      (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.
 \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.
 
 
 ;;; Interface to inline functions.
 


@@ -284,18 +286,6 @@ The return value is undefined.
 ;;                      (list 'put x ''byte-optimizer nil)))
 ;;             fns)))
 
 ;;                      (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)
 (defvar advertised-signature-table (make-hash-table :test 'eq :weakness 'key))
 
 (defun set-advertised-calling-convention (function signature _when)