diff --git a/src/expand/syntax_rules.clj b/src/expand/syntax_rules.clj index c816015..f2a7b74 100644 --- a/src/expand/syntax_rules.clj +++ b/src/expand/syntax_rules.clj @@ -1,4 +1,26 @@ -(ns expand.syntax-rules) +(ns expand.syntax-rules + (:require [clojure.core.match :refer [match]] + [clojure.spec.alpha :as s] + [scm])) + +(s/def ::pattern + (s/or :wildcard #{'_} + :var (s/and symbol? (complement #{'... '_})) + :lit scm/constant? + :list (s/and seq? + (s/cat :leading (s/* ::pattern) + :rest (s/? (s/cat :ellipsis #{'...} + :trailing (s/* ::pattern)))) + (s/conformer + (fn [pat] + (if-some [{:keys [ellipsis trailing]} (:rest pat)] + (let [{:keys [leading]} pat] + (if-some [variadic (last leading)] + {:leading (vec (butlast leading)) + :ellipsis variadic + :trailing trailing} + ::s/invalid)) + pat)))))) (defn- report-conflict [x y] (throw (ex-info "너무 정의합니다" @@ -48,22 +70,12 @@ (defn unify [pattern datum] (unify* (s/conform ::pattern pattern) datum)) -(defn transcribe [template env symtable scopes] +(defn transcribe [template] (match template - [:var x] (let [x* (offer-scopes x scopes)] - (match (lookup x* env symtable) - [:syntax [:ellipsis fuckoffmanjustshadowit]] (todo "점점점") - [:syntax syn] syn - :else x*)) - [:ellipsis _] (todo "점점점") - [:lit x] x - [:list xs] - (do (tap> xs) - (map #(transcribe % env symtable scopes) xs)))) + [:var x] (throw (Exception. "todo")) + [:ellipsis _] (throw (Exception. "todo 점점점")) + [:lit x] (throw (Exception. "todo 점점점")) + [:list xs] (throw (Exception. "todo 점점점")))) -(defn resolve-template [template scopes] - (clojure.walk/postwalk - #(if (variable? %) - (offer-scopes % scopes) - %) - template)) +(comment + (unify 'x '(1 2 3))) diff --git a/test/expand/syntax_rules_test.clj b/test/expand/syntax_rules_test.clj new file mode 100644 index 0000000..fd5ed94 --- /dev/null +++ b/test/expand/syntax_rules_test.clj @@ -0,0 +1,23 @@ +(ns expand.syntax-rules-test + (:require [expand.syntax-rules :as sut] + [clojure.test :as t])) + +(t/deftest unify-test + (t/is (= '{x (1 2 3)} + (sut/unify 'x '(1 2 3)))) + (t/is (= '{x 1 y 2} + (sut/unify '(x y) + '(1 2)))) + (t/is (= '{x [:ellipsis (1 2 3 4)]} + (sut/unify '(x ...) + '(1 2 3 4)))) + (t/is (= '{x [:ellipsis (1 3)] + y [:ellipsis (2 4)]} + (sut/unify '((x y) ...) + '((1 2) (3 4))))) + (t/is (= nil + (sut/unify '(x y z) + '(1 2)))) + (t/is (= nil + (sut/unify '((x y) ...) + '((1 2) (1 2 3))))))