fix tests }:)

src/expand.clj

@@ -233,7 +233,6 @@
               scopes)))
 
 (defn lookup [variable env symtable]
-  (tap> [variable env symtable])
   (let [[sym scopes] (or (destructure-variable variable)
                          (throw (ex-info "not a var" {:var variable})))
         ss (symtable-scopes symtable sym)]
@@ -256,8 +255,8 @@
     prim-name))
 
 (defn new-scope
-  ([] (gensym))
-  ([prefix] (gensym prefix)))
+  ([] (gensym "scope__"))
+  ([prefix] (gensym (str "scope__" prefix))))
 
 (defn bind-lexical [[sym scopes] denot symtable-ref]
   (let [bind [:lexical sym (gensym)]]
@@ -447,7 +446,6 @@
    (expand
     datum scheme-base-env (atom (symtable-for-env scheme-base-env)) #{}))
   ([datum env symtable-ref scopes]
-   (tap> datum)
    (match datum
      ;; literals
      (x :guard literal?) x
@@ -459,11 +457,37 @@
 
      ;; lists
      ([f & xs] :seq)
-     (if (variable? f)
-       (do (tap> f)
-           (match (lookup (offer-scopes f scopes) env @symtable-ref)
+     (or (when-some [v (and (variable? f)
+                            (offer-scopes f scopes))]
+           (match (lookup v env @symtable-ref)
              [:primitive prim] (expand-primitive
                                 datum prim env symtable-ref scopes)
-             [:macro trans] (expand-macro trans datum env symtable-ref scopes)))
-       (cons (expand f env symtable-ref scopes)
-             (map #(expand % env symtable-ref scopes) xs))))))
+             [:macro trans] (expand-macro trans datum env symtable-ref scopes)
+             [:var] nil))
+         (cons (expand f env symtable-ref scopes)
+               (map #(expand % env symtable-ref scopes) xs))))))
+
+
+
+(defn beautify
+  "Renumber the gensyms created by `new-scope` found in datum,
+  starting from zero."
+  [datum]
+  (let [c (atom 0)]
+    (walk/postwalk (fn [x]
+                     (if (and (symbol? x)
+                              (clojure.string/starts-with?
+                               (name x)
+                               "scope__"))
+                       (symbol (str "s" (first (swap-vals! c inc))))
+                       x))
+                   datum)))
+
+(defn unscope
+  "Remove all scopes from the variables found in datum."
+  [datum]
+  (walk/postwalk (fn [x]
+                   (if (instance? Variable x)
+                     (variable-symbol x)
+                     x))
+                 datum))

test/expand_test.clj

@@ -43,12 +43,15 @@
   (t/testing "simple data"
     (t/is (= 'a (s/conform ::patern 'a)))))
 
+(defn- us-expand [datum]
+  (sut/unscope (sut/expand datum)))
+
 (t/deftest expand-test
   (t/testing "unbound symbol"
     (t/is (thrown? Exception (sut/expand 'x))))
   (t/testing "lambda"
     (t/is (= '(lambda (x) x)
-             (sut/expand '(λ (x) x)))))
+             (us-expand '(λ (x) x)))))
   #_(t/testing "syntax-rules"
     (t/is (= '(lambda (x) x)
              (sut/expand
@@ -59,13 +62,13 @@
     (t/is (= '(let ((x 123)
                     (y 456))
                 (+ x y))
-             (sut/expand
+             (us-expand
               '(let ((x 123)
                      (y 456))
                  (+ x y))))))
   (t/testing "application"
     (t/is (= '(lambda (f x) (f x))
-             (sut/expand '(lambda (f x) (f x)))))))
+             (us-expand '(lambda (f x) (f x)))))))
 
 (t/deftest prim-lambda-spec
   (t/is (s/valid? ::sut/prim-lambda '(lambda (x) x)))