2010-m1s1-compilation/bootstrap/15.1-conses
2010-11-22 03:10:55 +01:00

56 lines
2.3 KiB
Plaintext

;; PRIMITIVE : car
;; PRIMITIVE : cdr
;; PRIMITIVE : cons
;; NEED : eql
;; NEED : complement
(defun caaaar (list) (car (car (car (car list)))))
(defun caaadr (list) (car (car (car (cdr list)))))
(defun caadar (list) (car (car (cdr (car list)))))
(defun caaddr (list) (car (car (cdr (cdr list)))))
(defun cadaar (list) (car (cdr (car (car list)))))
(defun cadadr (list) (car (cdr (car (cdr list)))))
(defun caddar (list) (car (cdr (cdr (car list)))))
(defun cadddr (list) (car (cdr (cdr (cdr list)))))
(defun cdaaar (list) (cdr (car (car (car list)))))
(defun cdaadr (list) (cdr (car (car (cdr list)))))
(defun cdadar (list) (cdr (car (cdr (car list)))))
(defun cdaddr (list) (cdr (car (cdr (cdr list)))))
(defun cddaar (list) (cdr (cdr (car (car list)))))
(defun cddadr (list) (cdr (cdr (car (cdr list)))))
(defun cdddar (list) (cdr (cdr (cdr (car list)))))
(defun cddddr (list) (cdr (cdr (cdr (cdr list)))))
(defun caaar (list) (car (car (car list)))))
(defun caadr (list) (car (car (cdr list)))))
(defun cadar (list) (car (cdr (car list)))))
(defun caddr (list) (car (cdr (cdr list)))))
(defun cdaar (list) (cdr (car (car list)))))
(defun cdadr (list) (cdr (car (cdr list)))))
(defun cddar (list) (cdr (cdr (car list)))))
(defun cdddr (list) (cdr (cdr (cdr list)))))
(defun caar (list) (car (car list)))))
(defun cadr (list) (car (cdr list)))))
(defun cdar (list) (cdr (car list)))))
(defun cddr (list) (cdr (cdr list)))))
;; Comptez les "d" :)
(defun first (list) (car list))
(defun second (list) (cadr list))
(defun third (list) (caddr list))
(defun fourth (list) (cadddr list))
(defun fifth (list) (car (cddddr list)))
(defun sixth (list) (cadr (cddddr list)))
(defun seventh (list) (caddr (cddddr list)))
(defun eighth (list) (cadddr (cddddr list)))
(defun ninth (list) (car (cddddr (cddddr list))))
(defun tenth (list) (cadr (cddddr (cddddr list))))
(defun tree-equal (x y &key (:test #'eql) :test-not)
(when test-not (setq test (complement test-not)))
(if (or (consp x) (consp y))
(and (consp x)
(consp y)
(tree-equal (car x) (car y) :test test)
(tree-equal (cdr x) (cdr y) :test test))
(funcall test x y)))