commit 7700b231c9219232d152aa3e024ea1d863f6f55b Author: Madeleine Sydney Ślaga Date: Wed Sep 16 06:12:12 2026 -0600 init diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..3550a30 --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +use flake diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..6b6b1fd --- /dev/null +++ b/.gitignore @@ -0,0 +1,16 @@ +result +result-* +.nrepl-port +.cpcache/ +.cache/ +.lsp/ +.clj-kondo +.cpcache +.lsp +.nrepl +.direnv/ +resources/vendor/* +node_modules +.cljs_node_repl +build/ +.shadow-cljs/ \ No newline at end of file diff --git a/deps.edn b/deps.edn new file mode 100644 index 0000000..9d16f1e --- /dev/null +++ b/deps.edn @@ -0,0 +1,13 @@ +{:deps {org.clojure/clojure {:mvn/version "1.12.0"} + babashka/fs {:mvn/version "0.5.24"} + org.clojure/core.match {:mvn/version "1.1.0"} + com.github.seancorfield/next.jdbc {:mvn/version "1.3.1070"} + org.xerial/sqlite-jdbc {:mvn/version "3.47.1.0"} + cheshire/cheshire {:mvn/version "6.1.0"} + org.clojure/data.csv {:mvn/version "1.1.1"} + com.rpl/specter {:mvn/version "1.1.6"} + io.github.msyds/spec-dict + {:git/sha "531d629b7f05f37232261cf9e8927a4b5915714f"}} + :paths ["src" "resources" "test"] + :test {:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}} + :main-opts ["-m" "kaocha.runner"]}} diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..c57aa64 --- /dev/null +++ b/flake.lock @@ -0,0 +1,137 @@ +{ + "nodes": { + "clj-nix": { + "inputs": { + "devshell": "devshell", + "nix-fetcher-data": "nix-fetcher-data", + "nixpkgs": "nixpkgs" + }, + "locked": { + "lastModified": 1767127926, + "narHash": "sha256-x7ySkkTG3dPi6jMhkPVten3pQCIzllRzcFqJ/tRQSFY=", + "owner": "jlesquembre", + "repo": "clj-nix", + "rev": "86c0312e9abcc46e3b4168c1b8ac1daebad5ddb6", + "type": "github" + }, + "original": { + "owner": "jlesquembre", + "repo": "clj-nix", + "type": "github" + } + }, + "devshell": { + "inputs": { + "nixpkgs": [ + "clj-nix", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1741473158, + "narHash": "sha256-kWNaq6wQUbUMlPgw8Y+9/9wP0F8SHkjy24/mN3UAppg=", + "owner": "numtide", + "repo": "devshell", + "rev": "7c9e793ebe66bcba8292989a68c0419b737a22a0", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "devshell", + "type": "github" + } + }, + "flake-parts": { + "inputs": { + "nixpkgs-lib": "nixpkgs-lib" + }, + "locked": { + "lastModified": 1719745305, + "narHash": "sha256-xwgjVUpqSviudEkpQnioeez1Uo2wzrsMaJKJClh+Bls=", + "owner": "hercules-ci", + "repo": "flake-parts", + "rev": "c3c5ecc05edc7dafba779c6c1a61cd08ac6583e9", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "flake-parts", + "type": "github" + } + }, + "nix-fetcher-data": { + "inputs": { + "flake-parts": "flake-parts", + "nixpkgs": [ + "clj-nix", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1728229178, + "narHash": "sha256-p5Fx880uBYstIsbaDYN7sECJT11oHxZQKtHgMAVblWA=", + "owner": "jlesquembre", + "repo": "nix-fetcher-data", + "rev": "f3a73c34d28db49ef90fd7872a142bfe93120e55", + "type": "github" + }, + "original": { + "owner": "jlesquembre", + "repo": "nix-fetcher-data", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1749285348, + "narHash": "sha256-frdhQvPbmDYaScPFiCnfdh3B/Vh81Uuoo0w5TkWmmjU=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "3e3afe5174c561dee0df6f2c2b2236990146329f", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-lib": { + "locked": { + "lastModified": 1717284937, + "narHash": "sha256-lIbdfCsf8LMFloheeE6N31+BMIeixqyQWbSr2vk79EQ=", + "type": "tarball", + "url": "https://github.com/NixOS/nixpkgs/archive/eb9ceca17df2ea50a250b6b27f7bf6ab0186f198.tar.gz" + }, + "original": { + "type": "tarball", + "url": "https://github.com/NixOS/nixpkgs/archive/eb9ceca17df2ea50a250b6b27f7bf6ab0186f198.tar.gz" + } + }, + "nixpkgs_2": { + "locked": { + "lastModified": 1774386573, + "narHash": "sha256-4hAV26quOxdC6iyG7kYaZcM3VOskcPUrdCQd/nx8obc=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "46db2e09e1d3f113a13c0d7b81e2f221c63b8ce9", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "root": { + "inputs": { + "clj-nix": "clj-nix", + "nixpkgs": "nixpkgs_2" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..ece8c2c --- /dev/null +++ b/flake.nix @@ -0,0 +1,44 @@ +{ + inputs = { + nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable"; + clj-nix.url = "github:jlesquembre/clj-nix"; + }; + + outputs = { self, nixpkgs, clj-nix, ... }@inputs: + let + supportedSystems = [ + "aarch64-darwin" + "aarch64-linux" + "x86_64-darwin" + "x86_64-linux" + ]; + + each-system = f: nixpkgs.lib.genAttrs supportedSystems (system: f rec { + pkgs = import nixpkgs { + inherit system; + overlays = [ + clj-nix.overlays.default + ]; + }; + inherit (pkgs) lib; + inherit system; + }); + in { + # Exposed as a REPL convenience. + _pkgs = each-system ({ pkgs, ... }: pkgs); + + devShells = each-system ({ pkgs, system, ... }: { + default = pkgs.mkShell { + packages = with pkgs; [ + zprint + clojure + babashka + sqlite-web + sqlite + mariadb + vega-lite + ]; + }; + }); + }; +} diff --git a/src/expand.clj b/src/expand.clj new file mode 100644 index 0000000..22d90c4 --- /dev/null +++ b/src/expand.clj @@ -0,0 +1,129 @@ +(ns expand + (:require [clojure.spec.alpha :as s] + [clojure.core.match :refer [match]] + [spec-dict.main :refer [dict]] + [clojure.set :as set])) + +(def primitives + #{'let 'let-syntax 'letrec 'lambda 'syntax-rules 'if}) + +(s/def ::binding + #(match % + [:lexical sym uniq] (and (symbol? sym) (symbol? uniq)) + [:global sym] (symbol? sym))) + +(s/def ::pattern any?) + +(s/def ::template any?) + +(s/def ::rule + (s/tuple ::pattern ::template)) + +(s/def ::transformer + (dict {:rules (s/coll-of ::rule :kind sequential?)})) + +(s/def ::denotation + #(match % + [:var] true + [:primitive p] (primitives p) + [:macro trans] (s/valid? ::transformer trans))) + +(s/def ::environment + (s/map-of ::binding ::denotation)) + +(s/def ::scope symbol?) + +(s/def ::symtable + (s/map-of symbol? + (s/map-of (s/coll-of ::scope :kind set?) + ::binding))) + + + +(defn symtable-for-env [env] + (into {} + (for [[[_ x] _] env] + [x {#{} [:global x]}]))) + +(def scheme-base-env + (into {[:global 'λ] [:primitive 'lambda]} + (for [p primitives] + [[:global p] [:primitive p]]))) + +(defn nearest [[sym scopes] ss] + (when-some [xs (->> ss + (filter #(set/subset? % scopes)) + (group-by count) + seq)] + (second (apply max-key first xs)))) + +(defn lookup [[sym scopes] env symtable] + (let [ss (get symtable sym)] + (let [xs (nearest [sym scopes] (keys ss)) + r (compare (count xs) 1)] + (cond (neg? r) (throw (ex-info "undefined sym" {:sym sym})) + (zero? r) + (or (get env (or (get ss (first xs)) + (throw (ex-info "unreachable" {})))) + (throw (ex-info "unreachable" {}))) + (pos? r) (throw (ex-info "ambiguous sym" {:sym sym})))))) + +(comment + (let [st (atom (symtable-for-env scheme-base-env))] + {:e (expand '(lambda (x y) x) scheme-base-env st #{}) + :st @st})) + +(defmulti expand-primitive + (fn [_datum prim-name _env _symtable-ref _scopes] + prim-name)) + +(defn new-scope + ([] (gensym)) + ([prefix] (gensym prefix))) + +(defn bind-lexical [[sym scopes] denot symtable-ref] + (let [bind [:lexical sym (gensym)]] + (swap! symtable-ref #(assoc-in % [sym scopes] bind)) + {bind denot})) + +(defmethod expand-primitive 'lambda + [datum _ env symtable-ref scopes] + (let [[_ formals & body] datum + scopes* (conj scopes (new-scope)) + env* (apply merge env + (for [x formals] + (bind-lexical [x scopes*] + [:var] symtable-ref)))] + (concat (list 'lambda formals) + (for [e body] + (expand e env* symtable-ref scopes*))))) + +(comment (assert (lookup ['lambda #{}] + scheme-base-env + (symtable-for-env scheme-base-env)))) + +(comment + (nearest ['x #{0 1 2}] + #{#{0} + #{0 1} + #{0 3}})) + +(comment + (expand 'x) + (expand '(lambda (x) x))) + +(defn expand + ([datum] + (expand + datum scheme-base-env (atom (symtable-for-env scheme-base-env)) #{})) + ([datum env symtable-ref scopes] + (match datum + (x :guard (some-fn boolean? number?)) x + (x :guard symbol?) + (do (lookup [x scopes] env @symtable-ref) + x) + ([(f :guard symbol?) & xs] :seq) + (match (lookup [f scopes] env @symtable-ref) + [:primitive prim] (expand-primitive + datum prim env symtable-ref scopes))))) + diff --git a/test/expand_test.clj b/test/expand_test.clj new file mode 100644 index 0000000..04db231 --- /dev/null +++ b/test/expand_test.clj @@ -0,0 +1,17 @@ +(ns expand-test + (:require [expand :as sut] + [clojure.test :as t] + [clojure.spec.alpha :as s])) + +(t/deftest scheme-base-env-test + (t/is (s/valid? ::sut/environment sut/scheme-base-env))) + +(t/deftest symtable-for-env-test + (t/is (s/valid? ::sut/symtable (sut/symtable-for-env sut/scheme-base-env)))) + +(t/deftest expand-test + (t/testing "unbound symbol" + (t/is (thrown? Exception (sut/expand 'x)))) + (t/testing "identity fn" + (t/is (= '(lambda (x) x) + (sut/expand '(λ (x) x))))))