declare core syntaces individually separate from (scheme base)

piclib/built-in.scm

@@ -1,4 +1,6 @@
 ;;; hygienic macros
+(define-library (picrin macro)
+  (import (scheme base))
 
   (define (sc-macro-transformer f)
     (lambda (expr use-env mac-env)
@@ -32,46 +34,28 @@
         (walk (lambda (x) (if (symbol? x) (inject x) x)) expr))
       (make-syntactic-closure mac-env '() (f renamed inject compare))))
 
-;;; Core syntaxes
+  (export sc-macro-transformer
+          rsc-macro-transformer
+          er-macro-transformer
+          ir-macro-transformer))
 
-(define (list . args)
-  args)
+;;; core syntaces
+(define-library (picrin core-syntax)
+  (import (scheme base)
+          (picrin macro))
 
-(define (caar p)
-  (car (car p)))
+  (define (list . args) args)
 
-(define (cadr p)
-  (car (cdr p)))
+  (define (caar p) (car (car p)))
+  (define (cadr p) (car (cdr p)))
+  (define (cdar p) (cdr (car p)))
+  (define (cddr p) (cdr (cdr p)))
 
-(define (cdar p)
-  (cdr (car p)))
-
-(define (cddr p)
-  (cdr (cdr p)))
-
-(define (any pred list)
+  (define (map f list)
     (if (null? list)
-      #f
-      ((lambda (it)
-	 (if it
-	     it
-	     (any pred (cdr list))))
-       (pred (car list)))))
-
-(define (map f list . lists)
-  (define (single-map f list)
-    (if (null? list)
-	'()
+        list
         (cons (f (car list))
               (map f (cdr list)))))
-  (define (multiple-map f lists)
-    (if (any null? lists)
-	'()
-	(cons (apply f (single-map car lists))
-	      (multiple-map f (single-map cdr lists)))))
-  (if (null? lists)
-      (single-map f list)
-      (multiple-map f (cons list lists))))
 
   (define-macro (let bindings . body)
     (if (symbol? bindings)
@@ -188,6 +172,47 @@
   (define-auxiliary-syntax unquote)
   (define-auxiliary-syntax unquote-splicing)
 
+  (export let let* letrec letrec*
+          quasiquote unquote unquote-splicing
+          and or
+          cond else =>
+          do
+          when unless
+          _ ...))
+
+(import (picrin macro)
+        (picrin core-syntax))
+
+(define (list . args)
+  args)
+
+(define (caar p)
+  (car (car p)))
+
+(define (cadr p)
+  (car (cdr p)))
+
+(define (cdar p)
+  (cdr (car p)))
+
+(define (cddr p)
+  (cdr (cdr p)))
+
+(define (append xs ys)
+  (if (null? xs)
+      ys
+      (cons (car xs)
+            (append (cdr xs) ys))))
+
+(define (any pred list)
+  (if (null? list)
+      #f
+      ((lambda (it)
+	 (if it
+	     it
+	     (any pred (cdr list))))
+       (pred (car list)))))
+
 (define (every pred list)
   (if (null? list)
       #t
@@ -383,7 +408,11 @@
 
 (define-macro (define-char-transitive-predicate name op)
   `(define (,name . cs)
-     (apply ,op (map char->integer cs))))
+     (letrec ((map (lambda (f list)
+                     (if (null? list)
+                         list
+                         (cons (f (car list)) (map f (cdr list)))))))
+       (apply ,op (map char->integer cs)))))
 
 (define-char-transitive-predicate char=? =)
 (define-char-transitive-predicate char<? <)
@@ -561,6 +590,21 @@
 
 ;;; 6.10 control features
 
+(define (map f list . lists)
+  (define (single-map f list)
+    (if (null? list)
+	'()
+	(cons (f (car list))
+	      (map f (cdr list)))))
+  (define (multiple-map f lists)
+    (if (any null? lists)
+	'()
+	(cons (apply f (single-map car lists))
+	      (multiple-map f (single-map cdr lists)))))
+  (if (null? lists)
+      (single-map f list)
+      (multiple-map f (cons list lists))))
+
 (define (for-each f list . lists)
   (define (single-for-each f list)
     (if (null? list)