refactor scheme prelude

lib/Quox/Untyped/Scheme.idr

@@ -237,46 +237,38 @@ export
 prelude : String
 prelude = """
 #!r6rs
+(import (rnrs))
 
 ; curried lambda
 (define-syntax lambda%
   (syntax-rules ()
-    [(_ (x0 x1 ...) body ...)
+    [(_ (x . xs) . body) (lambda (x) (lambda% xs . body))]
-     (lambda (x0) (lambda% (x1 ...) body ...))]
+    [(_ ()       . body) (begin . body)]))
-    [(_ () body ...)
-     (begin body ...)]))
 
 ; curried application
 (define-syntax %
   (syntax-rules ()
-    [(_ e0 e1 e2 ...)
+    [(_ e0 e1 . es) (% (e0 e1) . es)]
-     (% (e0 e1) e2 ...)]
     [(_ e) e]))
 
 ; curried function definition
 (define-syntax define%
   (syntax-rules ()
-    [(_ (f x ...) body ...)
+    [(_ (f . xs) . body) (define f (lambda% xs . body))]
-     (define f (lambda% (x ...) body ...))]
+    [(_ f        . body) (define f . body)]))
-    [(_ x body ...)
-     (define x body ...)]))
 
 (define-syntax builtin-io
   (syntax-rules ()
-    [(_ body ...)
+    [(_ . body) (lambda (s) (cons (begin . body) s))]))
-     (lambda (s)
-       (let [(res (begin body ...))]
-         (cons res s)))]))
 
 (define (case-nat-rec z s n)
-  (let go [(acc (z)) (i 0)]
+  (do [(i 0 (+ i 1)) (acc (z) (s i acc))]
-    (if (= i n) acc (go (s i acc) (+ i 1)))))
+      [(= i n) acc]))
 
 (define (case-nat-nonrec z s n)
   (if (= n 0) (z) (s (- n 1))))
 
-(define (run-main f) (f 'io-state) (void))
+(define (run-main f) (f 'io-state))
-;;;;;;
 """
 
 export