diff --git a/src/expand.clj b/src/expand.clj index 1271909..905716b 100644 --- a/src/expand.clj +++ b/src/expand.clj @@ -210,7 +210,7 @@ (transcribe* 0 unification (s/conform ::template template))) (comment - (transcribe-transformer scheme-and '(and 1))) + (transcribe-transformer scheme-and '(and 1 2))) (defn transcribe-transformer [trans datum] (some (fn [{:keys [pattern template]}] @@ -317,8 +317,7 @@ (for [[x rhs] bindings] (bind-lexical [x scopes*] - [:macro (->> (expand rhs env symtable-ref scopes) - (s/conform ::transformer))] + [:macro (expand rhs env symtable-ref scopes)] symtable-ref)))] (concat (list 'let-syntax bindings) (for [e body] @@ -326,8 +325,9 @@ (defmethod expand-primitive 'syntax-rules [datum _ env symtable-ref scopes] - (assert (s/valid? ::prim-syntax-rules datum)) - datum) + (let [r (s/conform ::prim-syntax-rules datum)] + (assert (not (s/invalid? r))) + r)) (defn expand ([datum] @@ -346,8 +346,6 @@ (match (lookup [f scopes] env @symtable-ref) [:primitive prim] (expand-primitive datum prim env symtable-ref scopes) - [:macro trans] (todo "trans %s" (->> trans - (s/conform ::prim-syntax-rules) - pr-str)) + [:macro trans] (todo "trans %s" (->> (pr-str trans))) _ (cons (expand f env symtable-ref scopes) (map #(expand % env symtable-ref scopes) xs))))))