(%defmacro* pushq args (list* 'setq (car (cdr args)) (car args))) (defun first (list) (car list)) ;;;;----------------------------------------------------------------- ;;;; THE CxR FUNCTIONS ;;;;----------------------------------------------------------------- (defun caaaar (list) (car (caaar list))) (defun caaadr (list) (car (caadr list))) (defun caaar (list) (car (caar list))) (defun caadar (list) (car (cadar list))) (defun caaddr (list) (car (caddr list))) (defun caadr (list) (car (cadr list))) (defun caar (list) (car (car list))) (defun cadaar (list) (car (cdaar list))) (defun cadadr (list) (car (cdadr list))) (defun cadar (list) (car (cdar list))) (defun caddar (list) (car (cddar list))) (defun cadddr (list) (car (cdddr list))) (defun caddr (list) (car (cddr list))) (defun cadr (list) (car (cdr list))) (shadow 'car) (unexport 'sys::car (find-package :sys)) (defun car (list) (sys::car list)) (defun cdaaar (list) (cdr (caaar list))) (defun cdaadr (list) (cdr (caadr list))) (defun cdaar (list) (cdr (caar list))) (defun cdadar (list) (cdr (cadar list))) (defun cdaddr (list) (cdr (caddr list))) (defun cdadr (list) (cdr (cadr list))) (defun cdar (list) (cdr (car list))) (defun cddaar (list) (cdr (cdaar list))) (defun cddadr (list) (cdr (cdadr list))) (defun cddar (list) (cdr (cdar list))) (defun cdddar (list) (cdr (cddar list))) (defun cddddr (list) (cdr (cdddr list))) (defun cdddr (list) (cdr (cddr list))) (defun cddr (list) (cdr (cdr list))) (shadow 'cdr) (unexport 'sys::cdr (find-package :sys)) (defun cdr (list) (sys::cdr list)) ;;;;----------------------------------------------------------------- ;;;; SECOND ... TENTH ;;;;----------------------------------------------------------------- (defun second (list) (cadr list)) (defun third (list) (caddr list)) (defun fourth (list) (car (cdddr list))) (defun fifth (list) (cadr (cdddr list))) (defun sixth (list) (caddr (cdddr list))) (defun seventh (list) (car (cdddr (cdddr list)))) (defun eigthth (list) (cadr (cdddr (cdddr list)))) (defun ninth (list) (caddr (cdddr (cdddr list)))) (defun tenth (list) (car (cdddr (cdddr (cdddr list))))) ;;;;----------------------------------------------------------------- ;;;; CONS ;;;;----------------------------------------------------------------- (shadow 'cons) (unexport 'sys::cons (find-package :sys)) (defun cons (x y) (sys::cons x y)) ;;;;----------------------------------------------------------------- ;;;; TYPE PREDICATES ;;;;----------------------------------------------------------------- (shadow '(consp listp null atom)) (unexport '(sys::consp sys::listp sys::null sys::atom) (find-package :sys)) (defun consp (x) (sys::consp x)) (defun listp (x) (sys::listp x)) (defun null (x) (sys::null x)) (defun atom (x) (sys::atom x)) ;(%deftype cons args '(satisfies consp)) ;(%deftype list args '(satisfies listp)) ;(%deftype null args '(satisfies null)) ;(%deftype atom args '(satisfies atom)) ;;;;----------------------------------------------------------------- ;;;; OTHER PREDICATES ;;;;----------------------------------------------------------------- (defun endp (list) (let ((thing list)) ;;FIXME (check-type thing list) (null thing))) ;;;;----------------------------------------------------------------- ;;;; ACCESSORS ;;;;----------------------------------------------------------------- (shadow '(rplaca rplacd)) (unexport '(sys::rplaca sys::rplacd) (find-package :sys)) (defun rplaca (cons new-value) (sys::rplaca cons new-value)) (defun rplacd (cons new-value) (sys::rplacd cons new-value)) ;;;;----------------------------------------------------------------- (export '(cons list* first second third fourth fifth sixth seventh eigthth ninth tenth atom consp listp null rplaca rplacd caaaar caaadr caaar caadar caaddr caadr caar cadaar cadadr cadar caddar cadddr caddr cadr car cdaaar cdaadr cdaar cdadar cdaddr cdadr cdar cddaar cddadr cddar cdddar cddddr cdddr cddr cdr))