src/expand.clj

@@ -7,6 +7,13 @@
             [spec-dict.main :refer [dict]]
             [scm]))
 
+(defmacro inherit [& syms]
+  (let [f (if (<= 8 (count syms))
+            `hash-map
+            `array-map)]
+    `(~f ~@(mapcat #(list (keyword %) %)
+                   syms))))
+
 (s/def ::scope symbol?)
 
 (s/def ::binding
@@ -143,8 +150,7 @@
                   store-atom
                   {:x [:var]}
                   (fn [ident* env*]
-                    (tap> {:ident* ident*
-                           :env* env*})
+                    (tap> (inherit ident* env*))
                     (list (scm/datum->syntax 'x ident*))))))
 
 
@@ -182,16 +188,11 @@
   (fn [_datum prim-name _env _store-atom]
     prim-name))
 
-#_
 (defmethod expand-primitive 'lambda
   [stx _ env symtable-ref]
-  (let [{:keys [formals body]} (->> stx
-                                    scm/syntax-e
-                                    (s/conform ::prim-lambda))]
-    (concat (list 'lambda
-                  (throw (Exception. "todo2")))
-            (for [e body]
-              (expand e env* symtable-ref)))))
+  (let [{:keys [formals body]} (s/conform ::prim-lambda stx)]
+    (tap> (inherit formals body))
+    (throw (Exception. "todo2"))))
 
 (defn expand [stx env store-atom]
   (match (scm/syntax-e stx)
@@ -210,3 +211,12 @@
               (map #(expand % env store-atom) xs)))))
 
 (defn expand-library [lib])
+
+(comment
+  (let [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 #{}])
+                      #{}]
+            env store-atom)))