src/expand/core.clj

@@ -8,7 +8,8 @@
             [expand.common :refer :all]
             [expand.scm :as scm]
             [expand.syntax-rules :as syntax-rules]
-            [spec-dict.main :refer [dict]]))
+            [spec-dict.main :refer [dict]]
+            [clojure.walk :as walk]))
 
 (defn- conform! [spec x]
   (let [r (s/conform spec x)]
@@ -49,8 +50,7 @@
   #(match %
      [:var] true
      [:primitive p] (primitives p)
-     ;; 나쁜
-     [:macro trans] (contains? trans :rules)
+     [:macro form trans] (ifn? trans)
      [:syntax datum] true))
 
 (s/def ::environment
@@ -227,7 +227,9 @@
      (fn [scopeholder env*]
        (concat (list 'let
                      (for [{:keys [rhs lhs]} bindings]
-                       (list (scm/rescope rhs scopeholder) lhs)))
+                       (list (scm/rescope rhs scopeholder)
+                             ;; todo: 여기에 expand함
+                             lhs)))
                (for [x body]
                  (expand (scm/rescope x scopeholder)
                          env* store-atom)))))))
@@ -243,19 +245,35 @@
 
 (defmethod expand-primitive 'let-syntax
   [stx _ env store-atom]
-  (let [_ (s/conform ::prim-let-syntax stx)]))
+  (let [{:keys [bindings body]} (conform! ::prim-let-syntax stx)]
+    (assert (list? bindings))
+    (assert (list? body))
+    (let [bindings* (for [{:keys [rhs lhs]} bindings]
+                      {:rhs rhs
+                       :lhs (expand lhs env store-atom)})]
+      (binding-form
+       stx env store-atom
+       (for [{:keys [rhs lhs]} bindings*]
+         (let [lhs* (expand lhs env store-atom)]
+           (assert (scm/macro? lhs*)
+                   "let-syntax의 왼쪽은 마크로 아니다.")
+           [(scm/syntax-e rhs) lhs*]))
+       (fn [scopeholder env*]
+         (concat (list 'let-syntax
+                       (for [{:keys [rhs lhs]} bindings*]
+                         (list (scm/rescope rhs scopeholder) lhs)))))))))
 
 (defmethod expand-primitive 'syntax-rules
   [stx _ env store-atom]
   (let [trans (conform! ::prim-syntax-rules stx)]
-    (dbg> trans)
-    (dbg> (scm/datum->syntax
-           [:macro
-            #(let [intro (scm/new-scopeholder stx)
-                   r (syntax-rules/invoke trans %)]
-               (assert r "맞은 패턴은 찾을 수 없었다")
-               r)]
-           stx))))
+    (scm/datum->syntax
+     [:macro
+      stx
+      #(let [intro (scm/new-scopeholder stx)
+             r (syntax-rules/invoke trans %)]
+         (assert r "맞은 패턴은 찾을 수 없었다")
+         r)]
+     stx)))
 
 (defn expand
   ([stx]
@@ -329,15 +347,26 @@
                   [:import & xs] (cons 'import xs)
                   [:export & xs] (cons 'export xs))))))
 
+(defn macro->datum [macro]
+  (match macro
+    [:macro stx _] (scm/syntax->datum stx)))
+
 (defn library-syntax->datum [lib]
   (update lib :library/declarations
           (fn [decls]
             (for [decl decls]
               (match decl
-                [:begin & xs] (->> xs
-                                   (map scm/syntax->datum)
-                                   (cons :begin)
-                                   vec)
+                [:begin & xs]
+                (->> xs
+                     (map scm/syntax->datum)
+                     (map (fn [x]
+                            (walk/prewalk
+                             #(if (scm/macro? %)
+                                (dbg> (scm/macro-form %))
+                                %)
+                             x)))
+                     (cons :begin)
+                     vec)
                 :else decl)))))
 
 (comment
@@ -346,7 +375,10 @@
       (scm/read-syntax :library? true :throw? true)
       expand-library
       library-syntax->datum
-      library->datum)
+      library->datum
+      #_#_#_(nth 3)
+      (nth 1)
+      scm/macro?)
   (let [scopeholder (scm/new-scopeholder)
         env {[:global 'lambda] [:primitive 'lambda]}
         store-atom (atom {['lambda #{}] [:global 'lambda]})]

src/expand/scm.clj

@@ -276,9 +276,20 @@
 
 (defn macro? [x]
   (match x
-    [:macro f] (fn? x)
+    [:macro _ f] (ifn? x)
+    (_ :guard syntax?) (-> x syntax-e macro?)
     :else false))
 
+(defn macro-form [macro]
+  (match macro
+    [:macro stx _] stx
+    (_ :guard syntax?) (-> macro syntax-e macro-form)))
+
+(defn macro-fn [macro]
+  (match macro
+    [:macro _ f] f
+    (_ :guard syntax?) (-> macro syntax-e macro-fn)))
+
 (defn datum? [x]
   (or (number? x)
       (boolean? x)