From 0b74b088fd760401a5f78ec46387fd088f9f4c20 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Sat, 19 Sep 2026 21:31:57 -0600 Subject: [PATCH] var record --- src/expand.clj | 80 ++++++++++++++++++++++++++++++++++---------------- 1 file changed, 54 insertions(+), 26 deletions(-) diff --git a/src/expand.clj b/src/expand.clj index 463ab8a..8c5b265 100644 --- a/src/expand.clj +++ b/src/expand.clj @@ -2,7 +2,8 @@ (:require [clojure.spec.alpha :as s] [clojure.core.match :refer [match]] [spec-dict.main :refer [dict]] - [clojure.set :as set])) + [clojure.set :as set] + [clojure.pprint :as pprint])) (defmacro todo ([] `(throw (ex-info "todo" {}))) @@ -98,40 +99,67 @@ (s/def ::body (s/+ any?)) +(defrecord Variable [symbol scopes]) + +(def ^:dynamic *print-variable-scopes* true) + +;; does not respect `*print-dup*` lol +(defmethod print-method Variable [this writer] + (binding [*out* writer] + (if *print-variable-scopes* + (pr [(:symbol this) (:scopes this)]) + (pr (:symbol this))))) + +(defmethod clojure.pprint/simple-dispatch expand.Variable [x] + (clojure.pprint/simple-dispatch + (if *print-variable-scopes* + [(:symbol x) (:scopes x)] + (:symbol x)))) + (s/def ::variable (s/conformer - #(match % - (x :guard symbol?) [x nil] - [x scopes] (let [r (s/conform (s/nilable ::scope-set) scopes)] - (if (or (not (symbol? x)) (s/invalid? r)) - ::s/invalid - [x scopes])) - :else ::s/invalid))) + (fn [x] + (match x + (_ :guard symbol?) (->Variable x nil) + (_ :guard #(instance? Variable %)) + (if (symbol? (:symbol x)) + (let [r (s/conform ::scope-set (:scopes x))] + (if (s/invalid? r) + ::s/invalid + (->Variable (:symbol x) (:scopes x)))) + ::s/invalid) + [sym scopes] (let [r (s/conform (s/nilable ::scope-set) scopes)] + (if (or (not (symbol? sym)) (s/invalid? r)) + ::s/invalid + (->Variable sym r))) + :else ::s/invalid)))) (defn variable? [x] (s/valid? ::variable x)) -(defn variable-symbol [v] - (if (symbol? v) - v - (first v))) - (defn normalise-variale [v] (let [r (s/conform ::variable v)] (when-not (s/invalid? r) r))) +(defn destructure-variable [v] + (let [r (s/conform ::variable v)] + (when-not (s/invalid? r) + [(:symbol r) (:scopes r)]))) + (defn variable-scopes [v] - (match v - [_ scopes] scopes - :else nil)) + (when-some [[_ scopes] (destructure-variable v)] + scopes)) + +(defn variable-symbol [v] + (when-some [[s _] (destructure-variable v)] + s)) (defn offer-scopes "variable v는 안 resolve되면 v와 scopes는 붙음." [v scopes] - (if-some [ss (variable-scopes v)] - [(variable-symbol v) ss] - [(variable-symbol v) scopes])) + (let [[sym existing-scopes] (destructure-variable v)] + (->Variable sym (or existing-scopes scopes)))) (s/def ::prim-lambda (s/cat :keyword ::variable @@ -206,7 +234,7 @@ (defn lookup [variable env symtable] (tap> [variable env symtable]) - (let [[sym scopes] (or (normalise-variale variable) + (let [[sym scopes] (or (destructure-variable variable) (throw (ex-info "not a var" {:var variable}))) ss (symtable-scopes symtable sym)] (let [xs (nearest [sym scopes] ss) @@ -357,8 +385,7 @@ [:var] symtable-ref)))] (concat (list 'let (for [[k v] bindings] - [(offer-scopes k scopes*) - v])) + (list (emit-variable (offer-scopes k scopes*)) v))) (for [e body] (expand e env* symtable-ref scopes*))))) @@ -433,9 +460,10 @@ ;; lists ([f & xs] :seq) (if (variable? f) - (match (lookup (offer-scopes f scopes) env @symtable-ref) - [:primitive prim] (expand-primitive - datum prim env symtable-ref scopes) - [:macro trans] (expand-macro trans datum env symtable-ref scopes)) + (do (tap> f) + (match (lookup (offer-scopes f scopes) env @symtable-ref) + [:primitive prim] (expand-primitive + datum prim env symtable-ref scopes) + [:macro trans] (expand-macro trans datum env symtable-ref scopes))) (cons (expand f env symtable-ref scopes) (map #(expand % env symtable-ref scopes) xs))))))