expand2

src/scm.clj

@@ -0,0 +1,63 @@
+(ns scm
+  (:require [instaparse.core :as insta]
+            [clojure.java.io :as io]
+            [clojure.core.match :refer [match]])
+  (:refer-clojure :exclude [read]))
+
+
+;;; syntax objects
+
+(defprotocol IStx
+  (stx-datum [this])
+  (stx-context [this]))
+
+(defn syntax? [x]
+  (instance? IStx x))
+
+(deftype Stx [datum ctx]
+  Object
+  (equals [x y]
+    (or (identical? x y)
+        (and (instance? IStx y)
+             (.equals datum (stx-datum y))
+             (.equals ctx (stx-context y)))))
+  IStx
+  (stx-datum [this] datum)
+  (stx-context [this] ctx))
+
+(def ^:dynamic *print-ctx?* true)
+
+;; does not respect `*print-dup*` lol
+(defmethod print-method Stx [this writer]
+  (binding [*out* writer]
+    (pr (tagged-literal
+         'scm/stx
+         (if *print-ctx?*
+           [(stx-datum this) (stx-context this)]
+           (stx-datum this))))))
+
+(defmethod clojure.pprint/simple-dispatch Stx [x]
+  (clojure.pprint/simple-dispatch
+   (tagged-literal
+    'scm/stx
+    (if *print-ctx?*
+      [(stx-datum x) (stx-context x)]
+      (stx-datum x)))))
+
+(defn stx-reader [[datum ctx]]
+  (->Stx datum ctx))
+
+
+;;; r⁷rs reader
+
+(insta/defparser r7rs-parser (io/resource "r7rs.ebnf"))
+
+(defn read [s & {:as opts}]
+  (->> (insta/parse r7rs-parser s opts)
+       (insta/transform
+        {:boolean (fn [x]
+                    [:boolean
+                     (match x
+                       (:or "#t" "#true") true
+                       (:or "#f" "#false") false)])})))
+