Browse files

First cut at extensible reader. registration only ATM

  • Loading branch information...
1 parent 8444ce1 commit 6bd99763b8f4fe2d0f21a7126cbcaa17c1a0c1fe @fogus fogus committed May 12, 2012
Showing with 48 additions and 26 deletions.
  1. +2 −2 src/cljs/cljs/core.cljs
  2. +33 −9 src/cljs/cljs/reader.cljs
  3. +13 −15 test/cljs/cljs/reader_test.cljs
View
4 src/cljs/cljs/core.cljs
@@ -5782,8 +5782,8 @@ reduces them without incurring seq initialization"
IndexedSeq
(-pr-seq [coll opts] (pr-sequential pr-seq "(" " " ")" opts coll))
- PersistentQueueSeq
- (-pr-seq [coll opts] (pr-sequential pr-seq "(" " " ")" opts coll))
+ PersistentQueue
+ (-pr-seq [coll opts] (pr-sequential pr-seq "#queue [" " " "]" opts (seq coll)))
PersistentTreeMapSeq
(-pr-seq [coll opts] (pr-sequential pr-seq "(" " " ")" opts coll))
View
42 src/cljs/cljs/reader.cljs
@@ -214,15 +214,7 @@ nil if the end of stream has been reached")
[rdr ch]
(reader-error rdr "Reader for " ch " not implemented yet"))
-(defn maybe-read-tagged-type
- [rdr initch]
- (let [sym (read-symbol rdr initch)
- nxt (read-char rdr)
- vals ((macros nxt) rdr nxt)]
- (cond
- (vector? vals) vals
- (map? vals) vals
- :else sym)))
+(declare maybe-read-tagged-type)
(defn read-dispatch
[rdr _]
@@ -405,3 +397,35 @@ nil if the end of stream has been reached")
(read r true nil false)))
+;; read table
+
+(defn ^:private read-date
+ [str]
+ (js/Date. (Date/parse str)))
+
+
+(defn ^:private read-queue
+ [elems]
+ (if (vector? elems)
+ (into cljs.core.PersistentQueue/EMPTY elems)
+ (reader-error nil "Queue literal expects a vector for its elements.")))
+
+(def *tag-table* (atom {"inst" identity
+ "uuid" identity
+ "queue" read-queue}))
+
+(defn maybe-read-tagged-type
+ [rdr initch]
+ (let [tag (read-symbol rdr initch)
+ form (read rdr true nil false)
+ pfn (get @*tag-table* (name tag))]
+ (if pfn
+ (pfn form)
+ (reader-error rdr "Could not find tag parser for " (name tag) (pr-str @*tag-table*)))))
+
+(defn register-tag-parser!
+ [tag f]
+ (let [tag (name tag)
+ old-parser (get @*tag-table* tag)]
+ (swap! *tag-table* assoc tag f)
+ old-parser))
View
28 test/cljs/cljs/reader_test.cljs
@@ -30,23 +30,21 @@
(assert (= false (reader/read-string "false")))
(assert (= "string" (reader/read-string "\"string\"")))
(assert (= "escape chars \t \r \n \\ \" \b \f" (reader/read-string "\"escape chars \\t \\r \\n \\\\ \\\" \\b \\f\"")))
+
+ ;; queue literals
+ (assert (= cljs.core.PersistentQueue/EMPTY
+ (reader/read-string "#queue []")))
+
+ (assert (= (-> cljs.core.PersistentQueue/EMPTY (conj 1))
+ (reader/read-string "#queue [1]")))
+
+ (assert (= (into cljs.core.PersistentQueue/EMPTY [1 2])
+ (reader/read-string "#queue [1 2]")))
- (println (pr-str (reader/read-string "#cljs.reader_test.R[1 2]")))
- (println (pr-str (reader/read-string "#cljs.reader_test.R{:a 1 :b 2}")))
- (println (pr-str (new (.-R cljs.reader_test) 1 2)))
-
- (let [n 'R
- k cljs.reader_test.R]
- (println (pr-str (js* "(new ~{k}(1,2))"))))
+ ;; new parsers
- (println (pr-str (new (.-R (.-reader_test js/cljs)) 1 2)))
+ (reader/register-tag-parser! "foo" identity)
- (let [a "cljs"
- b "reader_test"
- c "R"
- #_d #_"window['~{a}']"]
- (println (js* "Function('return this')()")))
-
- (assert (= (R. 1 2) (reader/read-string "#cljs.reader_test.R[1 2]")))
+ (assert (= [1 2] (reader/read-string "#foo [1 2]")))
:ok)

0 comments on commit 6bd9976

Please sign in to comment.