From 040a1862c3c718336a1a4965b02a79ac3a046518 Mon Sep 17 00:00:00 2001
From: rhiannon morris <rhi@rhiannon.website>
Date: Sun, 5 Nov 2023 15:45:33 +0100
Subject: [PATCH] refactor scheme prelude

---
 lib/Quox/Untyped/Scheme.idr | 28 ++++++++++------------------
 1 file changed, 10 insertions(+), 18 deletions(-)

diff --git a/lib/Quox/Untyped/Scheme.idr b/lib/Quox/Untyped/Scheme.idr
index 36fbdd4..4998f93 100644
--- a/lib/Quox/Untyped/Scheme.idr
+++ b/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 ...)
-     (lambda (x0) (lambda% (x1 ...) body ...))]
-    [(_ () body ...)
-     (begin body ...)]))
+    [(_ (x . xs) . body) (lambda (x) (lambda% xs . body))]
+    [(_ ()       . body) (begin . body)]))
 
 ; curried application
 (define-syntax %
   (syntax-rules ()
-    [(_ e0 e1 e2 ...)
-     (% (e0 e1) e2 ...)]
+    [(_ e0 e1 . es) (% (e0 e1) . es)]
     [(_ e) e]))
 
 ; curried function definition
 (define-syntax define%
   (syntax-rules ()
-    [(_ (f x ...) body ...)
-     (define f (lambda% (x ...) body ...))]
-    [(_ x body ...)
-     (define x body ...)]))
+    [(_ (f . xs) . body) (define f (lambda% xs . body))]
+    [(_ f        . body) (define f . body)]))
 
 (define-syntax builtin-io
   (syntax-rules ()
-    [(_ body ...)
-     (lambda (s)
-       (let [(res (begin body ...))]
-         (cons res s)))]))
+    [(_ . body) (lambda (s) (cons (begin . body) s))]))
 
 (define (case-nat-rec z s n)
-  (let go [(acc (z)) (i 0)]
-    (if (= i n) acc (go (s i acc) (+ i 1)))))
+  (do [(i 0 (+ i 1)) (acc (z) (s i acc))]
+      [(= 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