import prims

src/expand.clj

@@ -5,7 +5,8 @@
             [clojure.spec.alpha :as s]
             [clojure.walk]
             [spec-dict.main :refer [dict]]
-            [scm]))
+            [scm]
+            [clojure.java.io :as io]))
 
 (defmacro inherit [& syms]
   (let [f (if (<= 8 (count syms))
@@ -34,13 +35,13 @@
 
 (def primitives
   "A set of symbols to be defined as primitive syntax exposed by
-  (scheme base)."
+  (primitives+builtins)."
   '#{let let-syntax letrec lambda syntax-rules if define
      define-syntax begin})
 
 (def builtins
-  "A set of symbols to be defined as variables exposed by (scheme
-  base)."
+  "A set of symbols to be defined as variables exposed by
+  (primitives+builtins)."
   '#{+ * / - car cdr write display newline cons list})
 
 (s/def ::denotation
@@ -152,18 +153,18 @@
     (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)]
-    (let [xs (nearest scopes ss)
-          r (compare (count xs) 1)]
-      (cond (neg? r) (throw (ex-info "undefined sym" {:sym sym}))
-            (zero? r)
-            (or (get env (or (get store [sym (first xs)])
-                             (throw (ex-info "unreachable" {}))))
-                (throw (ex-info "unreachable" {})))
-            (pos? r) (throw (ex-info "ambiguous sym" {:sym sym}))))))
+        ss (store-scopes store sym)
+        xs (nearest scopes ss)
+        r (compare (count xs) 1)]
+    (tap> (inherit ident env store))
+    (cond (neg? r) (throw (ex-info "undefined sym" {:sym sym}))
+          (zero? r)
+          (or (get env (or (get store [sym (first xs)])
+                           (throw (ex-info "unreachable" {}))))
+              (throw (ex-info "unreachable" {})))
+          (pos? r) (throw (ex-info "ambiguous sym" {:sym sym})))))
 
 (declare expand)
 
@@ -187,25 +188,75 @@
                  (expand (scm/rescope x scopeholder)
                          env* store-atom)))))))
 
-(defn expand [stx env store-atom]
-  (match (scm/syntax-e stx)
-    (_ :guard scm/constant?) stx
-    (_ :guard symbol?)
-    (do (lookup stx env @store-atom) ; throw if unbound
-        stx)
+(defn expand
+  ([stx]
+   (let [scopeholder (scm/new-scopeholder)
+         env {}
+         store-atom (atom {})]
+     (expand (scm/rescope stx scopeholder)
+             env store-atom)))
+  ([stx env store-atom]
+   (tap> (inherit stx))
+   (match (scm/syntax-e stx)
+     (_ :guard scm/constant?) stx
+     (_ :guard symbol?)
+     (do (lookup stx env @store-atom) ; throw if unbound
+         stx)
 
-    ([f & xs] :seq)
-    (or (when (scm/identifier? f)
-          (match (lookup f env @store-atom)
-            [:primitive prim] (expand-primitive stx prim env store-atom)
-            #_#_[:macro trans] (expand-macro trans datum env symtable-ref scopes)
-            [:var] nil))
-        (cons (expand f env store-atom)
-              (map #(expand % env store-atom) xs)))))
+     ([f & xs] :seq)
+     (or (when (scm/identifier? f)
+           (match (-> f
+                      (scm/rescope stx)
+                      (lookup env @store-atom))
+             [:primitive prim] (expand-primitive stx prim env store-atom)
+             #_#_[:macro trans]
+             (expand-macro trans datum env symtable-ref scopes)
+             [:var] nil))
+         (for [x (cons f xs)]
+           (expand (scm/rescope x stx) env store-atom))))))
 
-(defn expand-library [lib])
+(defn import-primitives+builtins [scopeholder env-atom store-atom]
+  (let [scopes (scm/syntax-context scopeholder)
+        additions (concat (for [p primitives]
+                            [p
+                             [:global p]
+                             [:primitive p]])
+                          (for [b builtins]
+                            [b
+                             [:global b]
+                             [:var]]))]
+    (swap! env-atom #(into % (for [[_sym bind denot] additions]
+                               [bind denot])))
+    (swap! store-atom #(into % (for [[sym bind _denot] additions]
+                                 [[sym scopes] bind])))))
+
+(defn expand-library [lib]
+  (let [scopeholder (scm/new-scopeholder)
+        env-atom (atom {})
+        store-atom (atom {})]
+    (update
+     lib
+     :library/declarations
+     (fn [decls]
+       (for [decl decls]
+         (match decl
+           [:import import-name]
+           (do (if (= import-name '(primitives+builtins))
+                 (import-primitives+builtins scopeholder env-atom store-atom)
+                 (throw (Exception. "todo")))
+               decl)
+           [:begin & xs]
+           (->> (for [x xs]
+                  (expand (scm/rescope x scopeholder)
+                          @env-atom store-atom))
+                (cons :begin)
+                vec)))))))
 
 (comment
+  (-> "t.scm"
+      slurp
+      (scm/read-syntax :library? true)
+      expand-library)
   (let [scopeholder (scm/new-scopeholder)
         env {[:global 'lambda] [:primitive 'lambda]}
         store-atom (atom {['lambda #{}] [:global 'lambda]})]