This commit is contained in:
1 parent
daf910757a
commit
7282e44c5a
2 files changed
+45
-24
No files matched your search
+7
-5
@@ -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))
|
||||
+38
-19
@@ -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]
|
||||
|
||||
Reference in new issue
Block a user