diff --git a/src/expand.clj b/src/expand.clj index 37cc8d4..8433847 100644 --- a/src/expand.clj +++ b/src/expand.clj @@ -51,10 +51,10 @@ (s/def ::identifier (s/and ::syntax - #(symbol? (scm/stx-datum %)))) + #(symbol? (scm/syntax-e %)))) (s/fdef expand - :args (s/cat :syntax ::syntax + :args (s/cat :stx ::syntax :env ::environment :store ::store) :ret ::syntax) @@ -81,8 +81,8 @@ (second (apply max-key first xs)))) (defn lookup [ident env store] - (let [sym (scm/stx-datum ident) - scopes (scm/stx-context ident) + (let [sym (scm/syntax-e ident) + scopes (scm/syntax-context ident) ss (store-scopes store sym)] (let [xs (nearest scopes ss) r (compare (count xs) 1)] @@ -93,4 +93,6 @@ (throw (ex-info "unreachable" {}))) (pos? r) (throw (ex-info "ambiguous sym" {:sym sym})))))) -(defn expand [stx env store-atom]) +(defn expand [stx env store-atom] + (match (scm/syntax-e stx) + (x :guard scm/constant?) x)) diff --git a/src/scm.clj b/src/scm.clj index 2bf1249..2071e00 100644 --- a/src/scm.clj +++ b/src/scm.clj @@ -11,22 +11,28 @@ ;;; syntax objects (defprotocol ISyntax - (stx-datum [this]) - (stx-context [this])) + (syntax-e [this]) + (syntax-context [this])) (defn syntax? [x] - (instance? ISyntax x)) + (satisfies? ISyntax x)) (deftype Syntax [datum ctx] Object (equals [x y] (or (identical? x y) - (and (instance? ISyntax y) - (.equals datum (stx-datum y)) - (.equals ctx (stx-context y))))) + (and (satisfies? ISyntax y) + (.equals datum (syntax-e y)) + (.equals ctx (syntax-context y))))) ISyntax - (stx-datum [this] datum) - (stx-context [this] ctx)) + (syntax-e [this] datum) + (syntax-context [this] ctx)) + +(defn unresolved? [stx] + (= (syntax-context stx) ::unresolved)) + +(defn resolved? [stx] + (not (unresolved? stx))) (def ^:dynamic *print-ctx?* true) @@ -35,26 +41,39 @@ (binding [*out* writer] (pr (tagged-literal 'scm/stx - (if *print-ctx?* - [(stx-datum this) (stx-context this)] - (stx-datum this)))))) + (if (and *print-ctx?* (resolved? this)) + [(syntax-e this) (syntax-context this)] + (syntax-e this)))))) (defmethod clojure.pprint/simple-dispatch Syntax [x] (clojure.pprint/simple-dispatch (tagged-literal 'scm/stx - (if *print-ctx?* - [(stx-datum x) (stx-context x)] - (stx-datum x))))) + (if (and *print-ctx?* (resolved? x)) + [(syntax-e x) (syntax-context x)] + (syntax-e x))))) -(defn stx-reader [[datum ctx]] - (->Syntax datum ctx)) +(defn stx-reader [x] + (if-let [[datum ctx] (and (vector? x) x)] + (->Syntax datum ctx) + (->Syntax x ::unresolved))) (defn datum->syntax ([datum] - (->Syntax datum nil)) + (->Syntax datum ::unresolved)) ([datum ctxt-donor] - (->Syntax datum (stx-context ctxt-donor)))) + (->Syntax datum (syntax-context ctxt-donor)))) + +(defn identifier? + "x가 신택스이고 x의 내용이 심볼이면 true를 생선함." + [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 @@ -120,7 +139,7 @@ ;; 과정할 수 있었더다. 작업 한 개만으로 syntax object들 다 ;; 만들 수 있어서 이럼은 더 좋다. :datum (fn [x] - (->Syntax x ::no-scopes)) + (datum->syntax x)) :number identity :symbol symbol :string (fn [& els]