scm: Add c????r.

* module/mes/base-0.mes (caar, cadr, cdar, cddr, map): Remove.  Update callers.
* module/mes/base.mes (): Remove.
* module/mes/base.mes (cadadr, cddadr, cdddar): New function.

module/mes/base-0.mes

@@ -35,13 +35,8 @@
 (define (primitive-eval e) (core:eval e (current-module)))
 (define eval core:eval)
 
-(define (caar x) (car (car x)))
-(define (cadr x) (car (cdr x)))
-(define (cdar x) (cdr (car x)))
-(define (cddr x) (cdr (cdr x)))
-
 (define-macro (defined? x)
-  (list 'assq x '(cddr (current-module))))
+  (list 'assq x '(cdr (cdr (current-module)))))
 
 (if (defined? 'current-input-port) #t
     (define (current-input-port) 0))
@@ -58,7 +53,6 @@
   (if (null? (cdr rest)) (car rest)
       (cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
 
-(define (apply f h . t) (apply-env f (cons h t) (current-module)))
 (define (apply f h . t)
   (if (null? t) (core:apply f h (current-module))
       (apply f (apply cons* (cons h t)))))
@@ -70,9 +64,9 @@
                (cons
                 '(test)
                 (list (list 'if 'test
-                            (if (pair? (cdar clauses))
+                            (if (pair? (cdr (car clauses)))
-                                (if (eq? (cadar clauses) '=>)
+                                (if (eq? (car (cdr (car clauses))) '=>)
-                                    (append2 (cddar clauses) '(test))
+                                    (append2 (cdr (cdr (car clauses))) '(test))
                                     (list (cons 'lambda (cons '() (car clauses)))))
                                 (list (cons 'lambda (cons '() (car clauses)))))
                             (if (pair? (cdr clauses))
@@ -81,6 +75,7 @@
 
 (define else #t)
 
+(define (cadr x) (car (cdr x)))
 (define-macro (simple-let bindings . rest)
   (cons (cons 'lambda (cons (map1 car bindings) rest))
         (map1 cadr bindings)))
@@ -150,8 +145,8 @@
           (list 'set! '*modules* (list cons (list string->symbol (module->file module)) '*modules*))
           (list 'load (list string-append '*mes-prefix* (module->file module)))))))
 
-(mes-use-module (srfi srfi-0))
 (mes-use-module (mes base))
+(mes-use-module (srfi srfi-0))
 (mes-use-module (mes quasiquote))
 (mes-use-module (mes let))
 (mes-use-module (mes scm))

module/mes/base.mes

@@ -31,15 +31,43 @@
 (define (cadr x) (car (cdr x)))
 (define (cdar x) (cdr (car x)))
 (define (cddr x) (cdr (cdr x)))
+
+
 (define (caaar x) (car (car (car x))))
 (define (caadr x) (car (car (cdr x))))
-(define (caddr x) (car (cdr (cdr x))))
-(define (cdadr x) (cdr (car (cdr x))))
 (define (cadar x) (car (cdr (car x))))
+(define (caddr x) (car (cdr (cdr x))))
+
+(define (cdaar x) (cdr (car (car x))))
+(define (cdadr x) (cdr (car (cdr x))))
 (define (cddar x) (cdr (cdr (car x))))
 (define (cdddr x) (cdr (cdr (cdr x))))
+
+
+
+(define (caaaar x) (car (car (car (car x)))))
+(define (caaadr x) (car (car (car (cdr x)))))
+(define (caadar x) (car (car (cdr (car x)))))
+(define (caaddr x) (car (car (cdr (cdr x)))))
+
+(define (cadaar x) (car (cdr (car (car x)))))
+(define (cadadr x) (car (cdr (car (cdr x)))))
+(define (caddar x) (car (cdr (cdr (car x)))))
 (define (cadddr x) (car (cdr (cdr (cdr x)))))
 
+
+(define (cdaaar x) (cdr (car (car (car x)))))
+(define (cdaadr x) (cdr (car (car (cdr x)))))
+(define (cdadar x) (cdr (car (cdr (car x)))))
+(define (cdaddr x) (cdr (car (cdr (cdr x)))))
+
+(define (cddaar x) (cdr (cdr (car (car x)))))
+(define (cddadr x) (cdr (cdr (car (cdr x)))))
+(define (cdddar x) (cdr (cdr (cdr (car x)))))
+(define (cddddr x) (cdr (cdr (cdr (cdr x)))))
+
+
+
 (define (identity x) x)
 (define call/cc call-with-current-continuation)
 
@@ -91,4 +119,3 @@
                   (if (null? (cdddr r))
                       (cons (f (car l) (caar r) (caadr r) (car (caddr r))) (map f (cdr l) (cdar r) (cdadr r) (cdr (caddr r))))
                       (error 'unsupported (cons* "map 5:" f l r))) )))))
-