From 53b882d909d7c66d53a36e12839c0fe48ee8e730 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Sun, 28 Jun 2015 16:06:13 -0400
Subject: [PATCH] Added named let using chibi's macro

---
 test2.scm      | 13 ++++---------
 transforms.scm | 38 ++++++++++++++++++++++++++++++--------
 2 files changed, 34 insertions(+), 17 deletions(-)

diff --git a/test2.scm b/test2.scm
index 7f3127bd..d044e76e 100644
--- a/test2.scm
+++ b/test2.scm
@@ -2,12 +2,7 @@
         (scheme file)
         (scheme write))
 
-;; TODO: fails with an "unspecified" error unless there is an else clause. WTF?
-;(write 
-  (cond
-    (#f #f)
-    ;(else #t)
-  )
-;)
-1
-
+(let loop ((i 10))
+  (if (zero? i)
+    (write 'done)
+    (loop (- i 1))))
diff --git a/transforms.scm b/transforms.scm
index 627e7c5b..876436e0 100644
--- a/transforms.scm
+++ b/transforms.scm
@@ -34,7 +34,29 @@
                     (list (rename 'if) (rename 'tmp)
                           (rename 'tmp)
                           (cons (rename 'or) (cddr expr))))))))
-    (cons 'let (lambda (exp rename compare) (let=>lambda exp)))
+;    (cons 'let (lambda (exp rename compare) (let=>lambda exp)))
+    (cons 'let
+     (lambda (expr rename compare)
+       (if (null? (cdr expr)) (error "empty let" expr))
+       (if (null? (cddr expr)) (error "no let body" expr))
+       ((lambda (bindings)
+          (if (list? bindings) #f (error "bad let bindings"))
+          (if (every (lambda (x)
+                       (if (pair? x) (if (pair? (cdr x)) (null? (cddr x)) #f) #f))
+                     bindings)
+              ((lambda (vars vals)
+                 (if (symbol? (cadr expr))
+                     `((,(rename 'lambda) ,vars
+                        (,(rename 'letrec) ((,(cadr expr)
+                                             (,(rename 'lambda) ,vars
+                                              ,@(cdr (cddr expr)))))
+                         (,(cadr expr) ,@vars)))
+                       ,@vals)
+                     `((,(rename 'lambda) ,vars ,@(cddr expr)) ,@vals)))
+               (map car bindings)
+               (map cadr bindings))
+              (error "bad let syntax" expr)))
+        (if (symbol? (cadr expr)) (car (cddr expr)) (cadr expr)))))
     (cons 'let*
       (lambda (expr rename compare)
         (if (null? (cdr expr)) (error "empty let*" expr))
@@ -857,13 +879,13 @@
 ; TODO: eventually, merge below functions with above *defined-macros* defs and 
 ;;      replace both with a lib of (define-syntax) constructs
 
-; let=>lambda : let-exp -> app-exp
-(define (let=>lambda exp)
-  (if (let? exp)
-      (let ((vars (map car (let->bindings exp)))
-            (args (map cadr (let->bindings exp))))
-        `((lambda (,@vars) ,@(let->exp exp)) ,@args))
-      exp))
+;; let=>lambda : let-exp -> app-exp
+;(define (let=>lambda exp)
+;  (if (let? exp)
+;      (let ((vars (map car (let->bindings exp)))
+;            (args (map cadr (let->bindings exp))))
+;        `((lambda (,@vars) ,@(let->exp exp)) ,@args))
+;      exp))
 
 ; letrec=>lets+sets : letrec-exp -> exp
 (define (letrec=>lets+sets exp)