scm: Add c????r.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 2 Apr 2017 07:35:47 +0000 (09:35 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 2 Apr 2017 07:35:47 +0000 (09:35 +0200)
* 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
module/mes/base.mes

index 78a525fd76c1fde41a99ee62e8582961705eb53d..11359fc2dab1255441748bea863df76f5f286329 100644 (file)
 (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 (eq? (cadar clauses) '=>)
-                                    (append2 (cddar clauses) '(test))
+                            (if (pair? (cdr (car clauses)))
+                                (if (eq? (car (cdr (car clauses))) '=>)
+                                    (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)))
           (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))
index 3bb1e4e5f9ca0cead70dff5ee082b9575de2f5d4..1c2f67986635a4a14b21405026668ab5f2751ec4 100644 (file)
 (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 (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 (cadar x) (car (cdr (car 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)
 
                   (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))) )))))
-