From d4c27b9c6303bad35c4c5e12fb0b9a5565ec0d8d Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Mon, 29 Jun 2015 17:59:14 -0400
Subject: [PATCH] Added a (when) macro

---
 TODO           | 3 ++-
 test2.scm      | 4 ++++
 transforms.scm | 6 ++++++
 3 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/TODO b/TODO
index 9c01edc7..c2a43efd 100644
--- a/TODO
+++ b/TODO
@@ -12,8 +12,9 @@ Working TODO list:
 
  - Constructs require for self-hosting
 
-   - named let
    - when
+   - eval
+     there is no concept of macro expansion, probably other deficiencies as well
 
    - vectors
        - make-vector should have an optional 'fill' arg in compiled code
diff --git a/test2.scm b/test2.scm
index d044e76e..2ff33cf1 100644
--- a/test2.scm
+++ b/test2.scm
@@ -6,3 +6,7 @@
   (if (zero? i)
     (write 'done)
     (loop (- i 1))))
+
+
+(write (when (lambda () #t) 'true))
+(write (when (lambda () #f) 'false))
diff --git a/transforms.scm b/transforms.scm
index 876436e0..f3ef815a 100644
--- a/transforms.scm
+++ b/transforms.scm
@@ -74,6 +74,12 @@
                 (error "bad let* syntax")))))
     (cons 'begin (lambda (exp rename compare) (begin=>let exp)))
     (cons 'letrec (lambda (exp rename compare) (letrec=>lets+sets exp)))
+    (cons 'when (lambda (exp rename compare)
+      (if (null? (cdr exp)) (error "empty when" exp))
+      (if (null? (cddr exp)) (error "no when body" exp))
+      `(if ,(cadr exp)
+           ((lambda () ,(caddr exp)))
+           #f)))
     (cons 'cond
           (lambda (expr rename compare)
             (if (null? (cdr expr))