src/expand.clj

@@ -17,8 +17,8 @@
      [:global sym] (symbol? sym)))
 
 (s/def ::pattern
-  (s/or :var (s/and symbol?
-                    #(not= '... %))
+  (s/or :wildcard #{'_}
+        :var (s/and symbol? (complement #{'... '_}))
         :lit ::literal
         :list (s/and seq?
                      (s/cat :leading (s/* ::pattern)
@@ -119,8 +119,8 @@
 
 (defn- unify* [pattern datum]
   (match [pattern datum]
-    [[:var x] _]
-    {x datum}
+    [[:wildcard _] _] {}
+    [[:var x] _] {x datum}
     
     [[:list {:leading leading
              :trailing nil

test/expand_test.clj

@@ -1,7 +1,8 @@
 (ns expand-test
   (:require [expand :as sut]
             [clojure.test :as t]
-            [clojure.spec.alpha :as s]))
+            [clojure.spec.alpha :as s]
+            [clojure.core.match :refer [match]]))
 
 (t/deftest scheme-base-env-test
   (t/is (s/valid? ::sut/environment sut/scheme-base-env)))
@@ -19,6 +20,13 @@
                         [#{0} #{0 1} #{0 3}]))))
 
 (t/deftest pattern-spec
+  (t/testing "var"
+    (let [pattern-var? #(match (s/conform ::pattern %)
+                          [:var _] true
+                          _ false)]
+      (t/is (pattern-var? 'abc))
+      (t/is (not (pattern-var? '_)))
+      (t/is (not (pattern-var? '...)))))
   (t/testing "list"
     (t/are [l e t x] (= [l e t]
                         ((juxt :leading :ellipsis :trailing)
@@ -41,6 +49,12 @@
   (t/testing "lambda"
     (t/is (= '(lambda (x) x)
              (sut/expand '(λ (x) x)))))
+  #_(t/testing "syntax-rules"
+    (t/is (= '(lambda (x) x)
+             (sut/expand
+              '(syntax-rules
+                ()
+                ((_)))))))
   (t/testing "let"
     (t/is (= '(let ((x 123)
                     (y 456))
@@ -98,7 +112,9 @@
 
     '{b [:ellipsis ([:ellipsis (1 2)] [:ellipsis (3 4)])]}
     '((b ...) ...)
-    '((1 2) (3 4))))
+    '((1 2) (3 4))
+
+    {} '_ 123))
 
 (t/deftest transcribe-test
   (t/are [result datum pattern template]