(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!)
(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))
f)))
(defun eval (form)
- (%funcall (@ (system base compile) compile)
- form
- (%funcall (@ (guile) symbol->keyword) 'from)
- 'elisp
- (%funcall (@ (guile) symbol->keyword) 'to)
- 'value))
+ (%funcall (@ (language elisp runtime) eval-elisp) form))
(defun %indirect-function (object)
(cond
(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)))
(args (funcall (@ (guile) frame-arguments) frame)))
(cons t (cons pname args))))
-(defun backtrace ()
+(defun guile-backtrace (&rest args)
(interactive)
- (let* ((stack (funcall (@ (guile) make-stack) t))
+ (let* ((stack (apply (@ (guile) make-stack) t args))
(frame (funcall (@ (guile) stack-ref) stack 1))
(space (funcall (@ (guile) integer->char) 32)))
(while frame
(setq frame (funcall (@ (guile) frame-previous) frame)))
nil))
+(defun backtrace ()
+ (guile-backtrace t))
+
(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"))
+(%define-compiler-macro require (form)
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (funcall #'require ,@(cdr form))))