src/expand.clj

@@ -109,23 +109,20 @@
                :store-atom #(instance? clojure.lang.Atom %)
                :datum ::datum))
 
-(defn binding-form [ident env store-atom binds f]
-  (let [scopes (conj (scm/syntax-context ident)
+(defn binding-form [scopeholder env store-atom binds f]
+  (let [scopes (conj (scm/syntax-context scopeholder)
                      (scm/new-scope))
-        ident* (scm/->Syntax (scm/syntax-e ident) scopes)
+        scopeholder* (scm/->Syntax (scm/syntax-e scopeholder) scopes)
         additions (for [[sym denot] binds]
                     [sym
                      [:lexical sym (gensym)]
                      denot])
         env* (into env (for [[_sym bind denot] additions]
                          [bind denot]))]
-    (swap! store-atom #(into % (for [[sym bind _denot] binds]
+    (swap! store-atom #(into % (for [[sym bind _denot] additions]
                                  [[sym scopes] bind])))
-    (scm/datum->syntax (cons
-                        ;; 여기서 ident를 써야 할지 ident*를 써야 할지 몰라…
-                        (scm/syntax-e ident)
-                        (f ident* env*))
-                       ident)))
+    (scm/datum->syntax (f scopeholder* env*)
+                       scopeholder)))
 
 (comment
   (let [env {}
@@ -155,6 +152,7 @@
     (set (some->> xs (apply max-key first) second))))
 
 (defn lookup [ident env store]
+  (tap> (inherit ident env store))
   (let [sym (scm/syntax-e ident)
         scopes (scm/syntax-context ident)
         ss (store-scopes store sym)]
@@ -174,17 +172,27 @@
     prim-name))
 
 (defmethod expand-primitive 'lambda
-  [stx _ env symtable-ref]
+  [stx _ env store-atom]
   (let [{:keys [formals body]} (s/conform ::prim-lambda stx)]
-    (tap> (inherit formals body))
-    (throw (Exception. "todo2"))))
+    (assert (list? formals))
+    (binding-form
+     stx env store-atom
+     (doall (for [x formals]
+              [(scm/syntax-e x) [:var]]))
+     (fn [scopeholder env*]
+       (concat (list 'lambda
+                     (for [x formals]
+                       (scm/rescope x scopeholder)))
+               (for [x body]
+                 (expand (scm/rescope x scopeholder)
+                         env* store-atom)))))))
 
 (defn expand [stx env store-atom]
   (match (scm/syntax-e stx)
-    (x :guard scm/constant?) x
-    (x :guard scm/identifier?)
-    (do (lookup x env @store-atom) ; throw if unbound
-        x)
+    (_ :guard scm/constant?) stx
+    (_ :guard symbol?)
+    (do (lookup stx env @store-atom) ; throw if unbound
+        stx)
 
     ([f & xs] :seq)
     (or (when (scm/identifier? f)
@@ -198,10 +206,10 @@
 (defn expand-library [lib])
 
 (comment
-  (let [env {[:global 'lambda] [:primitive 'lambda]}
+  (let [scopeholder (scm/new-scopeholder)
+        env {[:global 'lambda] [:primitive 'lambda]}
         store-atom (atom {['lambda #{}] [:global 'lambda]})]
-    (expand #scm/stx [(#scm/stx [lambda #{}]
-                       #scm/stx [(#scm/stx [x #{}]) #{}]
-                       #scm/stx [x #{}])
-                      #{}]
+    (expand (-> (slurp "t.scm")
+                (scm/read-syntax #_#_:library? true)
+                (scm/rescope scopeholder))
             env store-atom)))

src/scm.clj

@@ -73,10 +73,15 @@
 
 (defn datum->syntax
   ([datum]
+   (assert (not (syntax? datum)) "너는 이렇고 싶은가…")
    (->Syntax datum nil))
   ([datum ctxt-donor]
+   (assert (not (syntax? datum)) "너는 이렇고 싶은가…")
    (->Syntax datum (syntax-context ctxt-donor))))
 
+(defn rescope [stx ctxt-donor]
+  (->Syntax (syntax-e stx) (syntax-context ctxt-donor)))
+
 (defn identifier?
   "x가 신택스이고 x의 내용이 심볼이면 true를 생선함."
   [x]
@@ -207,6 +212,14 @@
   ([] (gensym "scope__"))
   ([prefix] (gensym (str "scope__" prefix))))
 
+(defn new-scopeholder
+  "정의뒤지 않은 데이텀을 생성한다. 그 데이텀은 새 스코프를 가진다."
+  ([donor]
+   (->Syntax ::undefined (conj (syntax-context donor)
+                               (new-scope "holder_"))))
+  ([]
+   (->Syntax ::undefined #{(new-scope "holder_")})))
+
 
 ;;; general scheme stuff