if let

src/expand.clj

@@ -102,6 +102,25 @@
           :formals ::lambda-formals
           :body ::body)))
 
+(s/def ::prim-let
+  (s/and ::unsyntax
+         (s/cat :keyword ::identifier
+                :bindings
+                (s/and ::unsyntax
+                       (s/coll-of
+                        (s/and ::unsyntax
+                               (s/cat :rhs ::identifier
+                                      :lhs ::datum))
+                        :kind sequential?))
+                :body ::body)))
+
+(s/def ::prim-if
+  (s/and ::unsyntax
+         (s/cat :keyword ::identifier
+                :condition ::datum
+                :consequent ::datum
+                :alternative ::datum)))
+
 
 
 #_
@@ -188,6 +207,31 @@
                  (expand (scm/rescope x scopeholder)
                          env* store-atom)))))))
 
+(defmethod expand-primitive 'let
+  [stx _ env store-atom]
+  (let [{:keys [bindings body]} (s/conform ::prim-let stx)]
+    (assert (list? bindings))
+    (binding-form
+     stx env store-atom
+     (doall (for [{:keys [rhs]} bindings]
+              [(scm/syntax-e rhs) [:var]]))
+     (fn [scopeholder env*]
+       (concat (list 'let
+                     (for [{:keys [rhs lhs]} bindings]
+                       (list (scm/rescope rhs scopeholder) lhs)))
+               (for [x body]
+                 (expand (scm/rescope x scopeholder)
+                         env* store-atom)))))))
+
+(defmethod expand-primitive 'if
+  [stx _ env store-atom]
+  (let [{:keys [condition consequent alternative]}
+        (s/conform ::prim-if stx)]
+    (assert ((every-pred scm/datum?) condition consequent alternative))
+    (cons 'if
+          (for [x [condition consequent alternative]]
+            (expand x env store-atom)))))
+
 (defn expand
   ([stx]
    (let [scopeholder (scm/new-scopeholder)

test/expand_test.clj

@@ -45,10 +45,26 @@
       scm/syntax->datum))
 
 (t/deftest expand-test
-  (t/is (= '(lambda (x) x)
-           (expand #scm/stx (#scm/stx lambda
-                             #scm/stx (#scm/stx x)
-                             #scm/stx x)))))
+  (t/is (thrown? Exception (expand #scm/stx x)))
+  (t/testing "primitive forms"
+    (t/testing "lambda"
+      (t/is (= '(lambda (x) x)
+               (expand #scm/stx (#scm/stx lambda
+                                 #scm/stx (#scm/stx x)
+                                 #scm/stx x)))))
+    (t/testing "let"
+      (t/is (= '(let ((x 123))
+                  x)
+               (expand #scm/stx (#scm/stx let
+                                 #scm/stx (#scm/stx (#scm/stx x
+                                                     #scm/stx 123))
+                                 #scm/stx x)))))
+    (t/testing "if"
+      (t/is (= '(if 123 true false)
+               (expand #scm/stx (#scm/stx if
+                                 #scm/stx 123
+                                 #scm/stx true
+                                 #scm/stx false)))))))
 
 
 ;;; specs