expand test

resources/scm/scheme/base.scm

@@ -1,3 +1,9 @@
 (define-library (scheme base)
-  (export lambda)
-  (import (scheme primitives)))
+  (export lambda begin define define-syntax
+          syntax-rules if when)
+  (import (primitives+builtins))
+  (begin
+    (define-syntax when
+      (syntax-rules ()
+        ((_ test body)
+         (if test (begin body)))))))

src/expand.clj

@@ -215,7 +215,7 @@
          (for [x (cons f xs)]
            (expand (scm/rescope x stx) env store-atom))))))
 
-(defn import-primitives+builtins [scopeholder env-atom store-atom]
+(defn- import-primitives+builtins [scopeholder env-atom store-atom]
   (let [scopes (scm/syntax-context scopeholder)
         additions (concat (for [p primitives]
                             [p
@@ -252,24 +252,33 @@
                 (cons :begin)
                 vec)))))))
 
+(defn library->datum [lib]
+  (cons 'define-library
+        (cons (:library/name lib)
+              (for [d (:library/declarations lib)]
+                (match d
+                  [:begin & xs] (cons 'begin xs)
+                  [:import & xs] (cons 'import xs)
+                  [:export & xs] (cons 'export xs))))))
+
+(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)
+                :else decl)))))
+
 (comment
   (-> "t.scm"
       slurp
       (scm/read-syntax :library? true)
       expand-library
-      ;; :library/declarations
-      ;; second
-      ;; second
-      ;; scm/syntax->datum
-      (update :library/declarations
-              (fn [decls]
-                (for [decl decls]
-                  (match decl
-                    [:begin & xs] (->> xs
-                                       (map scm/syntax->datum)
-                                       (cons :begin)
-                                       vec)
-                    :else decl)))))
+      library-syntax->datum
+      library->datum)
   (let [scopeholder (scm/new-scopeholder)
         env {[:global 'lambda] [:primitive 'lambda]}
         store-atom (atom {['lambda #{}] [:global 'lambda]})]

test/expand_test.clj

@@ -34,7 +34,21 @@
                        '{[x #{a b}] [:lexical x A]
                          [x #{a}] [:lexical x B]}))))
 
-(t/deftest expand-test)
+(defn- expand [stx]
+  (-> #:library {:name '(user)
+                 :declarations [[:import '(primitives+builtins)]
+                                [:begin stx]]}
+      sut/expand-library
+      :library/declarations
+      second
+      second
+      scm/syntax->datum))
+
+(t/deftest expand-test
+  (t/is (= '(lambda (x) x)
+           (expand #scm/stx (#scm/stx lambda
+                             #scm/stx (#scm/stx x)
+                             #scm/stx x)))))
 
 
 ;;; specs