From 5359bc1c0a2369c16eab19b439129e5a32158ebf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Wed, 23 Sep 2026 11:18:12 -0600 Subject: [PATCH] --- src/expand.clj | 21 +++------------------ src/scm.clj | 44 ++++++++++++++++++++++++++++++-------------- 2 files changed, 33 insertions(+), 32 deletions(-) diff --git a/src/expand.clj b/src/expand.clj index 7ca9946..ef32b6c 100644 --- a/src/expand.clj +++ b/src/expand.clj @@ -14,7 +14,7 @@ `(~f ~@(mapcat #(list (keyword %) %) syms)))) -(s/def ::scope symbol?) +(s/def ::scope scm/scope?) (s/def ::binding #(match % @@ -74,10 +74,6 @@ :ss (s/coll-of ::context)) :ret (s/coll-of ::context :kind set?)) -(s/fdef new-scope - :args (s/cat :prefix (s/? string?)) - :ret ::scope) - ;;; prim specs @@ -107,16 +103,6 @@ -(defn new-scope - ([] (gensym "scope__")) - ([prefix] (gensym (str "scope__" prefix)))) - -#_ -(defn bind-lexical [sym denot store-atom] - (let [bind [:lexical sym (gensym)]] - (swap! store-atom #(assoc % [sym scopes] bind)) - {bind denot})) - #_ (s/fdef binding-form :args (s/cat :binds (s/coll-of (s/tuple symbol? ::denotation)) @@ -125,9 +111,8 @@ (defn binding-form [ident env store-atom binds f] (let [scopes (conj (scm/syntax-context ident) - (new-scope)) - ident* (scm/->Syntax (scm/syntax-e ident) - scopes) + (scm/new-scope)) + ident* (scm/->Syntax (scm/syntax-e ident) scopes) additions (for [[sym denot] binds] [sym [:lexical sym (gensym)] diff --git a/src/scm.clj b/src/scm.clj index 8c6aa9e..9073431 100644 --- a/src/scm.clj +++ b/src/scm.clj @@ -1,11 +1,13 @@ (ns scm - (:require [instaparse.core :as insta] - [clojure.java.io :as io] - [clojure.core.match :refer [match]] - [clojure.string :as str] - [clojure.spec.alpha :as s]) - (:import clojure.lang.ILookup) - (:refer-clojure :exclude [read])) + (:refer-clojure :exclude [read]) + (:require + [clojure.core.match :refer [match]] + [clojure.java.io :as io] + [clojure.pprint] + [instaparse.core :as insta] + [clojure.spec.alpha :as s]) + (:import + (clojure.lang ILookup))) ;;; syntax objects @@ -80,12 +82,6 @@ [x] (and (syntax? x) (-> x syntax-e symbol?))) -(defn constant? [x] - (or (and (syntax? x) (-> x syntax-e constant?)) - (number? x) - (string? x) - (boolean? x))) - ;;; improper list @@ -196,7 +192,27 @@ (read text (merge {:syntax? true} opts))) -;;; specs +;;; scopes + +(defn scope? [x] + (symbol? x)) + +(s/fdef new-scope + :args (s/cat :prefix (s/? string?)) + :ret scope?) + +(defn new-scope + ([] (gensym "scope__")) + ([prefix] (gensym (str "scope__" prefix)))) + + +;;; general scheme stuff + +(defn constant? [x] + (or (and (syntax? x) (-> x syntax-e constant?)) + (number? x) + (string? x) + (boolean? x))) (defn datum? [x] (or (number? x)