Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv25835
Modified Files:
basic-macros.lisp
Log Message:
Added "fast" implementations of cddr and cdddr, in an effort to reduce
cal/ret run-time and code-size overhead in list processing.
Date: Sat Apr 17 11:33:57 2004
Author: ffjeld
Index: movitz/losp/muerte/basic-macros.lisp
diff -u movitz/losp/muerte/basic-macros.lisp:1.13 movitz/losp/muerte/basic-macros.lisp:1.14
--- movitz/losp/muerte/basic-macros.lisp:1.13 Fri Apr 16 19:33:36 2004
+++ movitz/losp/muerte/basic-macros.lisp Sat Apr 17 11:33:57 2004
@@ -9,7 +9,7 @@
;;;; Created at: Wed Nov 8 18:44:57 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
-;;;; $Id: basic-macros.lisp,v 1.13 2004/04/16 23:33:36 ffjeld Exp $
+;;;; $Id: basic-macros.lisp,v 1.14 2004/04/17 15:33:57 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -575,6 +575,23 @@
(define-compiler-macro cddr (x)
`(cdr (cdr ,x)))
+(define-compiler-macro caddr (x)
+ `(car (cdr (cdr ,x))))
+
+(define-compiler-macro cadddr (x)
+ `(car (cdr (cdr (cdr ,x)))))
+
+(define-compiler-macro cdar (x)
+ `(cdr (car ,x)))
+
+
+(define-compiler-macro rest (x) `(cdr ,x))
+(define-compiler-macro first (x) `(car ,x))
+(define-compiler-macro second (x) `(cadr ,x))
+(define-compiler-macro third (x) `(caddr ,x))
+(define-compiler-macro fourth (x) `(cadddr ,x))
+(define-compiler-macro fifth (x) `(caddddr ,x))
+
(define-compiler-macro (setf car) (value cell &environment env)
(if (and (movitz:movitz-constantp value env)
(eq nil (movitz::eval-form value env)))
@@ -840,32 +857,6 @@
(array
(error "Array backquote not implemented."))
(t (list 'quote form))))
-
-;;;(defmacro defun+movitz (name &rest args)
-;;; (flet ((make-compile-side-name (x)
-;;; (if (find-symbol (symbol-name x) :common-lisp)
-;;; (intern (format nil "~A-~A" '#:movitz x))
-;;; x)))
-;;; (if (symbolp name)
-;;; `(progn
-;;; (eval-when (:compile-toplevel)
-;;; (defun ,(make-compile-side-name name) ,@args))
-;;; (defun ,name ,@args))
-;;; `(progn
-;;; (eval-when (:compile-toplevel)
-;;; (defun (,(first name) ,(make-compile-side-name (second name))) ,@(cddr name)
-;;; ,@args))
-;;; (defun ,name ,@args)))))
-
-
-(define-compiler-macro first (x)
- `(car ,x))
-(define-compiler-macro second (x)
- `(cadr ,x))
-(define-compiler-macro third (x)
- `(caddr ,x))
-(define-compiler-macro rest (x)
- `(cdr ,x))
(define-compiler-macro find-class (&whole form &environment env symbol &optional (errorp t))
(declare (ignore errorp))