src/expand.clj

@@ -14,8 +14,11 @@
                     {}))))
 
 (def primitives
-  #{'let 'let-syntax 'letrec 'lambda 'syntax-rules 'if 'define
-    'define-syntax 'begin})
+  '#{let let-syntax letrec lambda syntax-rules if define
+     define-syntax begin})
+
+(def builtins
+  '#{car cdr write display newline cons list})
 
 (s/def ::binding
   #(match %
@@ -209,6 +212,10 @@
                      :consequent ::datum
                      :alternative (s/? ::datum))))
 
+(s/def ::prim-begin
+  (s/and seq? (s/cat :keyword ::variable
+                     :body (s/+ ::datum))))
+
 
 
 (defn symtable-for-env [env]
@@ -233,10 +240,12 @@
     [:global 'when] [:macro
                      (meta-syntax-rules ()
                        ((_ test body)
-                        (if test body)))]}
+                        (if test body))
+                       ((_ test body ...)
+                        (if test (begin body))))]}
    (into {} (for [p primitives]
               [[:global p] [:primitive p]]))
-   (into {} (for [b '(+ - * / car cdr cons)]
+   (into {} (for [b builtins]
               [[:global b] [:var]]))))
 
 (defn nearest [[sym scopes] ss]
@@ -456,6 +465,11 @@
                   (ex consequent))
             (some-> alternative ex))))
 
+(defmethod expand-primitive 'begin
+  [datum _ env symtable-ref scopes]
+  (let [{:keys [body]} (s/conform ::prim-begin datum)]
+    (cons 'begin (map #(expand % env symtable-ref scopes) body))))
+
 (comment
   (let [env scheme-base-env
         [_ trans] (get scheme-base-env [:global 'and])
@@ -496,8 +510,8 @@
 
      ;; lists
      ([f & xs] :seq)
-     (or (when-some [v (and (variable? f)
-                            (offer-scopes f scopes))]
+     (or (when-let [v (and (variable? f)
+                           (offer-scopes f scopes))]
            (match (lookup v env @symtable-ref)
              [:primitive prim] (expand-primitive
                                 datum prim env symtable-ref scopes)