fset macro

[bpt/guile.git] / module / language / elisp / boot.el

diff --git a/module/language/elisp/boot.el b/module/language/elisp/boot.el
index 1079357..4e8347f 100644 (file)
--- a/module/language/elisp/boot.el
+++ b/module/language/elisp/boot.el
@@ -22,6 +22,9 @@
 (defmacro @ (module symbol)
   `(guile-ref ,module ,symbol))
 
+(defmacro @@ (module symbol)
+  `(guile-private-ref ,module ,symbol))
+
 (defmacro defun (name args &rest body)
   `(let ((proc (function (lambda ,args ,@body))))
      (%funcall (@ (language elisp runtime) set-symbol-function!)
@@ -38,20 +41,53 @@
      (eval-when-compile ,@body)
      (progn ,@body)))
 
+(defmacro %define-compiler-macro (name args &rest body)
+  `(eval-and-compile
+     (%funcall
+      (@ (language elisp runtime) set-symbol-plist!)
+      ',name
+      (%funcall
+       (@ (guile) cons*)
+       '%compiler-macro
+       #'(lambda ,args ,@body)
+       (%funcall (@ (language elisp runtime) symbol-plist) ',name)))
+     ',name))
+
+(defmacro defsubst (name args &rest body)
+  `(progn
+     (defun ,name ,args ,@body)
+     (eval-and-compile
+       (%define-compiler-macro ,name (form)
+         (%funcall (@ (guile) cons*)
+                   '%funcall
+                   (%funcall
+                    (@ (guile) list)
+                    'function
+                    (%funcall (@ (guile) cons*) 'lambda ',args ',body))
+                   (%funcall (@ (guile) cdr) form))))))
+
 (eval-and-compile
   (defun eval (form)
     (%funcall (@ (language elisp runtime) eval-elisp) form)))
 
 (eval-and-compile
-  (defun null (object)
+  (defsubst null (object)
+    (declare (lexical object))
     (if object nil t))
-  (defun consp (object)
-    (%funcall (@ (guile) pair?) object))
+  (defsubst consp (x)
+    (declare (lexical x))
+    (%funcall (@ (guile) pair?) x))
+  (defsubst atom (x)
+    (declare (lexical x))
+    (null (consp x)))
   (defun listp (object)
+    (declare (lexical object))
     (if object (consp object) t))
-  (defun car (list)
+  (defsubst car (list)
+    (declare (lexical list))
     (if list (%funcall (@ (guile) car) list) nil))
-  (defun cdr (list)
+  (defsubst cdr (list)
+    (declare (lexical list))
     (if list (%funcall (@ (guile) cdr) list) nil))
   (defun make-symbol (name)
     (%funcall (@ (guile) make-symbol) name))
@@ -259,6 +295,18 @@
                 (function (lambda (&rest args)
                             (apply (autoload-do-load definition symbol nil) args)))
                 definition)))
+            ((and (symbolp definition)
+                  (let ((fn (symbol-function definition)))
+                    (and (consp fn)
+                         (or (eq (car fn) 'macro)
+                             (and (eq (car fn) 'autoload)
+                                  (or (eq (nth 4 fn) 'macro)
+                                      (eq (nth 4 fn) t)))))))
+             (cons 'macro
+                   (funcall
+                    (@ (language elisp falias) make-falias)
+                    (function (lambda (&rest args) `(,definition ,@args)))
+                    definition)))
             (t
              (funcall (@ (language elisp falias) make-falias)
                       (function (lambda (&rest args) (apply definition args)))
@@ -742,17 +790,3 @@
 
 (defun %set-eager-macroexpansion-mode (ignore)
   nil)
-
-(defun progn (&rest args) (error "Special operator"))
-(defun eval-when-compile (&rest args) (error "Special operator"))
-(defun if (&rest args) (error "Special operator"))
-(defun defconst (&rest args) (error "Special operator"))
-(defun defvar (&rest args) (error "Special operator"))
-(defun setq (&rest args) (error "Special operator"))
-(defun let (&rest args) (error "Special operator"))
-(defun flet (&rest args) (error "Special operator"))
-(defun labels (&rest args) (error "Special operator"))
-(defun let* (&rest args) (error "Special operator"))
-(defun function (&rest args) (error "Special operator"))
-(defun defmacro (&rest args) (error "Special operator"))
-(defun quote (&rest args) (error "Special operator"))