From 854bb85d105d3abcc6e53ed8d264e9edf997d18c Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Wed, 11 Mar 2009 19:40:04 +0900
Subject: [PATCH] adding initial init.scm

---
 eval.c   |  2 +-
 init.scm | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 52 insertions(+), 1 deletion(-)
 create mode 100644 init.scm

diff --git a/eval.c b/eval.c
index c2e95d90..716500fc 100644
--- a/eval.c
+++ b/eval.c
@@ -610,7 +610,7 @@ bytecode compile(sexp params, sexp obj, env e, sexp fv, sexp sv, int done_p) {
       emit(&bc, &i, OP_DROP);
     } else {
       analyze(SEXP_CAR(obj), &bc, &i, e, params, fv, sv, &d,
-              ! done_p && ! SEXP_PAIRP(internals));
+              (! done_p) && (! SEXP_PAIRP(internals)));
     }
   }
   if (SEXP_PAIRP(internals)) {
diff --git a/init.scm b/init.scm
new file mode 100644
index 00000000..af5a820e
--- /dev/null
+++ b/init.scm
@@ -0,0 +1,51 @@
+
+;; provide c[ad]{2,4}r
+
+(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 (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 (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)))))
+
+;; map with a fast-path for single lists
+
+(define (map proc ls . lol)
+  (if (null? lol)
+      (map1 proc ls '())
+      (mapn proc (cons ls lol) '())))
+
+(define (map1 proc ls res)
+  (if (pair? ls)
+      (map1 proc (cdr ls) (cons (proc (car ls)) res))
+      (reverse res)))
+
+(define (mapn proc lol res)
+  (if (null? lol)
+      (reverse res)
+      (mapn proc (cdr lol) (cons (apply proc (map1 car lol)) res))))
+