src/expand.clj

@@ -49,9 +49,7 @@
 
 (s/def ::syntax scm/syntax?)
 
-(s/def ::identifier
-  (s/and ::syntax
-         #(symbol? (scm/syntax-e %))))
+(s/def ::identifier scm/identifier?)
 
 (s/fdef expand
   :args (s/cat :stx ::syntax
@@ -64,6 +62,11 @@
                :env ::environment
                :store ::store))
 
+(s/fdef nearest
+  :args (s/cat :ctx ::context
+               :ss (s/coll-of ::context))
+  :ret (s/coll-of ::context :kind set?))
+
 
 
 (defn- store-scopes
@@ -74,11 +77,11 @@
               scopes)))
 
 (defn nearest [ctx ss]
-  (when-some [xs (->> ss
-                      (filter #(set/subset? % ctx))
-                      (group-by count)
-                      seq)]
-    (second (apply max-key first xs))))
+  (let [xs (->> ss
+                (filter #(set/subset? % ctx))
+                (group-by count)
+                seq)]
+    (set (some->> xs (apply max-key first) second))))
 
 (defn lookup [ident env store]
   (let [sym (scm/syntax-e ident)

src/scm.clj

@@ -121,10 +121,10 @@
 (defn read
   "`read` 작업의 결과로 생성된 콘텍스트 필드는 초기에 비어 있다. 이후
   `expand/expand` 작업을 통해 콘택스트 필드를 패울 수 있다."
-  [& {:keys [syntax? instaparse]
-      :or {syntax? false
-           instaparse {}}}]
-  (let [r (insta/parse r7rs-parser (slurp *in*)
+  [text & {:keys [syntax? instaparse]
+           :or {syntax? false
+                instaparse {}}}]
+  (let [r (insta/parse r7rs-parser text
                        :start :datum-start
                        instaparse)]
     (if (insta/failure? r)
@@ -139,7 +139,9 @@
         ;; 과정할 수 있었더다. 작업 한 개만으로 syntax object들 다
         ;; 만들 수 있어서 이럼은 더 좋다.
         :datum (fn [x]
-                 (datum->syntax x))
+                 (if syntax?
+                   (datum->syntax x)
+                   x))
         :number identity
         :symbol symbol
         :string (fn [& els]
@@ -159,5 +161,5 @@
                   (sign (parse-long digits)))}
        r))))
 
-(defn read-syntax [& {:as opts}]
-  (read (merge {:syntax? true} opts)))
+(defn read-syntax [text & {:as opts}]
+  (read text (merge {:syntax? true} opts)))