diff --git a/src/expand/syntax_rules.clj b/src/expand/syntax_rules.clj index c4b46e3..177f693 100644 --- a/src/expand/syntax_rules.clj +++ b/src/expand/syntax_rules.clj @@ -73,6 +73,10 @@ [(_ :guard wildcard?) _] {} [(x :guard symbol?) _] {x datum} + [(_ :guard scm/constant?) + (_ :guard scm/constant?)] + (when (= pattern datum) {}) + [([p (_ :guard ellipsis?) & ps] :seq) (ds :guard seq?)] (let [ds-end (take-last (count ps) ds) @@ -91,14 +95,11 @@ (merge-unify (unify p d) (unify (scm/datum->syntax ps pattern) (scm/datum->syntax ds datum))) + [([] :seq) ([] :seq)] {} - [(_ :guard scm/constant?) - (_ :guard scm/constant?)] - (when (= pattern datum) {}) - ;; no match :else nil)) @@ -111,15 +112,21 @@ (match (scm/syntax-e template) (_ :guard ellipsis?) (throw (IllegalArgumentException. "점점점은 여기 있으면 안 되다.")) + (x :guard symbol?) - (match (get unification x) - [:ellipsis xs] [:ellipsis xs] - nil (throw (Exception. "nosymmm")) - x-val x-val) + (or (get unification x) + (throw (Exception. "nosymmm"))) + + (_ :guard scm/constant?) + template ([x (_ :guard ellipsis?) & xs] :seq) (match (transcribe x unification) - [:ellipsis x*] (scm/datum->syntax x* template) + [:ellipsis x*] (let [xs* (transcribe (scm/datum->syntax xs template) + unification)] + (scm/datum->syntax + (concat x* (scm/syntax-e xs*)) + template)) :else (throw (IllegalArgumentException. "점점점은 나쁘다ㅠㅠ"))) ([x & xs] :seq) diff --git a/src/scm.clj b/src/scm.clj index 5f15072..7441508 100644 --- a/src/scm.clj +++ b/src/scm.clj @@ -55,7 +55,9 @@ ;; top-level scope를 짓겠는다. 그때 nil/#{}는 `::unresolved`를 ;; 대신하고 하나의 scope를 이루어진 집합은 #{}를 대신하겠는다. #_(= (syntax-context stx) ::unresolved) - (empty? (syntax-context stx))) + (let [x (syntax-context stx)] + (or (nil? x) + (and (coll? x) (empty? x))))) (defn resolved? [stx] (not (unresolved? stx))) diff --git a/test/expand/syntax_rules_test.clj b/test/expand/syntax_rules_test.clj index 49cba67..f9a3fde 100644 --- a/test/expand/syntax_rules_test.clj +++ b/test/expand/syntax_rules_test.clj @@ -9,6 +9,15 @@ (sut/unify* 'x '(1 2 3)))) (t/is (= '{x 1 y 2} (sut/unify* '(x y) '(1 2)))) + (t/testing "literals" + (t/is (= {} + (sut/unify* 123 123))) + (t/is (= nil + (sut/unify* 123 456))) + (t/is (= nil + (sut/unify* true 456))) + (t/is (= {} + (sut/unify* true true)))) (t/is (= '{x [:ellipsis (1 2 3 4)]} (sut/unify* '(x ...) '(1 2 3 4)))) (t/is (= '{x [:ellipsis (1 3)] @@ -42,7 +51,27 @@ (sut/transcribe* 'x '(x y) '(4 5)))) (t/is (= '(3 2 1) (sut/transcribe* '(z y x) '(x y z) '(1 2 3)))) + (t/is (= '(1 2 3) + (sut/transcribe* '(x ...) + '(x ...) + '(1 2 3)))) + (t/is (= 123 + (sut/transcribe* 123 + '_ + '(1 2 3 4 5)))) + (t/is (= '(111 3 4 5) + (sut/transcribe* '(111 x ...) + '(1 2 x ...) + '(1 2 3 4 5)))) + (t/is (= '(111 3 4 5 333) + (sut/transcribe* '(111 x ... 333) + '(1 2 x ...) + '(1 2 3 4 5)))) + (t/is (= '(3 4 5 3 4 5) + (sut/transcribe* '(x ... x ...) + '(1 2 x ...) + '(1 2 3 4 5)))) (t/is (= '(1 3 6) (sut/transcribe* '(x ...) - '((x _ ...) ...) - '((1 2) (3 4 5) (6 7 8 9)))))) + '((x _ ...) ...) + '((1 2) (3 4 5) (6 7 8 9))))))