adding initial init.scm

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)) {

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))))
+