src/expand.clj

@@ -1,11 +1,11 @@
 (ns expand
-  (:require [clojure.spec.alpha :as s]
-            [clojure.core.match :refer [match]]
-            [spec-dict.main :refer [dict]]
-            [clojure.set :as set]
-            [clojure.pprint :as pprint]
-            [clojure.string :as str]
-            [clojure.walk]))
+  (:require
+   [clojure.core.match :refer [match]]
+   [clojure.pprint :as pprint]
+   [clojure.set :as set]
+   [clojure.spec.alpha :as s]
+   [clojure.walk]
+   [spec-dict.main :refer [dict]]))
 
 (defmacro todo
   ([] `(throw (ex-info "todo" {})))
@@ -392,7 +392,9 @@
                     (for [x formals]
                       (bind-lexical [x scopes*]
                                     [:var] symtable-ref)))]
-    (concat (list 'lambda formals)
+    (concat (list 'lambda
+                  (for [x formals]
+                    (offer-scopes x scopes*)))
             (for [e body]
               (expand e env* symtable-ref scopes*)))))
 
@@ -416,10 +418,12 @@
         scopes* (conj scopes (new-scope))
         env* (apply merge env
                     (for [[x rhs] bindings]
-                      (bind-lexical
-                       [x scopes*]
-                       [:macro (expand rhs env symtable-ref scopes)]
-                       symtable-ref)))]
+                      (let [trans (->> (expand rhs env symtable-ref scopes)
+                                       (s/conform ::prim-syntax-rules))]
+                        (bind-lexical
+                         [x scopes*]
+                         [:macro trans]
+                         symtable-ref))))]
     (concat (list 'let-syntax bindings)
             (for [e body]
               (expand e env* symtable-ref scopes*)))))
@@ -428,7 +432,7 @@
   [datum _ env symtable-ref scopes]
   (let [r (s/conform ::prim-syntax-rules datum)]
     (assert (not (s/invalid? r)))
-    r))
+    datum))
 
 (defmethod expand-primitive 'if
   [datum _ env symtable-ref scopes]
@@ -522,3 +526,9 @@
        (variable-symbol x)
        x))
    datum))
+
+(defn us-expand [datum]
+  (unscope (expand datum)))
+
+(defn rg-expand [datum]
+  (regensym (expand datum)))