From cb566444a5ddecf70496945f8e2df9769f6c6f2f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Thu, 24 Sep 2026 10:46:13 -0600 Subject: [PATCH] --- src/expand/core.clj | 68 +++++++++++++++++++++++++++++++++------------ src/expand/scm.clj | 13 ++++++++- 2 files changed, 62 insertions(+), 19 deletions(-) diff --git a/src/expand/core.clj b/src/expand/core.clj index 312993e..7c0cde5 100644 --- a/src/expand/core.clj +++ b/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]})] diff --git a/src/expand/scm.clj b/src/expand/scm.clj index 38d6064..34eba5e 100644 --- a/src/expand/scm.clj +++ b/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)