├── doc └── intro.md ├── .gitignore ├── CONTRIBUTING.md ├── deps.edn ├── src ├── main │ ├── dotnet │ │ └── packager │ │ │ └── clojure.tools.reader.csproj │ └── clojure │ │ └── clojure │ │ └── tools │ │ ├── reader │ │ ├── impl │ │ │ ├── inspect.clj │ │ │ ├── utils.clj │ │ │ ├── errors.clj │ │ │ └── commons.clj │ │ ├── default_data_readers.clj │ │ ├── reader_types.clj │ │ └── edn.clj │ │ └── reader.clj └── test │ └── clojure │ └── clojure │ └── tools │ ├── reader_edn_test.clj │ ├── common_tests.clj │ ├── metadata_test.clj │ └── reader_test.clj ├── README.md ├── project.clj ├── .gitattributes ├── LICENSE.txt └── epl.html /doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to clr.tools.reader 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/great-documentation/what-to-write/) 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | /lib/ 3 | /classes/ 4 | /targets/ 5 | /target 6 | /classes 7 | /checkouts 8 | *.jar 9 | *.class 10 | *.dll 11 | *.pdb 12 | *.exe 13 | .lein-deps-sum 14 | .lein-failures 15 | .lein-plugins 16 | .vs 17 | .cpcache 18 | 19 | #Visual Studio artifacts 20 | bin 21 | obj 22 | *.user 23 | *.suo 24 | *.nupkg -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | This is a [Clojure contrib] project. 2 | 3 | Under the Clojure contrib [guidelines], this project cannot accept 4 | pull requests. All patches must be submitted via [JIRA]. 5 | 6 | See [Contributing] on the Clojure website for 7 | more information on how to contribute. 8 | 9 | [Clojure contrib]: https://clojure.org/community/contrib_libs 10 | [Contributing]: https://clojure.org/community/contributing 11 | [JIRA]: https://clojure.atlassian.net/browse/TNS 12 | [guidelines]: https://clojure.org/community/contrib_howto -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {} ;;; TODO: Figure out how we express ClojureCLR version dependency: org.clojure/clojure {:mvn/version "1.10.3"} 2 | :paths ["src/main/clojure"] 3 | 4 | :aliases 5 | {:test 6 | {:extra-paths ["src/test/clojure"] 7 | :extra-deps {io.github.dmiller/test-runner {:git/sha "c055ea13d19c6a9b9632aa2370fcc2215c8043c3"}} 8 | ;; :main-opts {"-m" "cognitect.test-runner" "-d" "src/test/clojure"} 9 | :exec-fn cognitect.test-runner.api/test 10 | :exec-args {:dirs ["src/test/clojure"]}}} 11 | } -------------------------------------------------------------------------------- /src/main/dotnet/packager/clojure.tools.reader.csproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | netstandard2.0;netstandard2.1 5 | 6 | 7 | 8 | clojure.tools.reader 9 | clojure.tools 10 | clojure.tools.reader 11 | clojure.tools.reader 12 | clojure.tools.reader 13 | ClojureCLR contributors 14 | A Clojure reader and edn-only reader 15 | Copyright © Rich Hickey, ClojureCLR contributors 2025 16 | EPL-1.0 17 | https://github.com/clojure/clr.tools.namesapce 18 | ClojureCLR contributors 19 | Clojure;ClojureCLR 20 | 1.5.2 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # clr.tools.reader 2 | 3 | A port [ clojure/tools.reader](https://github.com/clojure/tools.reader) library to ClojureCLR. 4 | 5 | From the parent's README: 6 | 7 | > A complete Clojure reader and an EDN-only reader, ... 8 | 9 | See the parent repo for documentation. 10 | 11 | # Releases 12 | 13 | Latest stable release: 1.5.2 14 | 15 | [clj](https://clojure.org/guides/getting_started) dependency information: 16 | ```clojure 17 | io.github.clojure/clr.tools.reader {:git/tag "v1.5.2" :git/sha "1a7a8e9"} 18 | ``` 19 | 20 | Nuget reference: 21 | 22 | > PM> Install-Package clojure.tools.reader -Version 1.5.2 23 | 24 | [Leiningen](https://github.com/technomancy/leiningen) dependency information: 25 | ```clojure 26 | [org.clojure.clr/tools.reader "1.5.0"] 27 | ``` 28 | 29 | 30 | # Note to maintainers 31 | 32 | If using lein-clr to work on this, specifically, to run tests, be aware that the structure of the tests in this project does not conform to the leiningen standard. 33 | There is a file common_tests.clj that is loaded by several other test files 34 | (Speaking to the notion that an include-file should be added for when load is not appropriate, as here). 35 | The leiningen test framework will load common_tests.clj and fail. 36 | You need to run each top-level file directly. For example, 37 | 38 | ``` 39 | lein.bat clr test clojure.tools.metadata-test clojure.tools.reader-test clojure.tools.reader-edn-test 40 | ``` 41 | 42 | # Copyright and License # 43 | 44 | Original Clojure(JVM) code: 45 | 46 | > Copyright © Nicola Mometto, Rich Hickey & contributors. 47 | 48 | > Licensed under the EPL. (See the file epl.html.)) 49 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject org.clojure.clr/tools.reader "1.5.2" 2 | :description "Port of clojure.org/tool.reader to ClojureCLR" 3 | :url "https://github.com/clojure/clr.tools.reader" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [] 7 | :source-paths ["src/main/clojure"] 8 | :test-paths ["src/test/clojure"] 9 | :deploy-repositories [["clojars" {:url "https://clojars.org/repo/" 10 | :sign-releases false}]] 11 | :warn-on-reflection true 12 | :min-lein-version "2.0.0" 13 | :plugins [[lein-clr "0.2.1"]] 14 | :clr {:cmd-templates {:clj-exe [[?PATH "mono"] [CLJCLR17_40 %1]] 15 | :clj-dep [[?PATH "mono"] ["target/clr/clj/Debug 4.0" %1]] 16 | :clj-url "http://sourceforge.net/projects/clojureclr/files/clojure-clr-1.7.0-Debug-4.0.zip/download" 17 | :clj-zip "clojure-clr-1.7.0-Debug-4.0.zip" 18 | :curl ["curl" "--insecure" "-f" "-L" "-o" %1 %2] 19 | :nuget-ver [[?PATH "mono"] [*PATH "nuget.exe"] "install" %1 "-Version" %2] 20 | :nuget-any [[?PATH "mono"] [*PATH "nuget.exe"] "install" %1] 21 | :unzip ["unzip" "-d" %1 %2] 22 | :wget ["wget" "--no-check-certificate" "--no-clobber" "-O" %1 %2]} 23 | ;; for automatic download/unzip of ClojureCLR, 24 | ;; 1. make sure you have curl or wget installed and on PATH, 25 | ;; 2. uncomment deps in :deps-cmds, and 26 | ;; 3. use :clj-dep instead of :clj-exe in :main-cmd and :compile-cmd 27 | :deps-cmds [; [:wget :clj-zip :clj-url] ; edit to use :curl instead of :wget 28 | ; [:unzip "../clj" :clj-zip] 29 | ] 30 | :main-cmd [:clj-exe "Clojure.Main.exe"] 31 | :compile-cmd [:clj-exe "Clojure.Compile.exe"]}) 32 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/tools/reader_edn_test.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.tools.reader-edn-test 2 | (:refer-clojure :exclude [read-string]) 3 | (:use [clojure.tools.reader.edn :as edn :only [read-string]] 4 | [clojure.test :only [deftest is testing]]) 5 | (:import clojure.lang.BigInt)) 6 | 7 | (load "common_tests") 8 | 9 | (deftest read-keyword 10 | (is (= :foo-bar (read-string ":foo-bar"))) 11 | (is (= :foo/bar (read-string ":foo/bar"))) 12 | (is (= :*+!-_? (read-string ":*+!-_?"))) 13 | (is (= :abc:def:ghi (read-string ":abc:def:ghi"))) 14 | (is (= :abc.def/ghi (read-string ":abc.def/ghi"))) 15 | (is (= :abc/def.ghi (read-string ":abc/def.ghi"))) 16 | (is (= :abc:def/ghi:jkl.mno (read-string ":abc:def/ghi:jkl.mno"))) 17 | (is (instance? clojure.lang.Keyword (read-string ":alphabet"))) ) 18 | 19 | (deftest read-tagged 20 | ;; (is (= #inst "2010-11-12T13:14:15.666" 21 | ;; (read-string "#inst \"2010-11-12T13:14:15.666\""))) 22 | ;; (is (= #inst "2010-11-12T13:14:15.666" 23 | ;; (read-string "#inst\"2010-11-12T13:14:15.666\""))) 24 | ;; (is (= #uuid "550e8400-e29b-41d4-a716-446655440000" 25 | ;; (read-string "#uuid \"550e8400-e29b-41d4-a716-446655440000\""))) 26 | ;; (is (= #uuid "550e8400-e29b-41d4-a716-446655440000" 27 | ;; (read-string "#uuid\"550e8400-e29b-41d4-a716-446655440000\""))) 28 | (is (= (System.Guid. "550e8400-e29b-41d4-a716-446655440000") ;;; java.util.UUID/fromString 29 | (read-string "#uuid \"550e8400-e29b-41d4-a716-446655440000\""))) 30 | (is (= (System.Guid. "550e8400-e29b-41d4-a716-446655440000") ;;; java.util.UUID/fromString 31 | (read-string "#uuid\"550e8400-e29b-41d4-a716-446655440000\""))) 32 | (let [my-unknown (fn [tag val] {:unknown-tag tag :value val})] 33 | (is (= {:unknown-tag 'foo :value 'bar} 34 | (read-string {:default my-unknown} "#foo bar"))))) 35 | 36 | (deftest pushback-reader-test 37 | (testing "TRDR-63" 38 | (is (= '(+) (edn/read (clojure.lang.PushbackTextReader. (System.IO.StringReader. "(+)"))))))) ;;; java.io.PushbackReader. java.io.StringReader. 39 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | ############################################################################### 2 | # Set default behavior to automatically normalize line endings. 3 | ############################################################################### 4 | * text=auto 5 | 6 | ############################################################################### 7 | # Set default behavior for command prompt diff. 8 | # 9 | # This is need for earlier builds of msysgit that does not have it on by 10 | # default for csharp files. 11 | # Note: This is only used by command line 12 | ############################################################################### 13 | #*.cs diff=csharp 14 | 15 | ############################################################################### 16 | # Set the merge driver for project and solution files 17 | # 18 | # Merging from the command prompt will add diff markers to the files if there 19 | # are conflicts (Merging from VS is not affected by the settings below, in VS 20 | # the diff markers are never inserted). Diff markers may cause the following 21 | # file extensions to fail to load in VS. An alternative would be to treat 22 | # these files as binary and thus will always conflict and require user 23 | # intervention with every merge. To do so, just uncomment the entries below 24 | ############################################################################### 25 | #*.sln merge=binary 26 | #*.csproj merge=binary 27 | #*.vbproj merge=binary 28 | #*.vcxproj merge=binary 29 | #*.vcproj merge=binary 30 | #*.dbproj merge=binary 31 | #*.fsproj merge=binary 32 | #*.lsproj merge=binary 33 | #*.wixproj merge=binary 34 | #*.modelproj merge=binary 35 | #*.sqlproj merge=binary 36 | #*.wwaproj merge=binary 37 | 38 | ############################################################################### 39 | # behavior for image files 40 | # 41 | # image files are treated as binary by default. 42 | ############################################################################### 43 | #*.jpg binary 44 | #*.png binary 45 | #*.gif binary 46 | 47 | ############################################################################### 48 | # diff behavior for common document formats 49 | # 50 | # Convert binary document formats to text before diffing them. This feature 51 | # is only available from the command line. Turn it on by uncommenting the 52 | # entries below. 53 | ############################################################################### 54 | #*.doc diff=astextplain 55 | #*.DOC diff=astextplain 56 | #*.docx diff=astextplain 57 | #*.DOCX diff=astextplain 58 | #*.dot diff=astextplain 59 | #*.DOT diff=astextplain 60 | #*.pdf diff=astextplain 61 | #*.PDF diff=astextplain 62 | #*.rtf diff=astextplain 63 | #*.RTF diff=astextplain 64 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/reader/impl/inspect.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Russ Olsen, Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.reader.impl.inspect) 10 | 11 | (declare inspect*) 12 | 13 | (defn- inspect*-col [truncate col start end] 14 | (let [n (count col) 15 | l (if truncate 0 (min 10 n)) 16 | elements (map (partial inspect* true) (take l col)) 17 | content (apply str (interpose " " elements)) 18 | suffix (if (< l n) "...")] 19 | (str start content suffix end))) 20 | 21 | (defn- dispatch-inspect 22 | [_ x] 23 | (cond 24 | (nil? x) :nil 25 | (string? x) :string 26 | (keyword? x) :strable 27 | (number? x) :strable 28 | (symbol? x) :strable 29 | (vector? x) :vector 30 | (list? x) :list 31 | (map? x) :map 32 | (set? x) :set 33 | (= x true) :strable 34 | (= x false) :strable 35 | :default (class x))) 36 | 37 | (defmulti inspect* dispatch-inspect) 38 | 39 | (defmethod inspect* :string [truncate ^String x] 40 | (let [n (if truncate 5 20) 41 | suffix (if (> (.Length x) n) "...\"" "\"")] ;;; .length 42 | (str 43 | \" 44 | (.Substring ^String x 0 (min n (.Length x))) ;;; .substring .length 45 | suffix))) 46 | 47 | (defmethod inspect* :strable [truncate x] (str x)) 48 | 49 | (defmethod inspect* clojure.lang.PersistentVector+ChunkedSeq [truncate x] ;;; clojure.lang.PersistentVector$ChunkedSeq 50 | "") 51 | 52 | (defmethod inspect* clojure.lang.PersistentArrayMap+Seq [truncate x] ;;; clojure.lang.PersistentArrayMap$Seq 53 | "") 54 | 55 | (defmethod inspect* clojure.lang.PersistentHashMap+NodeSeq [truncate x] ;;; clojure.lang.PersistentHashMap$NodeSeq 56 | "") 57 | 58 | (defmethod inspect* clojure.lang.Cons [truncate x] "") 59 | 60 | (defmethod inspect* clojure.lang.LazySeq [truncate x] "") 61 | 62 | (defmethod inspect* :nil [_ _] "nil") 63 | 64 | (defmethod inspect* :list [truncate col] 65 | (inspect*-col truncate col \( \))) 66 | 67 | (defmethod inspect* :map [truncate m] 68 | (let [len (count m) 69 | n-shown (if truncate 0 len) 70 | contents (apply concat (take n-shown m)) 71 | suffix (if (> len n-shown) "...}" \})] 72 | (inspect*-col truncate contents \{ suffix))) 73 | 74 | (defmethod inspect* :set [truncate col] 75 | (inspect*-col truncate col "#{" \})) 76 | 77 | (defmethod inspect* :vector [truncate col] 78 | (inspect*-col truncate col \[ \])) 79 | 80 | (defmethod inspect* :default [truncate x] 81 | (let [classname (if (nil? x) "nil" (.Name (class x)))] ;;; .getName 82 | (str "<" classname ">"))) 83 | 84 | (defn inspect 85 | "Return a string description of the value supplied. 86 | May be the a string version of the value itself (e.g. \"true\") 87 | or it may be a description (e.g. \"an instance of Foo\"). 88 | If truncate is true then return a very terse version of 89 | the inspection." 90 | ([x] (inspect* false x)) 91 | ([truncate x] (inspect* truncate x))) -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/reader/impl/utils.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^:skip-wiki clojure.tools.reader.impl.utils 10 | (:refer-clojure :exclude [char reader-conditional tagged-literal])) 11 | 12 | (defn char [x] 13 | (when x 14 | (clojure.core/char x))) 15 | 16 | (def <=clojure-1-7-alpha5 17 | (let [{:keys [minor qualifier]} *clojure-version*] 18 | (or (< minor 7) 19 | (and (= minor 7) 20 | (= "alpha" 21 | (when qualifier 22 | (subs qualifier 0 (dec (count qualifier))))) 23 | (<= (read-string (subs qualifier (dec (count qualifier)))) 24 | 5))))) 25 | 26 | #_(defmacro compile-when [cond & then] -- compile-when has been added to ClojureCLR itself 27 | (when (eval cond) 28 | `(do ~@then))) 29 | 30 | (defn ex-info? [ex] 31 | (instance? clojure.lang.ExceptionInfo ex)) 32 | 33 | (compile-when <=clojure-1-7-alpha5 34 | (defrecord TaggedLiteral [tag form]) 35 | 36 | (defn tagged-literal? 37 | "Return true if the value is the data representation of a tagged literal" 38 | [value] 39 | (instance? clojure.tools.reader.impl.utils.TaggedLiteral value)) 40 | 41 | (defn tagged-literal 42 | "Construct a data representation of a tagged literal from a 43 | tag symbol and a form." 44 | [tag form] 45 | (clojure.tools.reader.impl.utils.TaggedLiteral. tag form)) 46 | 47 | (ns-unmap *ns* '->TaggedLiteral) 48 | (ns-unmap *ns* 'map->TaggedLiteral) 49 | 50 | (defmethod print-method clojure.tools.reader.impl.utils.TaggedLiteral [o ^System.IO.TextWriter w] ;;; ^java.io.Writer 51 | (.Write w "#") ;;; .write 52 | (print-method (:tag o) w) 53 | (.Write w " ") ;;; .write 54 | (print-method (:form o) w)) 55 | 56 | (defrecord ReaderConditional [splicing? form]) 57 | (ns-unmap *ns* '->ReaderConditional) 58 | (ns-unmap *ns* 'map->ReaderConditional) 59 | 60 | (defn reader-conditional? 61 | "Return true if the value is the data representation of a reader conditional" 62 | [value] 63 | (instance? clojure.tools.reader.impl.utils.ReaderConditional value)) 64 | 65 | (defn reader-conditional 66 | "Construct a data representation of a reader conditional. 67 | If true, splicing? indicates read-cond-splicing." 68 | [form splicing?] 69 | (clojure.tools.reader.impl.utils.ReaderConditional. splicing? form)) 70 | 71 | (defmethod print-method clojure.tools.reader.impl.utils.ReaderConditional [o ^java.io.Writer w] 72 | (.write w "#?") 73 | (when (:splicing? o) (.write w "@")) 74 | (print-method (:form o) w))) 75 | 76 | (defn whitespace? 77 | "Checks whether a given character is whitespace" 78 | [ch] 79 | (when ch 80 | (or (Char/IsWhiteSpace ^Char ch) ;;; Character/isWhitespace ^Character 81 | (identical? \, ch)))) 82 | 83 | (defn numeric? 84 | "Checks whether a given character is numeric" 85 | [ch] ;;; ^Character -- can't replace w/ Char becvuase Char is primitis 86 | (when ch 87 | (Char/IsDigit ^Char ch))) ;;; Character/isDigit, added ^Char 88 | 89 | (defn newline? 90 | "Checks whether the character is a newline" 91 | [c] 92 | (or (identical? \newline c) 93 | (nil? c))) 94 | 95 | (defn desugar-meta 96 | "Resolves syntactical sugar in metadata" ;; could be combined with some other desugar? 97 | [f] 98 | (cond 99 | (keyword? f) {f true} 100 | (symbol? f) {:tag f} 101 | (string? f) {:tag f} 102 | (vector? f) {:param-tags f} 103 | :else f)) 104 | 105 | (defn make-var 106 | "Returns an anonymous unbound Var" 107 | [] 108 | (with-local-vars [x nil] x)) 109 | 110 | (defn namespace-keys [ns keys] 111 | (for [key keys] 112 | (if (or (symbol? key) 113 | (keyword? key)) 114 | (let [[key-ns key-name] ((juxt namespace name) key) 115 | ->key (if (symbol? key) symbol keyword)] 116 | (cond 117 | (nil? key-ns) 118 | (->key ns key-name) 119 | 120 | (= "_" key-ns) 121 | (->key key-name) 122 | 123 | :else 124 | key)) 125 | key))) 126 | 127 | (defn second' [[a b]] 128 | (when-not a b)) 129 | 130 | 131 | ;;; DM: ADDED FOR COMPATIBILITY WITH ClojureCLR 1.8. 132 | ;;; These will not be needed in ClojureCLR 1.9 and later. 133 | 134 | (defn char-value-in-radix 135 | "Reproduces clojure.lang.LispReader.CharValueInRadix. It was private in ClojureCLR 1.8 and earlier. 136 | This handles most of the cases (except wide Latin digits) of the Java Character/digit" 137 | [c radix] 138 | (cond 139 | (Char/IsDigit (char c)) 140 | (let [x (- c (long \0))] (if (< x radix) x -1)) 141 | (<= (long \A) c (long \Z)) 142 | (let [x (- c (long \A))] (if (< x (- radix 10)) (+ x 10) -1)) 143 | (<= (long \a) c (long \z)) 144 | (let [x (- c (long \a))] (if (< x (- radix 10)) (+ x 10) -1)) 145 | :else 146 | -1)) 147 | 148 | (def ^:private ^System.Reflection.FieldInfo JReMatcher-match-fieldinfo 149 | (.GetField clojure.lang.JReMatcher "_match" (enum-or System.Reflection.BindingFlags/NonPublic System.Reflection.BindingFlags/Instance))) 150 | 151 | (defn normalized-re-group 152 | "JReMatcher in Clojure 1.8 and before is not identical to java.util.regex.Matcher on the group method. 153 | The Java version returns null on an unsuccessful subexpression match. JReMatcher returns the empty string. 154 | Call (normalized-re-group matcher i) instead of (.group matcher i) when this matters." 155 | [^clojure.lang.JReMatcher m index] 156 | (let [ match ^System.Text.RegularExpressions.Match (.GetValue JReMatcher-match-fieldinfo m) 157 | groups ^System.Text.RegularExpressions.GroupCollection (.Groups match) 158 | group ^System.Text.RegularExpressions.Group (.get_Item groups (int index))] 159 | (if (.Success group) 160 | (.Value group) 161 | nil))) 162 | 163 | (defn add-front 164 | "Add sequence of items to the front of a System.Collections.Generic.LinkedList. 165 | This is supposed to handle the same situation as (.addAll ^java.util.List lst 0 items) used in the conditonal form splicer code. 166 | Someday, find a better way to code this." 167 | [^|System.Collections.Generic.LinkedList`1[System.Object]| lst items] 168 | (let [ first-node (.First lst)] 169 | (doseq [item (reverse items)] 170 | (if first-node 171 | (.AddAfter lst first-node item) 172 | (.AddFirst lst item))))) -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/reader/impl/errors.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Russ Olsen, Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.reader.impl.errors 10 | (:require [clojure.tools.reader.reader-types :as types] 11 | [clojure.tools.reader.impl.inspect :as i])) 12 | 13 | (defn- location-details [rdr ex-type] 14 | (let [details {:type :reader-exception 15 | :ex-kind ex-type}] 16 | (if (types/indexing-reader? rdr) 17 | (assoc 18 | details 19 | :file (types/get-file-name rdr) 20 | :line (types/get-line-number rdr) 21 | :col (types/get-column-number rdr)) 22 | details))) 23 | 24 | (defn ^:private throw-ex 25 | [rdr ex-type & msg] 26 | (let [details (location-details rdr ex-type) 27 | file (:file details) 28 | line (:line details) 29 | col (:col details) 30 | msg1 (if file (str file " ")) 31 | msg2 (if line (str "[line " line ", col " col "]")) 32 | msg3 (if (or msg1 msg2) " ") 33 | full-msg (apply str msg1 msg2 msg3 msg)] 34 | (throw (ex-info full-msg details)))) 35 | 36 | (defn reader-error 37 | "Throws an ExceptionInfo with the given message. 38 | If rdr is an IndexingReader, additional information about column and line number is provided" 39 | [rdr & msgs] 40 | (throw-ex rdr :reader-error (apply str msgs))) 41 | 42 | (defn eof-error 43 | "Throws an ExceptionInfo with the given message. 44 | If rdr is an IndexingReader, additional information about column and line number is provided" 45 | [rdr & msgs] 46 | (throw-ex rdr :eof (apply str msgs))) 47 | 48 | (defn illegal-arg-error 49 | "Throws an ExceptionInfo with the given message. 50 | If rdr is an IndexingReader, additional information about column and line number is provided" 51 | [rdr & msgs] 52 | (throw-ex rdr :illegal-argument (apply str msgs))) 53 | 54 | (defn throw-eof-delimited 55 | ([rdr kind line column] (throw-eof-delimited rdr kind line column nil)) 56 | ([rdr kind line column n] 57 | (eof-error 58 | rdr 59 | "Unexpected EOF while reading " 60 | (if n 61 | (str "item " n " of ")) 62 | (name kind) 63 | (if line 64 | (str ", starting at line " line " and column " column)) 65 | "."))) 66 | 67 | (defn throw-odd-map [rdr line col elements] 68 | (reader-error 69 | rdr 70 | "The map literal starting with " 71 | (i/inspect (first elements)) 72 | (if line (str " on line " line " column " col)) 73 | " contains " 74 | (count elements) 75 | " form(s). Map literals must contain an even number of forms.")) 76 | 77 | (defn throw-invalid-number [rdr token] 78 | (reader-error 79 | rdr 80 | "Invalid number: " 81 | token 82 | ".")) 83 | 84 | (defn throw-invalid-unicode-literal [rdr token] 85 | (throw 86 | (illegal-arg-error rdr 87 | "Invalid unicode literal: \\" token "."))) 88 | 89 | (defn throw-invalid-unicode-escape [rdr ch] 90 | (reader-error 91 | rdr 92 | "Invalid unicode escape: \\u" 93 | ch 94 | ".")) 95 | 96 | (defn throw-invalid [rdr kind token] 97 | (reader-error rdr "Invalid " (name kind) ": " token ".")) 98 | 99 | (defn throw-eof-at-start [rdr kind] 100 | (eof-error rdr "Unexpected EOF while reading start of " (name kind) ".")) 101 | 102 | (defn throw-bad-char [rdr kind ch] 103 | (reader-error rdr "Invalid character: " ch " found while reading " (name kind) ".")) 104 | 105 | (defn throw-eof-at-dispatch [rdr] 106 | (eof-error rdr "Unexpected EOF while reading dispatch character.")) 107 | 108 | (defn throw-unmatch-delimiter [rdr ch] 109 | (reader-error rdr "Unmatched delimiter " ch ".")) 110 | 111 | (defn throw-eof-reading [rdr kind & start] 112 | (let [init (case kind :regex "#\"" :string \")] 113 | (eof-error rdr "Unexpected EOF reading " (name kind) " starting " (apply str init start) "."))) 114 | 115 | (defn throw-invalid-unicode-char[rdr token] 116 | (throw 117 | (illegal-arg-error rdr 118 | "Invalid unicode character \\" token "."))) 119 | 120 | (defn throw-invalid-unicode-digit-in-token[rdr ch token] 121 | (throw 122 | (illegal-arg-error rdr 123 | "Invalid digit " ch " in unicode character \\" token "."))) 124 | 125 | (defn throw-invalid-unicode-digit[rdr ch] 126 | (throw 127 | (illegal-arg-error rdr 128 | "Invalid digit " ch " in unicode character."))) 129 | 130 | (defn throw-invalid-unicode-len[rdr actual expected] 131 | (throw 132 | (illegal-arg-error rdr 133 | "Invalid unicode literal. Unicode literals should be " 134 | expected 135 | " characters long. " 136 | "Value supplied is " 137 | actual 138 | " characters long."))) 139 | 140 | (defn throw-invalid-character-literal[rdr token] 141 | (reader-error rdr "Invalid character literal \\u" token ".")) 142 | 143 | (defn throw-invalid-octal-len[rdr token] 144 | (reader-error 145 | rdr 146 | "Invalid octal escape sequence in a character literal: " 147 | token 148 | ". Octal escape sequences must be 3 or fewer digits.")) 149 | 150 | (defn throw-bad-octal-number [rdr] 151 | (reader-error rdr "Octal escape sequence must be in range [0, 377].")) 152 | 153 | (defn throw-unsupported-character[rdr token] 154 | (reader-error 155 | rdr 156 | "Unsupported character: " 157 | token 158 | ".")) 159 | 160 | (defn throw-eof-in-character[rdr] 161 | (eof-error rdr "Unexpected EOF while reading character.")) 162 | 163 | (defn throw-bad-escape-char [rdr ch] 164 | (reader-error rdr "Unsupported escape character: \\" ch ".")) 165 | 166 | (defn throw-single-colon [rdr] 167 | (reader-error rdr "A single colon is not a valid keyword.")) 168 | 169 | (defn throw-bad-metadata [rdr x] 170 | (reader-error 171 | rdr 172 | "Metadata cannot be " 173 | (i/inspect x) 174 | ". Metadata must be a Symbol, Keyword, String, Map or Vector.")) 175 | 176 | (defn throw-bad-metadata-target [rdr target] 177 | (reader-error 178 | rdr 179 | "Metadata can not be applied to " 180 | (i/inspect target) 181 | ". " 182 | "Metadata can only be applied to IMetas.")) 183 | 184 | (defn throw-feature-not-keyword [rdr feature] 185 | (reader-error 186 | rdr 187 | "Feature cannot be " 188 | (i/inspect feature) 189 | ". Features must be keywords.")) 190 | 191 | (defn throw-ns-map-no-map [rdr ns-name] 192 | (reader-error rdr "Namespaced map with namespace " ns-name " does not specify a map.")) 193 | 194 | (defn throw-bad-ns [rdr ns-name] 195 | (reader-error rdr "Invalid value used as namespace in namespaced map: " ns-name ".")) 196 | 197 | (defn throw-bad-reader-tag [rdr tag] 198 | (reader-error 199 | rdr 200 | "Invalid reader tag: " 201 | (i/inspect tag) 202 | ". Reader tags must be symbols.")) 203 | 204 | (defn throw-unknown-reader-tag [rdr tag] 205 | (reader-error 206 | rdr 207 | "No reader function for tag " 208 | (i/inspect tag) 209 | ".")) 210 | 211 | (defn throw-eof-error [rdr line] 212 | (if line 213 | (eof-error rdr "EOF while reading, starting at line " line ".") 214 | (eof-error rdr "EOF while reading."))) -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/reader/impl/commons.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.reader.impl.commons 10 | (:refer-clojure :exclude [char]) 11 | (:require [clojure.tools.reader.reader-types :refer [peek-char read-char]] 12 | [clojure.tools.reader.impl.errors :refer [reader-error]] 13 | [clojure.tools.reader.impl.utils :refer [numeric? newline? char normalized-re-group char-value-in-radix]]) ;;; DM: Added char-value-in-radix normalized-re-group 14 | (:import (clojure.lang BigInt Numbers JReMatcher) ;;; Added JReMatcher 15 | (System.Text.RegularExpressions Regex) ;;; (java.util.regex Pattern Matcher) 16 | )) ;;; java.lang.reflect.Constructor 17 | 18 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 19 | ;; helpers 20 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 21 | 22 | (defn number-literal? 23 | "Checks whether the reader is at the start of a number literal" 24 | [reader initch] 25 | (or (numeric? initch) 26 | (and (or (identical? \+ initch) (identical? \- initch)) 27 | (numeric? (peek-char reader))))) 28 | 29 | (defn read-past 30 | "Read until first character that doesn't match pred, returning 31 | char." 32 | [pred rdr] 33 | (loop [ch (read-char rdr)] 34 | (if (pred ch) 35 | (recur (read-char rdr)) 36 | ch))) 37 | 38 | (defn skip-line 39 | "Advances the reader to the end of a line. Returns the reader" 40 | [reader] 41 | (loop [] 42 | (when-not (newline? (read-char reader)) 43 | (recur))) 44 | reader) 45 | 46 | (def ^Regex int-pattern #"^([-+]?)(?:(0)|([1-9][0-9]*)|0[xX]([0-9A-Fa-f]+)|0([0-7]+)|([1-9][0-9]?)[rR]([0-9A-Za-z]+)|0[0-9]+)(N)?$") ;;; ^Pattern & add ^ $ around 47 | (def ^Regex ratio-pattern #"^([-+]?[0-9]+)/([0-9]+)$") ;;; ^Pattern & add ^ $ around 48 | (def ^Regex float-pattern #"^([-+]?[0-9]+(\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?$") ;;; ^Pattern & add ^ $ around 49 | 50 | (defn- match-int 51 | [^JReMatcher m] ;;; ^Matcher 52 | (if (normalized-re-group m 2) ;;; .group 53 | (if (normalized-re-group m 8) 0N 0) ;;; .group 54 | (let [negate? (= "-" (normalized-re-group m 1)) ;;; .group 55 | a (cond 56 | (normalized-re-group m 3) [(normalized-re-group m 3) 10] ;;; .group 57 | (normalized-re-group m 4) [(normalized-re-group m 4) 16] ;;; .group 58 | (normalized-re-group m 5) [(normalized-re-group m 5) 8] ;;; .group 59 | (normalized-re-group m 7) [(normalized-re-group m 7) (Int32/Parse (normalized-re-group m 6))] ;;; .group Integer/parseInt 60 | :else [nil nil]) 61 | ^String n (a 0)] 62 | (when n 63 | (let [bn (BigInteger/Parse n (int (a 1))) ;;; BigInteger. 64 | bn (if negate? (.Negate bn) bn)] ;;; .negate 65 | (if (normalized-re-group m 8) ;;; .group 66 | (BigInt/fromBigInteger bn) 67 | (let [lv 0 ] ;;; (if (< (.bitLength bn) 64) 68 | (if (.AsInt64 bn (by-ref ^long lv)) lv ;;; (.longValue bn) ) 69 | (BigInt/fromBigInteger bn))))))))) 70 | 71 | (defn- match-ratio 72 | [^JReMatcher m] ;;; ^Matcher 73 | (let [^String numerator (normalized-re-group m 1) ;;; .group 74 | ^String denominator (normalized-re-group m 2) ;;; .group 75 | numerator (if (.StartsWith numerator "+") ;;; .startsWith 76 | (subs numerator 1) 77 | numerator)] 78 | (/ (-> numerator BigInteger/Parse BigInt/fromBigInteger Numbers/ReduceBigInt) ;;; BigInteger. reduceBigInt 79 | (-> denominator BigInteger/Parse BigInt/fromBigInteger Numbers/ReduceBigInt)))) ;;; BigInteger. reduceBigInt 80 | 81 | (defn- match-float 82 | [^String s ^JReMatcher m] ;;; ^Matcher 83 | (if (normalized-re-group m 4) ;;; .group 84 | (BigDecimal/Create ^String (normalized-re-group m 1)) ;;; BigDecimal. .group 85 | (Double/Parse s))) ;;; Double/parseDouble 86 | 87 | (defn match-number [^String s] 88 | (let [int-matcher (JReMatcher. int-pattern s)] ;;; .matcher 89 | (if (.matches int-matcher) 90 | (match-int int-matcher) 91 | (let [float-matcher (JReMatcher. float-pattern s)] ;;; .matcher 92 | (if (.matches float-matcher) 93 | (match-float s float-matcher) 94 | (let [ratio-matcher (JReMatcher. ratio-pattern s)] ;;; .matcher 95 | (when (.matches ratio-matcher) 96 | (match-ratio ratio-matcher)))))))) 97 | 98 | ;; Significant hacking on parse-symbol to deal with |-quoting. 99 | 100 | ;; The original parse-symbol can be used when there are no |'s in the token. 101 | 102 | (defn- parse-symbol-unquoted 103 | "Parses a string into a vector of the namespace and symbol" 104 | [^String token] 105 | (when-not (or (= "" token) 106 | (.EndsWith token ":") ;;; .endsWith 107 | (.StartsWith token "::")) ;;; .startsWith 108 | (let [ns-idx (.IndexOf token "/")] ;;; .indexOf 109 | (if-let [^String ns (and (pos? ns-idx) 110 | (subs token 0 ns-idx))] 111 | (let [ns-idx (inc ns-idx)] 112 | (when-not (== ns-idx (count token)) 113 | (let [sym (subs token ns-idx)] 114 | (cond 115 | (re-matches #"[1-9]" sym) 116 | [ns sym] 117 | (and (not (numeric? (nth sym 0))) 118 | (not (= "" sym)) 119 | (not (.EndsWith ns ":")) ;;; .endsWith 120 | (or (= sym "/") 121 | (== -1 (.IndexOf sym "/")))) ;;; .indexOf 122 | [ns sym])))) 123 | (when (or (= token "/") 124 | (== -1 (.IndexOf token "/"))) ;;; .indexOf 125 | [nil token]))))) 126 | 127 | (defn- decode-quoted-token 128 | "Returns a 'masked' version of the token with all quoted characters replaced by 'a' and the raw version with all the |'s removed (handling || properly)" 129 | [^String token] 130 | (let [sbMasked (StringBuilder.) 131 | sbRaw (StringBuilder.)] 132 | (loop [i 0 rawMode false] 133 | (cond 134 | (>= i (.Length token)) 135 | [(str sbMasked) (str sbRaw)] 136 | rawMode 137 | (if (= (.get_Chars token i) \|) 138 | (if (and (< i (dec (.Length token))) (= (.get_Chars token (inc i)) \|)) 139 | (do (.Append sbMasked \a) 140 | (.Append sbRaw \|) 141 | (recur (+ i 2) rawMode)) 142 | (recur (+ i 1) false)) 143 | (do (.Append sbMasked \a) 144 | (.Append sbRaw (.get_Chars token i)) 145 | (recur (+ i 1) rawMode))) 146 | (= (.get_Chars token i) \|) 147 | (recur (+ i 1) true) 148 | :else 149 | (do (.Append sbMasked (.get_Chars token i)) 150 | (.Append sbRaw (.get_Chars token i)) 151 | (recur (+ i 1) rawMode)))))) 152 | 153 | (defn- parse-symbol-quoted 154 | [^String token] 155 | (let [[masked raw] (decode-quoted-token token)] 156 | (let [result (parse-symbol-unquoted masked)] 157 | (when result 158 | (let [[^String ns sym] result] 159 | (if (nil? ns) 160 | [nil raw] 161 | [(.Substring ^String raw 0 (.Length ns)) 162 | (.Substring ^String raw (inc (.Length ns)))])))))) 163 | 164 | 165 | (defn parse-symbol 166 | "Parses a string into a vector of the namespace and symbol" 167 | [^String token] 168 | (if (.Contains token "|") 169 | (parse-symbol-quoted token) 170 | (parse-symbol-unquoted token))) 171 | 172 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 173 | ;; readers 174 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 175 | 176 | (defn read-comment 177 | [rdr & _] 178 | (skip-line rdr)) 179 | 180 | (defn throwing-reader 181 | [msg] 182 | (fn [rdr & _] 183 | (reader-error rdr msg))) 184 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/tools/common_tests.clj: -------------------------------------------------------------------------------- 1 | 2 | (deftest read-integer 3 | (is (== 42 (read-string "42"))) 4 | (is (== +42 (read-string "+42"))) 5 | (is (== -42 (read-string "-42"))) 6 | 7 | (is (== 42 (read-string "42N"))) 8 | (is (== +42 (read-string "+42N"))) 9 | (is (== -42 (read-string "-42N"))) 10 | 11 | (is (== 0 (read-string "0"))) 12 | (is (== 0N (read-string "0N"))) 13 | 14 | (is (== 042 (read-string "042"))) 15 | (is (== +042 (read-string "+042"))) 16 | (is (== -042 (read-string "-042"))) 17 | 18 | (is (== 0x42e (read-string "0x42e"))) 19 | (is (== +0x42e (read-string "+0x42e"))) 20 | (is (== -0x42e (read-string "-0x42e"))) 21 | 22 | (is (instance? Int64 (read-string "2147483647"))) ;;; Long 23 | (is (instance? Int64 (read-string "+1"))) ;;; Long 24 | (is (instance? Int64 (read-string "1"))) ;;; Long 25 | (is (instance? Int64 (read-string "+0"))) ;;; Long 26 | (is (instance? Int64 (read-string "0"))) ;;; Long 27 | (is (instance? Int64 (read-string "-0"))) ;;; Long 28 | (is (instance? Int64 (read-string "-1"))) ;;; Long 29 | (is (instance? Int64 (read-string "-2147483648"))) ;;; Long 30 | 31 | (is (instance? Int64 (read-string "2147483648"))) ;;; Long 32 | (is (instance? Int64 (read-string "-2147483649"))) ;;; Long 33 | (is (instance? Int64 (read-string "9223372036854775807"))) ;;; Long 34 | (is (instance? Int64 (read-string "-9223372036854775808"))) ;;; Long 35 | 36 | (is (instance? BigInt (read-string "9223372036854775808"))) 37 | (is (instance? BigInt (read-string "-9223372036854775809"))) 38 | (is (instance? BigInt (read-string "10000000000000000000000000000000000000000000000000"))) 39 | (is (instance? BigInt (read-string "-10000000000000000000000000000000000000000000000000")))) 40 | 41 | (deftest read-floating 42 | (is (== 42.23 (read-string "42.23"))) 43 | (is (== +42.23 (read-string "+42.23"))) 44 | (is (== -42.23 (read-string "-42.23"))) 45 | 46 | (is (== 42.23M (read-string "42.23M"))) 47 | (is (== +42.23M (read-string "+42.23M"))) 48 | (is (== -42.23M (read-string "-42.23M"))) 49 | 50 | (is (== 42.2e3 (read-string "42.2e3"))) 51 | (is (== +42.2e+3 (read-string "+42.2e+3"))) 52 | (is (== -42.2e-3 (read-string "-42.2e-3"))) 53 | 54 | (is (== 42.2e3M (read-string "42.2e3M"))) 55 | (is (== +42.2e+3M (read-string "+42.2e+3M"))) 56 | (is (== -42.2e-3M (read-string "-42.2e-3M"))) 57 | 58 | (is (instance? Double (read-string "+1.0e+1"))) 59 | (is (instance? Double (read-string "+1.e+1"))) 60 | (is (instance? Double (read-string "+1e+1"))) 61 | 62 | (is (instance? Double (read-string "+1.0e+1"))) 63 | (is (instance? Double (read-string "+1.e+1"))) 64 | (is (instance? Double (read-string "+1e+1"))) 65 | 66 | (is (instance? Double (read-string "+1.0e1"))) 67 | (is (instance? Double (read-string "+1.e1"))) 68 | (is (instance? Double (read-string "+1e1"))) 69 | 70 | (is (instance? Double (read-string "+1.0e-1"))) 71 | (is (instance? Double (read-string "+1.e-1"))) 72 | (is (instance? Double (read-string "+1e-1"))) 73 | 74 | (is (instance? Double (read-string "1.0e+1"))) 75 | (is (instance? Double (read-string "1.e+1"))) 76 | (is (instance? Double (read-string "1e+1"))) 77 | 78 | (is (instance? Double (read-string "1.0e-1"))) 79 | (is (instance? Double (read-string "1.e-1"))) 80 | (is (instance? Double (read-string "1e-1"))) 81 | 82 | (is (instance? Double (read-string "-1.0e+1"))) 83 | (is (instance? Double (read-string "-1.e+1"))) 84 | (is (instance? Double (read-string "-1e+1"))) 85 | 86 | (is (instance? Double (read-string "-1.0e1"))) 87 | (is (instance? Double (read-string "-1.e1"))) 88 | (is (instance? Double (read-string "-1e1"))) 89 | 90 | (is (instance? Double (read-string "-1.0e-1"))) 91 | (is (instance? Double (read-string "-1.e-1"))) 92 | (is (instance? Double (read-string "-1e-1"))) 93 | 94 | (is (instance? Double (read-string "+1.0"))) 95 | (is (instance? Double (read-string "+1."))) 96 | 97 | (is (instance? Double (read-string "1.0"))) 98 | (is (instance? Double (read-string "1."))) 99 | 100 | (is (instance? Double (read-string "+0.0"))) 101 | (is (instance? Double (read-string "+0."))) 102 | 103 | (is (instance? Double (read-string "0.0"))) 104 | (is (instance? Double (read-string "0."))) 105 | 106 | (is (instance? Double (read-string "-0.0"))) 107 | (is (instance? Double (read-string "-0."))) 108 | 109 | (is (instance? Double (read-string "-1.0"))) 110 | (is (instance? Double (read-string "-1."))) 111 | 112 | (is (instance? BigDecimal (read-string "9223372036854775808M"))) 113 | (is (instance? BigDecimal (read-string "-9223372036854775809M"))) 114 | (is (instance? BigDecimal (read-string "2147483647M"))) 115 | (is (instance? BigDecimal (read-string "+1M"))) 116 | (is (instance? BigDecimal (read-string "1M"))) 117 | (is (instance? BigDecimal (read-string "+0M"))) 118 | (is (instance? BigDecimal (read-string "0M"))) 119 | (is (instance? BigDecimal (read-string "-0M"))) 120 | (is (instance? BigDecimal (read-string "-1M"))) 121 | (is (instance? BigDecimal (read-string "-2147483648M"))) 122 | 123 | (is (instance? BigDecimal (read-string "+1.0e+1M"))) 124 | (is (instance? BigDecimal (read-string "+1.e+1M"))) 125 | (is (instance? BigDecimal (read-string "+1e+1M"))) 126 | 127 | (is (instance? BigDecimal (read-string "+1.0e1M"))) 128 | (is (instance? BigDecimal (read-string "+1.e1M"))) 129 | (is (instance? BigDecimal (read-string "+1e1M"))) 130 | 131 | (is (instance? BigDecimal (read-string "+1.0e-1M"))) 132 | (is (instance? BigDecimal (read-string "+1.e-1M"))) 133 | (is (instance? BigDecimal (read-string "+1e-1M"))) 134 | 135 | (is (instance? BigDecimal (read-string "1.0e+1M"))) 136 | (is (instance? BigDecimal (read-string "1.e+1M"))) 137 | (is (instance? BigDecimal (read-string "1e+1M"))) 138 | 139 | (is (instance? BigDecimal (read-string "1.0e1M"))) 140 | (is (instance? BigDecimal (read-string "1.e1M"))) 141 | (is (instance? BigDecimal (read-string "1e1M"))) 142 | 143 | (is (instance? BigDecimal (read-string "1.0e-1M"))) 144 | (is (instance? BigDecimal (read-string "1.e-1M"))) 145 | (is (instance? BigDecimal (read-string "1e-1M"))) 146 | 147 | (is (instance? BigDecimal (read-string "-1.0e+1M"))) 148 | (is (instance? BigDecimal (read-string "-1.e+1M"))) 149 | (is (instance? BigDecimal (read-string "-1e+1M"))) 150 | 151 | (is (instance? BigDecimal (read-string "-1.0e1M"))) 152 | (is (instance? BigDecimal (read-string "-1.e1M"))) 153 | (is (instance? BigDecimal (read-string "-1e1M"))) 154 | 155 | (is (instance? BigDecimal (read-string "-1.0e-1M"))) 156 | (is (instance? BigDecimal (read-string "-1.e-1M"))) 157 | (is (instance? BigDecimal (read-string "-1e-1M"))) 158 | 159 | (is (instance? BigDecimal (read-string "+1.0M"))) 160 | (is (instance? BigDecimal (read-string "+1.M"))) 161 | 162 | (is (instance? BigDecimal (read-string "1.0M"))) 163 | (is (instance? BigDecimal (read-string "1.M"))) 164 | 165 | (is (instance? BigDecimal (read-string "+0.0M"))) 166 | (is (instance? BigDecimal (read-string "+0.M"))) 167 | 168 | (is (instance? BigDecimal (read-string "0.0M"))) 169 | (is (instance? BigDecimal (read-string "0.M"))) 170 | 171 | (is (instance? BigDecimal (read-string "-0.0M"))) 172 | (is (instance? BigDecimal (read-string "-0.M"))) 173 | 174 | (is (instance? BigDecimal (read-string "-1.0M"))) 175 | (is (instance? BigDecimal (read-string "-1.M")))) 176 | 177 | (deftest read-ratio 178 | (is (== 4/2 (read-string "4/2"))) 179 | (is (== 4/2 (read-string "+4/2"))) 180 | (is (== -4/2 (read-string "-4/2")))) 181 | 182 | 183 | (deftest read-symbol 184 | (is (= 'foo (read-string "foo"))) 185 | (is (= 'foo/bar (read-string "foo/bar"))) 186 | (is (= '*+!-_? (read-string "*+!-_?"))) 187 | (is (= 'abc:def:ghi (read-string "abc:def:ghi"))) 188 | (is (= 'abc.def/ghi (read-string "abc.def/ghi"))) 189 | (is (= 'abc/def.ghi (read-string "abc/def.ghi"))) 190 | (is (= 'abc:def/ghi:jkl.mno (read-string "abc:def/ghi:jkl.mno"))) 191 | (is (instance? clojure.lang.Symbol (read-string "alphabet"))) 192 | (is (= "foo//" (str (read-string "foo//")))) ;; the clojure reader can't read this 193 | (is (= (str 'NaN) (str (read-string "##NaN")))) 194 | (is (= Double/PositiveInfinity (read-string "##Inf"))) ;;; Double/POSITIVE_INFINITY 195 | (is (= Double/NegativeInfinity (read-string "##-Inf")))) ;;; Double/NEGATIVE_INFINITY 196 | 197 | (deftest read-specials 198 | (is (= 'nil nil)) 199 | (is (= 'false false)) 200 | (is (= 'true true))) 201 | 202 | (deftest read-char 203 | (is (= \f (read-string "\\f"))) 204 | (is (= \u0194 (read-string "\\u0194"))) 205 | (is (= \o123 (read-string "\\o123"))) 206 | (is (= \newline (read-string "\\newline"))) 207 | (is (= (char 0) (read-string "\\o0"))) 208 | (is (= (char 0) (read-string "\\o000"))) 209 | (is (= (char 0377) (read-string "\\o377"))) 210 | (is (= \A (read-string "\\u0041"))) 211 | (is (= \@ (read-string "\\@"))) 212 | (is (= (char 0xd7ff) (read-string "\\ud7ff"))) 213 | (is (= (char 0xe000) (read-string "\\ue000"))) 214 | (is (= (char 0xffff) (read-string "\\uffff")))) 215 | 216 | (deftest read-string* 217 | (is (= "foo bar" (read-string "\"foo bar\""))) 218 | (is (= "foo\\bar" (read-string "\"foo\\\\bar\""))) 219 | (is (= "foo\000bar" (read-string "\"foo\\000bar\""))) 220 | (is (= "foo\u0194bar" (read-string "\"foo\\u0194bar\""))) 221 | (is (= "foo\123bar" (read-string "\"foo\\123bar\""))) 222 | (is (= "\060" (read-string "\"\\060\""))) 223 | (is (= "\340" (read-string "\"\\340\""))) 224 | (is (= "\377" (read-string "\"\\377\"")))) 225 | 226 | (deftest read-list 227 | (is (= '() (read-string "()"))) 228 | (is (= '(foo bar) (read-string "(foo bar)"))) 229 | (is (= '(foo (bar) baz) (read-string "(foo (bar) baz)")))) 230 | 231 | (deftest read-vector 232 | (is (= '[] (read-string "[]"))) 233 | (is (= '[foo bar] (read-string "[foo bar]"))) 234 | (is (= '[foo [bar] baz] (read-string "[foo [bar] baz]")))) 235 | 236 | (deftest read-map 237 | (is (= '{} (read-string "{}"))) 238 | (is (= '{foo bar} (read-string "{foo bar}"))) 239 | (is (= '{foo {bar baz}} (read-string "{foo {bar baz}}")))) 240 | 241 | (deftest read-set 242 | (is (= '#{} (read-string "#{}"))) 243 | (is (= '#{foo bar} (read-string "#{foo bar}"))) 244 | (is (= '#{foo #{bar} baz} (read-string "#{foo #{bar} baz}")))) 245 | 246 | (deftest read-metadata 247 | (is (= {:foo true} (meta (read-string "^:foo 'bar")))) 248 | (is (= {:foo 'bar} (meta (read-string "^{:foo bar} 'baz")))) 249 | (is (= {:tag "foo"} (meta (read-string "^\"foo\" 'bar")))) 250 | (is (= {:tag 'String} (meta (read-string "^String 'x"))))) 251 | 252 | (deftest read-namespaced-map' 253 | (is (= {:foo/bar 1 :baz 2} (read-string "#:foo{:bar 1 :_/baz 2}"))) 254 | (is (= '{foo/bar 1 :baz 2} (read-string "#:foo{bar 1 :_/baz 2}")))) 255 | 256 | 257 | ;; DM: Added tests to handle |-quoting in symbols. 258 | (deftest read-symbols-quoted 259 | 260 | (is (= 'abc (read-string "|abc|"))) 261 | (is (= 'abc (read-string "a|b|c"))) 262 | (is (= '|abc[]()| (read-string "|abc[]()|"))) 263 | (is (= '|abc/def| (read-string "|abc/def|"))) 264 | (is (= 'abc|/|def (read-string "abc|/|def"))) 265 | (is (= '|abc|/|def| (read-string "|abc|/|def|"))) 266 | (is (= '|abc||def| (read-string "|abc||def|"))) 267 | 268 | ) 269 | 270 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/tools/metadata_test.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.tools.metadata-test 2 | (:refer-clojure :exclude [read *default-data-reader-fn* read-string]) 3 | (:use [clojure.tools.reader :only [read *default-data-reader-fn* read-string]] 4 | [clojure.test :only [deftest is]]) 5 | (:require [clojure.tools.reader.reader-types :as reader-types] 6 | [clojure.string :as str] 7 | [clojure.walk :as walk]) 8 | (:import ;;; java.nio.charset.Charset 9 | (System.IO StringReader) ;;; java.io BufferedReader(-) 10 | clojure.lang.LineNumberingTextReader)) ;;; LineNumberingPushbackReader 11 | 12 | (defn compare-forms-with-meta [expected-form actual-form] 13 | (let [comparisons (map vector (tree-seq coll? identity expected-form) 14 | (tree-seq coll? identity actual-form))] 15 | (doseq [[expected actual] comparisons] 16 | (is (= [expected (meta expected)] [actual (meta actual)]))))) 17 | 18 | (def test-contents 19 | "Contents of a file stream for testing." 20 | "(ns clojure.tools.reader.haiku)\n\n(defn haiku 21 | \"It will read the form 22 | but will the form metadata be 23 | or never become?\" 24 | [first-five middle-seven last-five] 25 | (- (apply + 26 | ^{:last last-five} [1 2 3]) 27 | first-five middle-seven))") 28 | 29 | (defn test-reader 30 | "Return a fresh byte array input stream reading off test-bytes" 31 | [test-contents] 32 | (StringReader. test-contents)) 33 | 34 | (defn replace-newlines [s replacement] 35 | (str/replace s "\n" replacement)) 36 | 37 | (def expected-haiku-ns 38 | (with-meta '(^{:line 1 :column 2 :end-line 1 :end-column 4 :file "haiku.clj"} ns 39 | ^{:line 1 :column 5 :end-line 1 :end-column 31 :file "haiku.clj"} clojure.tools.reader.haiku) 40 | {:line 1 :column 1 :end-line 1 :end-column 32 :file "haiku.clj"})) 41 | 42 | (def expected-haiku-defn 43 | (with-meta (list 44 | '^{:line 3 :column 2 :end-line 3 :end-column 6 :file "haiku.clj"} defn 45 | '^{:line 3 :column 7 :end-line 3 :end-column 12 :file "haiku.clj"} haiku 46 | "It will read the form\n but will the form metadata be\n or never become?" 47 | (with-meta ['^{:line 7 :column 6 :end-line 7 :end-column 16 :file "haiku.clj"} first-five 48 | '^{:line 7 :column 17 :end-line 7 :end-column 29 :file "haiku.clj"} middle-seven 49 | '^{:line 7 :column 30 :end-line 7 :end-column 39 :file "haiku.clj"} last-five] 50 | {:line 7 :column 5 :end-line 7 :end-column 40 :file "haiku.clj"}) 51 | (with-meta (list '^{:line 8 :column 6 :end-line 8, :end-column 7 :file "haiku.clj"} - 52 | (with-meta (list '^{:line 8 :column 9 :end-line 8 :end-column 14 :file "haiku.clj"} apply 53 | '^{:line 8 :column 15 :end-line 8 :end-column 16 :file "haiku.clj"} + 54 | ^{:last 'last-five :line 9 :column 34 :end-line 9 :end-column 41 :file "haiku.clj"} 55 | [1 2 3]) 56 | {:line 8 :column 8 :end-line 9 :end-column 42 :file "haiku.clj"}) 57 | '^{:line 10 :column 8 :end-line 10 :end-column 18 :file "haiku.clj"} first-five 58 | '^{:line 10 :column 19 :end-line 10 :end-column 31 :file "haiku.clj"} middle-seven) 59 | {:line 8 :column 5 :end-line 10 :end-column 32 :file "haiku.clj"})) 60 | {:line 3 :column 1 :end-line 10 :end-column 33 :file "haiku.clj"})) 61 | 62 | (defn multiple-reader-variants-from-string [s filename] 63 | [(-> (test-reader s) 64 | (LineNumberingTextReader.) ;;; LineNumberingPushbackReader 65 | (reader-types/indexing-push-back-reader 1 filename)) 66 | (-> (test-reader s) 67 | #_(LineNumberingTextReader.) ;;; BufferedReader -- no exact equivalent 68 | (reader-types/indexing-push-back-reader 1 filename))]) 69 | 70 | (defn read-metadata-helper [reader] 71 | (let [first-form (read reader) 72 | second-form (read reader) 73 | third-form (read reader false :eof)] 74 | (is (= {:line 1 :column 1 :end-line 1 :end-column 32 :file "haiku.clj"} (meta first-form))) 75 | (compare-forms-with-meta expected-haiku-ns first-form) 76 | (compare-forms-with-meta expected-haiku-defn second-form) 77 | (is (= :eof third-form)))) 78 | 79 | (deftest read-metadata 80 | (doseq [s [test-contents 81 | (replace-newlines test-contents "\r") 82 | (replace-newlines test-contents "\r\n")] 83 | rdr (multiple-reader-variants-from-string s "haiku.clj")] 84 | (read-metadata-helper rdr))) 85 | 86 | (def expected-haiku-ns-with-source 87 | (with-meta '(^{:line 1 :column 2 :end-line 1 :end-column 4 :source "ns" :file "haiku.clj"} ns 88 | ^{:line 1 :column 5 :end-line 1 :end-column 31 :source "clojure.tools.reader.haiku" :file "haiku.clj"} clojure.tools.reader.haiku) 89 | {:line 1 :column 1 :end-line 1 :end-column 32 :source "(ns clojure.tools.reader.haiku)" :file "haiku.clj"})) 90 | 91 | (def expected-haiku-defn-with-source 92 | (with-meta (list 93 | '^{:line 3 :column 2 :end-line 3 :end-column 6 :source "defn" :file "haiku.clj"} defn 94 | '^{:line 3 :column 7 :end-line 3 :end-column 12 :source "haiku" :file "haiku.clj"} haiku 95 | "It will read the form\n but will the form metadata be\n or never become?" 96 | (with-meta ['^{:line 7 :column 6 :end-line 7 :end-column 16 :source "first-five" :file "haiku.clj"} first-five 97 | '^{:line 7 :column 17 :end-line 7 :end-column 29 :source "middle-seven" :file "haiku.clj"} middle-seven 98 | '^{:line 7 :column 30 :end-line 7 :end-column 39 :source "last-five" :file "haiku.clj"} last-five] 99 | {:line 7 :column 5 :end-line 7 :end-column 40 :source "[first-five middle-seven last-five]" :file "haiku.clj"}) 100 | (with-meta (list '^{:line 8 :column 6 :end-line 8, :end-column 7 :source "-" :file "haiku.clj"} - 101 | (with-meta (list '^{:line 8 :column 9 :end-line 8 :end-column 14 :source "apply" :file "haiku.clj"} apply 102 | '^{:line 8 :column 15 :end-line 8 :end-column 16 :source "+" :file "haiku.clj"} + 103 | ^{:last 'last-five :line 9 :column 34 :end-line 9 :end-column 41 :source "^{:last last-five} [1 2 3]" :file "haiku.clj"} 104 | [1 2 3]) 105 | {:line 8 :column 8 :end-line 9 :end-column 42 :source "(apply + 106 | ^{:last last-five} [1 2 3])" :file "haiku.clj"}) 107 | '^{:line 10 :column 8 :end-line 10 :end-column 18 :source "first-five" :file "haiku.clj"} first-five 108 | '^{:line 10 :column 19 :end-line 10 :end-column 31 :source "middle-seven" :file "haiku.clj"} middle-seven) 109 | {:line 8 :column 5 :end-line 10 :end-column 32 :source "(- (apply + 110 | ^{:last last-five} [1 2 3]) 111 | first-five middle-seven)" :file "haiku.clj"})) 112 | {:line 3 :column 1 :end-line 10 :end-column 33 :source "(defn haiku 113 | \"It will read the form 114 | but will the form metadata be 115 | or never become?\" 116 | [first-five middle-seven last-five] 117 | (- (apply + 118 | ^{:last last-five} [1 2 3]) 119 | first-five middle-seven))" :file "haiku.clj"})) 120 | 121 | (defn read-metadata-with-source-helper [rdr] 122 | (let [reader (-> rdr 123 | (LineNumberingTextReader.) ;;; LineNumberingPushbackReader. 124 | (reader-types/source-logging-push-back-reader 1 "haiku.clj")) 125 | first-form (read reader) 126 | second-form (read reader)] 127 | (is (= {:line 1 :column 1 :end-line 1 :end-column 32 :source "(ns clojure.tools.reader.haiku)" :file "haiku.clj"} (meta first-form))) 128 | (compare-forms-with-meta expected-haiku-ns-with-source first-form) 129 | (compare-forms-with-meta expected-haiku-defn-with-source second-form))) 130 | 131 | (deftest read-metadata-with-source 132 | (doseq [s [test-contents 133 | (replace-newlines test-contents "\n") ;;; "\r" -- we don't treat \r the same way they do. 134 | (replace-newlines test-contents "\r\n")]] 135 | (read-metadata-with-source-helper (test-reader s)))) 136 | 137 | 138 | (def test2-contents 139 | (str/join "\n" 140 | ["[ +42 -42 0N +042 +0x42e -0x42e -36rCRAZY -42.2e-3M 0.314e+1" 141 | " true false :kw :ns/kw 'foo/bar nil" 142 | " \\f \\u0194 \\newline \\o377 \\ud7ff " 143 | " () [7] #{8 9} '^{:meta []} bar " 144 | ;;" () [7] #{8 9} " 145 | " #inst \"2010-11-12T13:14:15.666\"" 146 | " ]"])) 147 | 148 | (def expected-vector 149 | (with-meta 150 | (vector 151 | 42 -42 0N 34 1070 -1070 -21429358 -0.0422M 3.14 152 | true false :kw :ns/kw 153 | (list 154 | 'quote 155 | (with-meta 156 | 'foo/bar 157 | {:line 2, :column 26, :end-line 2, :end-column 33, :file "vector.clj"})) 158 | nil 159 | \f \Ɣ \newline \ÿ \퟿ 160 | (with-meta 161 | '() 162 | {:line 4, :column 2, :end-line 4, :end-column 4, :file "vector.clj"}) 163 | '^{:line 4, :column 5, :end-line 4, :end-column 8, :file "vector.clj"} [7] 164 | '^{:line 4, :column 9, :end-line 4, :end-column 15, :file "vector.clj"} #{9 8} 165 | ^{:source "'^{:meta []} bar"} 166 | (list 167 | 'quote 168 | (with-meta 169 | 'bar 170 | {:meta 171 | ^{:line 4, :column 25, :end-line 4, :end-column 27, :file "vector.clj"} 172 | [], 173 | :line 4, :column 29, :end-line 4, :end-column 32, :file "vector.clj"})) 174 | (read-string "#inst \"2010-11-12T13:14:15.666-00:00\"")) 175 | {:line 1 :column 1 :end-line 6 :end-column 3 :file "vector.clj"})) 176 | 177 | (deftest read-metadata2 178 | (let [reader (-> (StringReader. test2-contents) 179 | (LineNumberingTextReader.) ;;; LineNumberingPushbackReader. 180 | (reader-types/indexing-push-back-reader 1 "vector.clj")) 181 | first-form (read reader)] 182 | (compare-forms-with-meta expected-vector first-form))) 183 | 184 | (defn test-string [n linesep] 185 | (apply str (concat ["a "] (repeat n linesep) [" b"]))) 186 | 187 | (deftest many-consecutive-lineseps 188 | ;; With older versions of tools.reader, consecutive-lineseps of 189 | ;; 10,000, linesep "\r", and one of the variants of reader, would 190 | ;; cause a StackOverflowError exception. 191 | (doseq [consecutive-lineseps [1 10 10000] 192 | linesep ["\n" "\r" "\r\n"] 193 | reader (multiple-reader-variants-from-string 194 | (test-string consecutive-lineseps linesep) "foo.clj")] 195 | (let [first-form (read reader) 196 | second-form (read reader) 197 | third-form (read reader false :eof)] 198 | (is (= {:line 1 :column 1 :end-line 1 :end-column 2 :file "foo.clj"} (meta first-form))) 199 | (is (= {:line (inc consecutive-lineseps) :column 2 200 | :end-line (inc consecutive-lineseps) :end-column 3 :file "foo.clj"} 201 | (meta second-form))) 202 | (is (= :eof third-form))))) -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Eclipse Public License - v 1.0 2 | 3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 4 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 5 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 6 | 7 | 1. DEFINITIONS 8 | 9 | "Contribution" means: 10 | 11 | a) in the case of the initial Contributor, the initial code and documentation 12 | distributed under this Agreement, and 13 | b) in the case of each subsequent Contributor: 14 | i) changes to the Program, and 15 | ii) additions to the Program; 16 | 17 | where such changes and/or additions to the Program originate from and are 18 | distributed by that particular Contributor. A Contribution 'originates' 19 | from a Contributor if it was added to the Program by such Contributor 20 | itself or anyone acting on such Contributor's behalf. Contributions do not 21 | include additions to the Program which: (i) are separate modules of 22 | software distributed in conjunction with the Program under their own 23 | license agreement, and (ii) are not derivative works of the Program. 24 | 25 | "Contributor" means any person or entity that distributes the Program. 26 | 27 | "Licensed Patents" mean patent claims licensable by a Contributor which are 28 | necessarily infringed by the use or sale of its Contribution alone or when 29 | combined with the Program. 30 | 31 | "Program" means the Contributions distributed in accordance with this 32 | Agreement. 33 | 34 | "Recipient" means anyone who receives the Program under this Agreement, 35 | including all Contributors. 36 | 37 | 2. GRANT OF RIGHTS 38 | a) Subject to the terms of this Agreement, each Contributor hereby grants 39 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 40 | reproduce, prepare derivative works of, publicly display, publicly 41 | perform, distribute and sublicense the Contribution of such Contributor, 42 | if any, and such derivative works, in source code and object code form. 43 | b) Subject to the terms of this Agreement, each Contributor hereby grants 44 | Recipient a non-exclusive, worldwide, royalty-free patent license under 45 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 46 | transfer the Contribution of such Contributor, if any, in source code and 47 | object code form. This patent license shall apply to the combination of 48 | the Contribution and the Program if, at the time the Contribution is 49 | added by the Contributor, such addition of the Contribution causes such 50 | combination to be covered by the Licensed Patents. The patent license 51 | shall not apply to any other combinations which include the Contribution. 52 | No hardware per se is licensed hereunder. 53 | c) Recipient understands that although each Contributor grants the licenses 54 | to its Contributions set forth herein, no assurances are provided by any 55 | Contributor that the Program does not infringe the patent or other 56 | intellectual property rights of any other entity. Each Contributor 57 | disclaims any liability to Recipient for claims brought by any other 58 | entity based on infringement of intellectual property rights or 59 | otherwise. As a condition to exercising the rights and licenses granted 60 | hereunder, each Recipient hereby assumes sole responsibility to secure 61 | any other intellectual property rights needed, if any. For example, if a 62 | third party patent license is required to allow Recipient to distribute 63 | the Program, it is Recipient's responsibility to acquire that license 64 | before distributing the Program. 65 | d) Each Contributor represents that to its knowledge it has sufficient 66 | copyright rights in its Contribution, if any, to grant the copyright 67 | license set forth in this Agreement. 68 | 69 | 3. REQUIREMENTS 70 | 71 | A Contributor may choose to distribute the Program in object code form under 72 | its own license agreement, provided that: 73 | 74 | a) it complies with the terms and conditions of this Agreement; and 75 | b) its license agreement: 76 | i) effectively disclaims on behalf of all Contributors all warranties 77 | and conditions, express and implied, including warranties or 78 | conditions of title and non-infringement, and implied warranties or 79 | conditions of merchantability and fitness for a particular purpose; 80 | ii) effectively excludes on behalf of all Contributors all liability for 81 | damages, including direct, indirect, special, incidental and 82 | consequential damages, such as lost profits; 83 | iii) states that any provisions which differ from this Agreement are 84 | offered by that Contributor alone and not by any other party; and 85 | iv) states that source code for the Program is available from such 86 | Contributor, and informs licensees how to obtain it in a reasonable 87 | manner on or through a medium customarily used for software exchange. 88 | 89 | When the Program is made available in source code form: 90 | 91 | a) it must be made available under this Agreement; and 92 | b) a copy of this Agreement must be included with each copy of the Program. 93 | Contributors may not remove or alter any copyright notices contained 94 | within the Program. 95 | 96 | Each Contributor must identify itself as the originator of its Contribution, 97 | if 98 | any, in a manner that reasonably allows subsequent Recipients to identify the 99 | originator of the Contribution. 100 | 101 | 4. COMMERCIAL DISTRIBUTION 102 | 103 | Commercial distributors of software may accept certain responsibilities with 104 | respect to end users, business partners and the like. While this license is 105 | intended to facilitate the commercial use of the Program, the Contributor who 106 | includes the Program in a commercial product offering should do so in a manner 107 | which does not create potential liability for other Contributors. Therefore, 108 | if a Contributor includes the Program in a commercial product offering, such 109 | Contributor ("Commercial Contributor") hereby agrees to defend and indemnify 110 | every other Contributor ("Indemnified Contributor") against any losses, 111 | damages and costs (collectively "Losses") arising from claims, lawsuits and 112 | other legal actions brought by a third party against the Indemnified 113 | Contributor to the extent caused by the acts or omissions of such Commercial 114 | Contributor in connection with its distribution of the Program in a commercial 115 | product offering. The obligations in this section do not apply to any claims 116 | or Losses relating to any actual or alleged intellectual property 117 | infringement. In order to qualify, an Indemnified Contributor must: 118 | a) promptly notify the Commercial Contributor in writing of such claim, and 119 | b) allow the Commercial Contributor to control, and cooperate with the 120 | Commercial Contributor in, the defense and any related settlement 121 | negotiations. The Indemnified Contributor may participate in any such claim at 122 | its own expense. 123 | 124 | For example, a Contributor might include the Program in a commercial product 125 | offering, Product X. That Contributor is then a Commercial Contributor. If 126 | that Commercial Contributor then makes performance claims, or offers 127 | warranties related to Product X, those performance claims and warranties are 128 | such Commercial Contributor's responsibility alone. Under this section, the 129 | Commercial Contributor would have to defend claims against the other 130 | Contributors related to those performance claims and warranties, and if a 131 | court requires any other Contributor to pay any damages as a result, the 132 | Commercial Contributor must pay those damages. 133 | 134 | 5. NO WARRANTY 135 | 136 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN 137 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR 138 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE, 139 | NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each 140 | Recipient is solely responsible for determining the appropriateness of using 141 | and distributing the Program and assumes all risks associated with its 142 | exercise of rights under this Agreement , including but not limited to the 143 | risks and costs of program errors, compliance with applicable laws, damage to 144 | or loss of data, programs or equipment, and unavailability or interruption of 145 | operations. 146 | 147 | 6. DISCLAIMER OF LIABILITY 148 | 149 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 150 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 151 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 152 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 153 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 154 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 155 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 156 | OF SUCH DAMAGES. 157 | 158 | 7. GENERAL 159 | 160 | If any provision of this Agreement is invalid or unenforceable under 161 | applicable law, it shall not affect the validity or enforceability of the 162 | remainder of the terms of this Agreement, and without further action by the 163 | parties hereto, such provision shall be reformed to the minimum extent 164 | necessary to make such provision valid and enforceable. 165 | 166 | If Recipient institutes patent litigation against any entity (including a 167 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 168 | (excluding combinations of the Program with other software or hardware) 169 | infringes such Recipient's patent(s), then such Recipient's rights granted 170 | under Section 2(b) shall terminate as of the date such litigation is filed. 171 | 172 | All Recipient's rights under this Agreement shall terminate if it fails to 173 | comply with any of the material terms or conditions of this Agreement and does 174 | not cure such failure in a reasonable period of time after becoming aware of 175 | such noncompliance. If all Recipient's rights under this Agreement terminate, 176 | Recipient agrees to cease use and distribution of the Program as soon as 177 | reasonably practicable. However, Recipient's obligations under this Agreement 178 | and any licenses granted by Recipient relating to the Program shall continue 179 | and survive. 180 | 181 | Everyone is permitted to copy and distribute copies of this Agreement, but in 182 | order to avoid inconsistency the Agreement is copyrighted and may only be 183 | modified in the following manner. The Agreement Steward reserves the right to 184 | publish new versions (including revisions) of this Agreement from time to 185 | time. No one other than the Agreement Steward has the right to modify this 186 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 187 | Eclipse Foundation may assign the responsibility to serve as the Agreement 188 | Steward to a suitable separate entity. Each new version of the Agreement will 189 | be given a distinguishing version number. The Program (including 190 | Contributions) may always be distributed subject to the version of the 191 | Agreement under which it was received. In addition, after a new version of the 192 | Agreement is published, Contributor may elect to distribute the Program 193 | (including its Contributions) under the new version. Except as expressly 194 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 195 | licenses to the intellectual property of any Contributor under this Agreement, 196 | whether expressly, by implication, estoppel or otherwise. All rights in the 197 | Program not expressly granted under this Agreement are reserved. 198 | 199 | This Agreement is governed by the laws of the State of New York and the 200 | intellectual property laws of the United States of America. No party to this 201 | Agreement will bring a legal action under this Agreement more than one year 202 | after the cause of action arose. Each party waives its rights to a jury trial in 203 | any resulting litigation. 204 | 205 | -------------------------------------------------------------------------------- /epl.html: -------------------------------------------------------------------------------- 1 | Eclipse Public License - v 1.0 2 | 3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 4 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 5 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 6 | 7 | 1. DEFINITIONS 8 | 9 | "Contribution" means: 10 | 11 | a) in the case of the initial Contributor, the initial code and documentation 12 | distributed under this Agreement, and 13 | b) in the case of each subsequent Contributor: 14 | i) changes to the Program, and 15 | ii) additions to the Program; 16 | 17 | where such changes and/or additions to the Program originate from and are 18 | distributed by that particular Contributor. A Contribution 'originates' 19 | from a Contributor if it was added to the Program by such Contributor 20 | itself or anyone acting on such Contributor's behalf. Contributions do not 21 | include additions to the Program which: (i) are separate modules of 22 | software distributed in conjunction with the Program under their own 23 | license agreement, and (ii) are not derivative works of the Program. 24 | 25 | "Contributor" means any person or entity that distributes the Program. 26 | 27 | "Licensed Patents" mean patent claims licensable by a Contributor which are 28 | necessarily infringed by the use or sale of its Contribution alone or when 29 | combined with the Program. 30 | 31 | "Program" means the Contributions distributed in accordance with this 32 | Agreement. 33 | 34 | "Recipient" means anyone who receives the Program under this Agreement, 35 | including all Contributors. 36 | 37 | 2. GRANT OF RIGHTS 38 | a) Subject to the terms of this Agreement, each Contributor hereby grants 39 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 40 | reproduce, prepare derivative works of, publicly display, publicly 41 | perform, distribute and sublicense the Contribution of such Contributor, 42 | if any, and such derivative works, in source code and object code form. 43 | b) Subject to the terms of this Agreement, each Contributor hereby grants 44 | Recipient a non-exclusive, worldwide, royalty-free patent license under 45 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 46 | transfer the Contribution of such Contributor, if any, in source code and 47 | object code form. This patent license shall apply to the combination of 48 | the Contribution and the Program if, at the time the Contribution is 49 | added by the Contributor, such addition of the Contribution causes such 50 | combination to be covered by the Licensed Patents. The patent license 51 | shall not apply to any other combinations which include the Contribution. 52 | No hardware per se is licensed hereunder. 53 | c) Recipient understands that although each Contributor grants the licenses 54 | to its Contributions set forth herein, no assurances are provided by any 55 | Contributor that the Program does not infringe the patent or other 56 | intellectual property rights of any other entity. Each Contributor 57 | disclaims any liability to Recipient for claims brought by any other 58 | entity based on infringement of intellectual property rights or 59 | otherwise. As a condition to exercising the rights and licenses granted 60 | hereunder, each Recipient hereby assumes sole responsibility to secure 61 | any other intellectual property rights needed, if any. For example, if a 62 | third party patent license is required to allow Recipient to distribute 63 | the Program, it is Recipient's responsibility to acquire that license 64 | before distributing the Program. 65 | d) Each Contributor represents that to its knowledge it has sufficient 66 | copyright rights in its Contribution, if any, to grant the copyright 67 | license set forth in this Agreement. 68 | 69 | 3. REQUIREMENTS 70 | 71 | A Contributor may choose to distribute the Program in object code form under 72 | its own license agreement, provided that: 73 | 74 | a) it complies with the terms and conditions of this Agreement; and 75 | b) its license agreement: 76 | i) effectively disclaims on behalf of all Contributors all warranties 77 | and conditions, express and implied, including warranties or 78 | conditions of title and non-infringement, and implied warranties or 79 | conditions of merchantability and fitness for a particular purpose; 80 | ii) effectively excludes on behalf of all Contributors all liability for 81 | damages, including direct, indirect, special, incidental and 82 | consequential damages, such as lost profits; 83 | iii) states that any provisions which differ from this Agreement are 84 | offered by that Contributor alone and not by any other party; and 85 | iv) states that source code for the Program is available from such 86 | Contributor, and informs licensees how to obtain it in a reasonable 87 | manner on or through a medium customarily used for software exchange. 88 | 89 | When the Program is made available in source code form: 90 | 91 | a) it must be made available under this Agreement; and 92 | b) a copy of this Agreement must be included with each copy of the Program. 93 | Contributors may not remove or alter any copyright notices contained 94 | within the Program. 95 | 96 | Each Contributor must identify itself as the originator of its Contribution, 97 | if 98 | any, in a manner that reasonably allows subsequent Recipients to identify the 99 | originator of the Contribution. 100 | 101 | 4. COMMERCIAL DISTRIBUTION 102 | 103 | Commercial distributors of software may accept certain responsibilities with 104 | respect to end users, business partners and the like. While this license is 105 | intended to facilitate the commercial use of the Program, the Contributor who 106 | includes the Program in a commercial product offering should do so in a manner 107 | which does not create potential liability for other Contributors. Therefore, 108 | if a Contributor includes the Program in a commercial product offering, such 109 | Contributor ("Commercial Contributor") hereby agrees to defend and indemnify 110 | every other Contributor ("Indemnified Contributor") against any losses, 111 | damages and costs (collectively "Losses") arising from claims, lawsuits and 112 | other legal actions brought by a third party against the Indemnified 113 | Contributor to the extent caused by the acts or omissions of such Commercial 114 | Contributor in connection with its distribution of the Program in a commercial 115 | product offering. The obligations in this section do not apply to any claims 116 | or Losses relating to any actual or alleged intellectual property 117 | infringement. In order to qualify, an Indemnified Contributor must: 118 | a) promptly notify the Commercial Contributor in writing of such claim, and 119 | b) allow the Commercial Contributor to control, and cooperate with the 120 | Commercial Contributor in, the defense and any related settlement 121 | negotiations. The Indemnified Contributor may participate in any such claim at 122 | its own expense. 123 | 124 | For example, a Contributor might include the Program in a commercial product 125 | offering, Product X. That Contributor is then a Commercial Contributor. If 126 | that Commercial Contributor then makes performance claims, or offers 127 | warranties related to Product X, those performance claims and warranties are 128 | such Commercial Contributor's responsibility alone. Under this section, the 129 | Commercial Contributor would have to defend claims against the other 130 | Contributors related to those performance claims and warranties, and if a 131 | court requires any other Contributor to pay any damages as a result, the 132 | Commercial Contributor must pay those damages. 133 | 134 | 5. NO WARRANTY 135 | 136 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN 137 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR 138 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE, 139 | NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each 140 | Recipient is solely responsible for determining the appropriateness of using 141 | and distributing the Program and assumes all risks associated with its 142 | exercise of rights under this Agreement , including but not limited to the 143 | risks and costs of program errors, compliance with applicable laws, damage to 144 | or loss of data, programs or equipment, and unavailability or interruption of 145 | operations. 146 | 147 | 6. DISCLAIMER OF LIABILITY 148 | 149 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 150 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 151 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 152 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 153 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 154 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 155 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 156 | OF SUCH DAMAGES. 157 | 158 | 7. GENERAL 159 | 160 | If any provision of this Agreement is invalid or unenforceable under 161 | applicable law, it shall not affect the validity or enforceability of the 162 | remainder of the terms of this Agreement, and without further action by the 163 | parties hereto, such provision shall be reformed to the minimum extent 164 | necessary to make such provision valid and enforceable. 165 | 166 | If Recipient institutes patent litigation against any entity (including a 167 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 168 | (excluding combinations of the Program with other software or hardware) 169 | infringes such Recipient's patent(s), then such Recipient's rights granted 170 | under Section 2(b) shall terminate as of the date such litigation is filed. 171 | 172 | All Recipient's rights under this Agreement shall terminate if it fails to 173 | comply with any of the material terms or conditions of this Agreement and does 174 | not cure such failure in a reasonable period of time after becoming aware of 175 | such noncompliance. If all Recipient's rights under this Agreement terminate, 176 | Recipient agrees to cease use and distribution of the Program as soon as 177 | reasonably practicable. However, Recipient's obligations under this Agreement 178 | and any licenses granted by Recipient relating to the Program shall continue 179 | and survive. 180 | 181 | Everyone is permitted to copy and distribute copies of this Agreement, but in 182 | order to avoid inconsistency the Agreement is copyrighted and may only be 183 | modified in the following manner. The Agreement Steward reserves the right to 184 | publish new versions (including revisions) of this Agreement from time to 185 | time. No one other than the Agreement Steward has the right to modify this 186 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 187 | Eclipse Foundation may assign the responsibility to serve as the Agreement 188 | Steward to a suitable separate entity. Each new version of the Agreement will 189 | be given a distinguishing version number. The Program (including 190 | Contributions) may always be distributed subject to the version of the 191 | Agreement under which it was received. In addition, after a new version of the 192 | Agreement is published, Contributor may elect to distribute the Program 193 | (including its Contributions) under the new version. Except as expressly 194 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 195 | licenses to the intellectual property of any Contributor under this Agreement, 196 | whether expressly, by implication, estoppel or otherwise. All rights in the 197 | Program not expressly granted under this Agreement are reserved. 198 | 199 | This Agreement is governed by the laws of the State of New York and the 200 | intellectual property laws of the United States of America. No party to this 201 | Agreement will bring a legal action under this Agreement more than one year 202 | after the cause of action arose. Each party waives its rights to a jury trial in 203 | any resulting litigation. 204 | 205 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/tools/reader_test.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.tools.reader-test 2 | (:refer-clojure :exclude [read read-string *default-data-reader-fn* *data-readers*]) 3 | (:use [clojure.tools.reader :only [read read-string *default-data-reader-fn* *data-readers*]] 4 | [clojure.tools.reader.reader-types :only [string-push-back-reader 5 | indexing-push-back-reader]] 6 | [clojure.test :only [deftest is are testing]] 7 | [clojure.tools.reader.impl.utils :exclude [char]]) 8 | (:require [clojure.tools.reader.edn :as tre]) 9 | (:import clojure.lang.BigInt 10 | (System.IO StringReader) ;;; (java.io StringReader BufferedReader) 11 | clojure.lang.LineNumberingTextReader)) ;;; LineNumberingPushbackReader 12 | 13 | (load "common_tests") 14 | 15 | (deftest read-keyword 16 | (is (= :foo-bar (read-string ":foo-bar"))) 17 | (is (= :foo/bar (read-string ":foo/bar"))) 18 | (is (= :user/foo-bar (binding [*ns* (the-ns 'user)] 19 | (read-string "::foo-bar")))) 20 | (is (= :clojure.core/foo-bar 21 | (do (alias 'core 'clojure.core) 22 | (read-string "::core/foo-bar")))) 23 | (is (= :*+!-_? (read-string ":*+!-_?"))) 24 | (is (= :abc:def:ghi (read-string ":abc:def:ghi"))) 25 | (is (= :abc.def/ghi (read-string ":abc.def/ghi"))) 26 | (is (= :abc/def.ghi (read-string ":abc/def.ghi"))) 27 | (is (= :abc:def/ghi:jkl.mno (read-string ":abc:def/ghi:jkl.mno"))) 28 | (is (instance? clojure.lang.Keyword (read-string ":alphabet"))) ) 29 | 30 | (deftest read-regex 31 | (is (= (str #"\[\]?(\")\\") 32 | (str (read-string "#\"\\[\\]?(\\\")\\\\\""))))) 33 | 34 | (deftest read-quote 35 | (is (= ''foo (read-string "'foo")))) 36 | 37 | (deftest read-syntax-quote 38 | (is (= '`user/foo (binding [*ns* (the-ns 'user)] 39 | (read-string "`foo")))) 40 | (is (= () (eval (read-string "`(~@[])")))) 41 | (is (= '`+ (read-string "`+"))) 42 | (is (= '`foo/bar (read-string "`foo/bar"))) 43 | (is (= '`1 (read-string "`1"))) 44 | (is (= `(1 (~2 ~@'(3))) (eval (read-string "`(1 (~2 ~@'(3)))"))))) 45 | 46 | (deftest read-deref 47 | (is (= '@foo (read-string "@foo")))) 48 | 49 | (deftest read-var 50 | (is (= '(var foo) (read-string "#'foo")))) 51 | 52 | (deftest read-fn 53 | (is (= '(fn* [] (foo bar baz)) (read-string "#(foo bar baz)")))) 54 | 55 | (deftest read-arg 56 | (is (= 14 ((eval (read-string "#(apply + % %1 %3 %&)")) 1 2 3 4 5))) 57 | (is (= 4 ((eval (read-string "#(last %&)")) 1 2 3 4)))) 58 | 59 | (deftest read-eval 60 | (is (= 3 (read-string "#=(+ 1 2)")))) 61 | 62 | (deftest read-tagged 63 | ;; (is (= #inst "2010-11-12T13:14:15.666" 64 | ;; (read-string "#inst \"2010-11-12T13:14:15.666\""))) 65 | ;; (is (= #inst "2010-11-12T13:14:15.666" 66 | ;; (read-string "#inst\"2010-11-12T13:14:15.666\""))) 67 | ;; (is (= #uuid "550e8400-e29b-41d4-a716-446655440000" 68 | ;; (read-string "#uuid \"550e8400-e29b-41d4-a716-446655440000\""))) 69 | ;; (is (= #uuid "550e8400-e29b-41d4-a716-446655440000" 70 | ;; (read-string "#uuid\"550e8400-e29b-41d4-a716-446655440000\""))) 71 | (is (= (System.Guid. "550e8400-e29b-41d4-a716-446655440000") ;;; java.util.UUID/fromString 72 | (read-string "#uuid \"550e8400-e29b-41d4-a716-446655440000\""))) 73 | (is (= (System.Guid. "550e8400-e29b-41d4-a716-446655440000") ;;; java.util.UUID/fromString 74 | (read-string "#uuid\"550e8400-e29b-41d4-a716-446655440000\""))) 75 | (when *default-data-reader-fn* 76 | (let [my-unknown (fn [tag val] {:unknown-tag tag :value val})] 77 | (is (= {:unknown-tag 'foo :value 'bar} 78 | (binding [*default-data-reader-fn* my-unknown] 79 | (read-string "#foo bar"))))))) 80 | 81 | (defrecord foo []) 82 | (defrecord bar [baz buz]) 83 | 84 | (deftest read-record 85 | (is (= (foo.) (read-string "#clojure.tools.reader_test.foo[]"))) 86 | (is (= (foo.) (read-string "#clojure.tools.reader_test.foo []"))) ;; not valid in clojure 87 | (is (= (foo.) (read-string "#clojure.tools.reader_test.foo{}"))) 88 | (is (= (assoc (foo.) :foo 'bar) (read-string "#clojure.tools.reader_test.foo{:foo bar}"))) 89 | 90 | (is (= (map->bar {}) (read-string "#clojure.tools.reader_test.bar{}"))) 91 | (is (= (bar. 1 nil) (read-string "#clojure.tools.reader_test.bar{:baz 1}"))) 92 | (is (= (bar. 1 nil) (read-string "#clojure.tools.reader_test.bar[1 nil]"))) 93 | (is (= (bar. 1 2) (read-string "#clojure.tools.reader_test.bar[1 2]")))) 94 | 95 | (deftest read-ctor 96 | (is (= "CCC" (read-string "#System.String[\\C 3]")))) ;;; java.lang.String "foo" \"foo\" added int arg 97 | 98 | (defrecord JSValue [v]) 99 | 100 | (deftest reader-conditionals 101 | (let [opts {:read-cond :allow :features #{:cljr}}] 102 | (are [out s opts] (= out (read-string opts s)) 103 | ;; basic read-cond 104 | '[foo-form] "[#?(:foo foo-form :bar bar-form)]" {:read-cond :allow :features #{:foo}} 105 | '[bar-form] "[#?(:foo foo-form :bar bar-form)]" {:read-cond :allow :features #{:bar}} 106 | '[foo-form] "[#?(:foo foo-form :bar bar-form)]" {:read-cond :allow :features #{:foo :bar}} 107 | '[] "[#?(:foo foo-form :bar bar-form)]" {:read-cond :allow :features #{:baz}} 108 | 'nil "#?(:default nil)" opts 109 | 110 | ;; environmental features 111 | "clojure" "#?(:cljr \"clojure\" :cljs \"clojurescript\" :default \"default\")" opts 112 | 113 | ;; default features 114 | "default" "#?(:clj \"clr\" :cljs \"cljs\" :default \"default\")" opts ;;; :cljr => :clj -- because we need to trigger default 115 | 116 | ;; splicing 117 | [] "[#?@(:cljr [])]" opts ;;; :clj 118 | [:a] "[#?@(:cljr [:a])]" opts ;;; :clj 119 | [:a :b] "[#?@(:cljr [:a :b])]" opts ;;; :clj 120 | [:a :b :c] "[#?@(:cljr [:a :b :c])]" opts ;;; :clj 121 | 122 | ;; nested splicing 123 | [:a :b :c :d :e] "[#?@(:cljr [:a #?@(:cljr [:b #?@(:cljr [:c]) :d]):e])]" opts ;;; :clj 124 | '(+ 1 (+ 2 3)) "(+ #?@(:cljr [1 (+ #?@(:cljr [2 3]))]))" opts ;;; :clj 125 | '(+ (+ 2 3) 1) "(+ #?@(:cljr [(+ #?@(:cljr [2 3])) 1]))" opts ;;; :clj 126 | [:a [:b [:c] :d] :e] "[#?@(:cljr [:a [#?@(:cljr [:b #?@(:cljr [[:c]]) :d])] :e])]" opts ;;; :clj 127 | 128 | ;; bypass unknown tagged literals 129 | [1 2 3] "#?(:cljs #js [1 2 3] :cljr [1 2 3])" opts ;;; :clj 130 | :clojure "#?(:foo #some.nonexistent.Record {:x 1} :cljr :clojure)" opts) ;;; :clj 131 | 132 | (are [re s opts] (is (thrown-with-msg? Exception re (read-string opts s))) ;;; RuntimeException 133 | #"Features must be keywords" "#?((+ 1 2) :a)" opts 134 | #"even number of forms" "#?(:cljs :a :cljr)" opts ;;; :clj 135 | #"read-cond-splicing must implement" "(#?@(:cljr :a))" opts ;;; :clj 136 | #"is reserved" "(#?@(:foo :a :else :b))" opts 137 | #"must be a list" "#?[:foo :a :else :b]" opts 138 | #"Conditional read not allowed" "#?[:cljr :a :default nil]" {:read-cond :BOGUS} ;;; :clj 139 | #"Conditional read not allowed" "#?[:cljr :a :default nil]" {})) ;;; :clj 140 | (binding [*data-readers* {'js (fn [v] (JSValue. v) )}] 141 | (is (= (JSValue. [1 2 3]) 142 | (read-string {:features #{:cljs} :read-cond :allow} "#?(:cljs #js [1 2 3] :foo #foo [1])"))))) 143 | 144 | (deftest preserve-read-cond 145 | (is (= 1 (binding [*data-readers* {'foo (constantly 1)}] 146 | (read-string {:read-cond :preserve} "#foo []")))) 147 | 148 | (let [x (read-string {:read-cond :preserve} "#?(:clj foo :cljs bar)")] 149 | (is (reader-conditional? x)) 150 | (is (= x (reader-conditional '(:clj foo :cljs bar) false))) 151 | (is (not (:splicing? x))) 152 | (is (= :foo (get x :no-such-key :foo))) 153 | (is (= (:form x) '(:clj foo :cljs bar)))) 154 | (let [x (first (read-string {:read-cond :preserve} "(#?@(:clj [foo]))"))] 155 | (is (reader-conditional? x)) 156 | (is (= x (reader-conditional '(:clj [foo]) true))) 157 | (is (:splicing? x)) 158 | (is (= :foo (get x :no-such-key :foo))) 159 | (is (= (:form x) '(:clj [foo])))) 160 | (is (thrown-with-msg? Exception #"No reader function for tag" ;;; RuntimeException 161 | (read-string {:read-cond :preserve} "#js {:x 1 :y 2}" ))) 162 | (let [x (read-string {:read-cond :preserve} "#?(:cljs #js {:x 1 :y 2})") 163 | [platform tl] (:form x)] 164 | (is (reader-conditional? x)) 165 | (is (tagged-literal? tl)) 166 | (is (= tl (tagged-literal 'js {:x 1 :y 2}))) 167 | (is (= 'js (:tag tl))) 168 | (is (= {:x 1 :y 2} (:form tl))) 169 | (is (= :foo (get tl :no-such-key :foo)))) 170 | (testing "print form roundtrips" 171 | (doseq [s ["#?(:clj foo :cljs bar)" 172 | "#?(:cljs #js {:x 1, :y 2})" 173 | "#?(:clj #clojure.test_clojure.reader.TestRecord [42 85])"]] 174 | (is (= s (pr-str (read-string {:read-cond :preserve} s))))))) 175 | 176 | (alias 'c.c 'clojure.core) 177 | 178 | (deftest read-namespaced-map 179 | (binding [*ns* (the-ns 'clojure.tools.reader-test)] 180 | (is (= {::foo 1} (read-string "#::{:foo 1}"))) 181 | (is (= {::foo 1 :bar 2} (read-string "#::{:foo 1 :_/bar 2}"))) 182 | (is (= {:a/foo 1 :bar 2} (read-string "#:a{:foo 1 :_/bar 2}"))) 183 | (is (= {:clojure.core/foo 2} (read-string "#::c.c{:foo 2}"))))) 184 | 185 | 186 | (defn multiple-reader-variants-from-string [s filename] 187 | [(-> (StringReader. s) 188 | (LineNumberingTextReader.) ;;; LineNumberingPushbackReader 189 | (indexing-push-back-reader 1 filename)) 190 | (-> (StringReader. s) 191 | ;;; (BufferedReader.) -- no equivalent 192 | (indexing-push-back-reader 1 filename))]) 193 | 194 | (defn first-reads-from-multiple-readers [s] 195 | (for [rdr (multiple-reader-variants-from-string s "file.edn")] 196 | (tre/read rdr))) 197 | 198 | (deftest trdr-54 199 | (let [read-vals (mapcat first-reads-from-multiple-readers 200 | ["[a\rb]" "[a\r b]" "[a \rb]"])] 201 | (doseq [pairs (partition 2 1 read-vals)] 202 | (is (= (first pairs) (second pairs)))))) 203 | 204 | (deftest read-symbol 205 | (is (= 'foo (read-string "foo"))) 206 | (is (= 'foo/bar (read-string "foo/bar"))) 207 | (is (= '*+!-_? (read-string "*+!-_?"))) 208 | (is (= 'abc:def:ghi (read-string "abc:def:ghi"))) 209 | (is (= 'abc.def/ghi (read-string "abc.def/ghi"))) 210 | (is (= 'abc/def.ghi (read-string "abc/def.ghi"))) 211 | (is (= 'abc:def/ghi:jkl.mno (read-string "abc:def/ghi:jkl.mno"))) 212 | (is (instance? clojure.lang.Symbol (read-string "alphabet"))) 213 | (is (= "foo//" (str (read-string "foo//")))) 214 | (is (Double/IsNaN ^double (read-string "##NaN"))) ;;; java.lang.Double/isNaN 215 | (is (Double/IsInfinity ^double (read-string "##Inf"))) ;;; java.lang.Double/isInfinite 216 | (is (Double/IsInfinity ^double (read-string "##-Inf"))) ;;; java.lang.Double/isInfinite 217 | (testing "Correct array class symbols" 218 | (doseq [n (range 1 10) 219 | :let [sym (str "String/" n) 220 | qsym (str "System.String/" n)]] ;;; "java.lang.String/" 221 | (let [rsym (read-string sym) 222 | rqsym (read-string qsym)] 223 | (is (= ((juxt namespace name) rsym) 224 | ["String" (str n)])) 225 | (is (= ((juxt namespace name) rqsym) 226 | ["System.String" (str n)]))))) ;;; "java.lang.String" 227 | (testing "Correct prim array symbols" 228 | (doseq [prim ["int" "long" "boolean" "byte" "char" "double" "float" "short"]] 229 | (doseq [n (range 1 10) 230 | :let [sym (str prim "/" n)]] 231 | (let [rsym (read-string sym)] 232 | (is (= ((juxt namespace name) rsym) 233 | [prim (str n)])))))) 234 | (testing "Incorrect Array class symbols" 235 | (doseq [suffix ["" "0" "11" "1a"] 236 | :let [sym (str "String/" suffix)]] 237 | (is (thrown? clojure.lang.ExceptionInfo (read-string sym)) sym)))) -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/reader/default_data_readers.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | ;;; copied from clojure.instant and clojure.uuid ;;; 10 | 11 | (ns ^:skip-wiki clojure.tools.reader.default-data-readers 12 | ;;;(:import [java.util Calendar Date GregorianCalendar TimeZone] ;;; Do we want to do 13 | );;; [java.sql Timestamp])) ;;; Do we want to do [System.DataSqlTypes SqlDateTime] 14 | 15 | ;;; clojure.instant ;;; 16 | 17 | (set! *warn-on-reflection* true) 18 | 19 | ;;; ------------------------------------------------------------------------ 20 | ;;; convenience macros 21 | 22 | (defmacro ^:private fail 23 | [msg] 24 | `(throw (Exception. ~msg))) ;;; RuntimeException. 25 | 26 | (defmacro ^:private verify 27 | ([test msg] `(when-not ~test (fail ~msg))) 28 | ([test] `(verify ~test ~(str "failed: " (pr-str test))))) 29 | 30 | (defn- divisible? 31 | [num div] 32 | (zero? (mod num div))) 33 | 34 | (defn- indivisible? 35 | [num div] 36 | (not (divisible? num div))) 37 | 38 | 39 | ;;; ------------------------------------------------------------------------ 40 | ;;; parser implementation 41 | 42 | (defn- parse-int [^String s] 43 | (if (String/IsNullOrEmpty s) 0 (Int64/Parse s))) ;;; (Long/parseLong s)) 44 | 45 | (defn- zero-fill-right [^String s width] 46 | (cond (= width (count s)) s 47 | (< width (count s)) (.Substring s 0 width) ;;; .substring 48 | :else (loop [b (StringBuilder. s)] 49 | (if (< (.Length b) width) ;;; .length 50 | (recur (.Append b \0)) ;;; .append 51 | (.ToString b))))) ;;; .toString 52 | 53 | (def parse-timestamp 54 | "Parse a string containing an RFC3339-like like timestamp. 55 | 56 | The function new-instant is called with the following arguments. 57 | 58 | min max default 59 | --- ------------ ------- 60 | years 0 9999 N/A (s must provide years) 61 | months 1 12 1 62 | days 1 31 1 (actual max days depends 63 | hours 0 23 0 on month and year) 64 | minutes 0 59 0 65 | seconds 0 60 0 (though 60 is only valid 66 | nanoseconds 0 999999999 0 when minutes is 59) 67 | offset-sign -1 1 0 68 | offset-hours 0 23 0 69 | offset-minutes 0 59 0 70 | 71 | These are all integers and will be non-nil. (The listed defaults 72 | will be passed if the corresponding field is not present in s.) 73 | 74 | Grammar (of s): 75 | 76 | date-fullyear = 4DIGIT 77 | date-month = 2DIGIT ; 01-12 78 | date-mday = 2DIGIT ; 01-28, 01-29, 01-30, 01-31 based on 79 | ; month/year 80 | time-hour = 2DIGIT ; 00-23 81 | time-minute = 2DIGIT ; 00-59 82 | time-second = 2DIGIT ; 00-58, 00-59, 00-60 based on leap second 83 | ; rules 84 | time-secfrac = '.' 1*DIGIT 85 | time-numoffset = ('+' / '-') time-hour ':' time-minute 86 | time-offset = 'Z' / time-numoffset 87 | 88 | time-part = time-hour [ ':' time-minute [ ':' time-second 89 | [time-secfrac] [time-offset] ] ] 90 | 91 | timestamp = date-year [ '-' date-month [ '-' date-mday 92 | [ 'T' time-part ] ] ] 93 | 94 | Unlike RFC3339: 95 | 96 | - we only parse the timestamp format 97 | - timestamp can elide trailing components 98 | - time-offset is optional (defaults to +00:00) 99 | 100 | Though time-offset is syntactically optional, a missing time-offset 101 | will be treated as if the time-offset zero (+00:00) had been 102 | specified. 103 | " 104 | (let [timestamp #"(\d\d\d\d)(?:-(\d\d)(?:-(\d\d)(?:[T](\d\d)(?::(\d\d)(?::(\d\d)(?:[.](\d+))?)?)?)?)?)?(?:[Z]|([-+])(\d\d):(\d\d))?"] 105 | 106 | (fn [new-instant ^String cs] ;;; ^CharSequence 107 | (if-let [[_ years months days hours minutes seconds fraction 108 | offset-sign offset-hours offset-minutes] 109 | (re-matches timestamp cs)] 110 | (new-instant 111 | (parse-int years) 112 | (if-not months 1 (parse-int months)) 113 | (if-not days 1 (parse-int days)) 114 | (if-not hours 0 (parse-int hours)) 115 | (if-not minutes 0 (parse-int minutes)) 116 | (if-not seconds 0 (parse-int seconds)) 117 | (if-not fraction 0 (parse-int (zero-fill-right fraction 9))) 118 | (cond (= "-" offset-sign) -1 119 | (= "+" offset-sign) 1 120 | :else 0) 121 | (if-not offset-hours 0 (parse-int offset-hours)) 122 | (if-not offset-minutes 0 (parse-int offset-minutes))) 123 | (fail (str "Unrecognized date/time syntax: " cs)))))) 124 | 125 | 126 | ;;; ------------------------------------------------------------------------ 127 | ;;; Verification of Extra-Grammatical Restrictions from RFC3339 128 | 129 | (defn- leap-year? 130 | [year] 131 | (and (divisible? year 4) 132 | (or (indivisible? year 100) 133 | (divisible? year 400)))) 134 | 135 | (def ^:private days-in-month 136 | (let [dim-norm [nil 31 28 31 30 31 30 31 31 30 31 30 31] 137 | dim-leap [nil 31 29 31 30 31 30 31 31 30 31 30 31]] 138 | (fn [month leap-year?] 139 | ((if leap-year? dim-leap dim-norm) month)))) 140 | 141 | (defn validated 142 | "Return a function which constructs and instant by calling constructor 143 | after first validating that those arguments are in range and otherwise 144 | plausible. The resulting function will throw an exception if called 145 | with invalid arguments." 146 | [new-instance] 147 | (fn [years months days hours minutes seconds nanoseconds 148 | offset-sign offset-hours offset-minutes] 149 | (verify (<= 1 months 12)) 150 | (verify (<= 1 days (days-in-month months (leap-year? years)))) 151 | (verify (<= 0 hours 23)) 152 | (verify (<= 0 minutes 59)) 153 | (verify (<= 0 seconds (if (= minutes 59) 60 59))) 154 | (verify (<= 0 nanoseconds 999999999)) 155 | (verify (<= -1 offset-sign 1)) 156 | (verify (<= 0 offset-hours 23)) 157 | (verify (<= 0 offset-minutes 59)) 158 | (new-instance years months days hours minutes seconds nanoseconds 159 | offset-sign offset-hours offset-minutes))) 160 | 161 | 162 | ;;; ------------------------------------------------------------------------ 163 | ;;; print integration 164 | 165 | ;;;(def ^:private ^ThreadLocal thread-local-utc-date-format 166 | ;;; ;; SimpleDateFormat is not thread-safe, so we use a ThreadLocal proxy for access. 167 | ;;; ;; http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=4228335 168 | ;;; (proxy [ThreadLocal] [] 169 | ;;; (initialValue [] 170 | ;;; (doto (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS-00:00") 171 | ;;; ;; RFC3339 says to use -00:00 when the timezone is unknown (+00:00 implies a known GMT) 172 | ;;; (.setTimeZone (java.util.TimeZone/getTimeZone "GMT")))))) 173 | 174 | (defn- print-datetime ;;; print-date 175 | "Print a System.DateTime as RFC3339 timestamp, always in UTC." ;;; java.util.Date 176 | [ ^System.DateTime d, ^System.IO.TextWriter w] ;;; ^java.util.Date ^java.io.Writer 177 | (let [utc-format "yyyy-MM-ddTHH:mm:ss.fff-00:00"] ;;; ^java.text.DateFormat utc-format (.get thread-local-utc-date-format) 178 | (.Write w "#inst \"") ;;; .write 179 | (.Write w (.ToString d utc-format )) ;;; (.write w (.format utc-format d)) 180 | (.Write w "\""))) ;;; .write 181 | 182 | ;;; DM Added 183 | (defn- print-datetimeoffset 184 | "Print a System.DateTimeOffset as RFC3339 timestamp, always in UTC." 185 | [ ^System.DateTimeOffset d, ^System.IO.TextWriter w] 186 | (let [utc-format "yyyy-MM-ddTHH:mm:ss.fffzzzz"] 187 | (.Write w "#inst \"") 188 | (.Write w (.ToString d utc-format )) 189 | (.Write w "\""))) 190 | ;;; 191 | 192 | (defmethod print-method System.DateTime ;;; java.util.Date 193 | [^System.DateTime d, ^System.IO.TextWriter w] ;;; ^java.util.Date ^java.io.Writer 194 | (print-datetime d w)) ;;; print-date 195 | 196 | (defmethod print-dup System.DateTime ;;; java.util.Date 197 | [^System.DateTime d, ^System.IO.TextWriter w] ;;; ^java.util.Date ^java.io.Writer 198 | (print-datetime d w)) ;;; print-date 199 | 200 | ;;;(defn- print-calendar 201 | ;;; "Print a java.util.Calendar as RFC3339 timestamp, preserving timezone." 202 | ;;; [^java.util.Calendar c, ^java.io.Writer w] 203 | ;;; (let [calstr (format "%1$tFT%1$tT.%1$tL%1$tz" c) 204 | ;;; offset-minutes (- (.length calstr) 2)] 205 | ;;; ;; calstr is almost right, but is missing the colon in the offset 206 | ;;; (.write w "#inst \"") 207 | ;;; (.write w calstr 0 offset-minutes) 208 | ;;; (.write w ":") 209 | ;;; (.write w calstr offset-minutes 2) 210 | ;;; (.write w "\""))) 211 | 212 | (defmethod print-method System.DateTimeOffset ;;; java.util.Calendar 213 | [^System.DateTimeOffset d, ^System.IO.TextWriter w] ;;; ^java.util.Calendar ^java.io.Writer 214 | (print-datetimeoffset d w)) ;;; print-date 215 | 216 | (defmethod print-dup System.DateTimeOffset ;;; java.util.Calendar 217 | [^System.DateTimeOffset d, ^System.IO.TextWriter w] ;;; ^java.util.Calendar ^java.io.Writer 218 | (print-datetimeoffset d w)) ;;; print-date 219 | 220 | ;;;(def ^:private ^ThreadLocal thread-local-utc-timestamp-format 221 | ;;; ;; SimpleDateFormat is not thread-safe, so we use a ThreadLocal proxy for access. 222 | ;;; ;; http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=4228335 223 | ;;; (proxy [ThreadLocal] [] 224 | ;;; (initialValue [] 225 | ;;; (doto (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss") 226 | ;;; (.setTimeZone (java.util.TimeZone/getTimeZone "GMT")))))) 227 | 228 | ;;;(defn- print-timestamp 229 | ;;; "Print a java.sql.Timestamp as RFC3339 timestamp, always in UTC." 230 | ;;; [^java.sql.Timestamp ts, ^java.io.Writer w] 231 | ;;; (let [^java.text.DateFormat utc-format (.get thread-local-utc-timestamp-format)] 232 | ;;; (.write w "#inst \"") 233 | ;;; (.write w (.format utc-format ts)) 234 | ;;; ;; add on nanos and offset 235 | ;;; ;; RFC3339 says to use -00:00 when the timezone is unknown (+00:00 implies a known GMT) 236 | ;;; (.write w (format ".%09d-00:00" (.getNanos ts))) 237 | ;;; (.write w "\""))) 238 | 239 | ;;;(defmethod print-method java.sql.Timestamp 240 | ;;; [^java.sql.Timestamp ts, ^java.io.Writer w] 241 | ;;; (print-timestamp ts w)) 242 | 243 | ;;;(defmethod print-dup java.sql.Timestamp 244 | ;;; [^java.sql.Timestamp ts, ^java.io.Writer w] 245 | ;;; (print-timestamp ts w)) 246 | 247 | 248 | ;;; ------------------------------------------------------------------------ 249 | ;;; reader integration 250 | 251 | ;;;(defn- construct-calendar 252 | ;;; "Construct a java.util.Calendar, preserving the timezone 253 | ;;;offset, but truncating the subsecond fraction to milliseconds." 254 | ;;; ^GregorianCalendar 255 | ;;; [years months days hours minutes seconds nanoseconds 256 | ;;; offset-sign offset-hours offset-minutes] 257 | ;;; (doto (GregorianCalendar. years (dec months) days hours minutes seconds) 258 | ;;; (.set Calendar/MILLISECOND (/ nanoseconds 1000000)) 259 | ;;; (.setTimeZone (TimeZone/getTimeZone 260 | ;;; (format "GMT%s%02d:%02d" 261 | ;;; (if (neg? offset-sign) "-" "+") 262 | ;;; offset-hours offset-minutes))))) 263 | 264 | ;;; DM: Added 265 | (defn- construct-datetimeoffset 266 | "Construct a System.DateTimeOffset, preserving the timezone offset 267 | but truncating the subsecond fraction to milliseconds." 268 | ^DateTimeOffset 269 | [years months days hours minutes seconds nanoseconds 270 | offset-sign offset-hours offset-minutes] 271 | (DateTimeOffset. years months days hours minutes seconds 272 | (/ nanoseconds 1000000) 273 | (if (neg? offset-sign) 274 | (TimeSpan. (- offset-hours) (- offset-minutes) 0) 275 | (TimeSpan. offset-hours offset-minutes 0)))) 276 | ;;; 277 | 278 | 279 | ;;;(defn- construct-date 280 | ;;; "Construct a java.util.Date, which expresses the original instant as 281 | ;;;milliseconds since the epoch, UTC." 282 | ;;; [years months days hours minutes seconds nanoseconds 283 | ;;; offset-sign offset-hours offset-minutes] 284 | ;;; (.getTime (construct-calendar years months days 285 | ;;; hours minutes seconds nanoseconds 286 | ;;; offset-sign offset-hours offset-minutes))) 287 | 288 | ;;; DM: Added 289 | (defn- construct-datetime 290 | "Construct a System.DateTime, which expresses the original instant as 291 | milliseconds since the epoch, UTC." 292 | [years months days hours minutes seconds nanoseconds 293 | offset-sign offset-hours offset-minutes] 294 | (.UtcDateTime (construct-datetimeoffset years months days 295 | hours minutes seconds nanoseconds 296 | offset-sign offset-hours offset-minutes))) 297 | ;;; 298 | 299 | 300 | ;;;(defn- construct-timestamp 301 | ;;; "Construct a java.sql.Timestamp, which has nanosecond precision." 302 | ;;; [years months days hours minutes seconds nanoseconds 303 | ;;; offset-sign offset-hours offset-minutes] 304 | ;;; (doto (Timestamp. 305 | ;;; (.getTimeInMillis 306 | ;;; (construct-calendar years months days 307 | ;;; hours minutes seconds nanoseconds 308 | ;;; offset-sign offset-hours offset-minutes))) 309 | ;;; (.setNanos nanoseconds))) 310 | 311 | (def read-instant-datetime ;;; read-instant-date 312 | "To read an instant as a System.DateTime, bind *data-readers* to a map with 313 | this var as the value for the 'inst key. The timezone offset will be used 314 | to convert into UTC." 315 | (partial parse-timestamp (validated construct-datetime))) ;;; construct-date 316 | 317 | ;;; DM: Added 318 | (def read-instant-datetimeoffset 319 | "To read an instant as a System.DateTimeOffset, bind *data-readers* to a map with 320 | this var as the value for the 'inst key. The timezone offset will be used 321 | to convert into UTC." 322 | (partial parse-timestamp (validated construct-datetimeoffset))) 323 | ;;; 324 | 325 | ;;;(def read-instant-calendar 326 | ;;; "To read an instant as a java.util.Calendar, bind *data-readers* to a map with 327 | ;;;this var as the value for the 'inst key. Calendar preserves the timezone 328 | ;;;offset." 329 | ;;; (partial parse-timestamp (validated construct-calendar))) 330 | 331 | ;;;(def read-instant-timestamp 332 | ;;; "To read an instant as a java.sql.Timestamp, bind *data-readers* to a 333 | ;;;map with this var as the value for the 'inst key. Timestamp preserves 334 | ;;;fractional seconds with nanosecond precision. The timezone offset will 335 | ;;;be used to convert into UTC." 336 | ;;; (partial parse-timestamp (validated construct-timestamp))) 337 | 338 | ;;; clojure.uuid ;;; 339 | 340 | (defn- default-uuid-reader [form] 341 | {:pre [(string? form)]} 342 | (System.Guid. ^String form)) ;;; (java.util.UUID/fromString form), added String tag 343 | 344 | (defmethod print-method System.Guid [uuid ^System.IO.TextWriter w] ;;; java.util.UUID ^java.io.Writer 345 | (.Write w (str "#uuid \"" (str uuid) "\""))) ;;; .write 346 | 347 | (defmethod print-dup System.Guid [o w] ;;; java.util.UUID 348 | (print-method o w)) 349 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/reader/reader_types.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "Protocols and default Reader types implementation" 10 | :author "Bronsa"} 11 | clojure.tools.reader.reader-types 12 | (:refer-clojure :exclude [char read-line]) 13 | (:require [clojure.tools.reader.impl.utils :refer [char whitespace? newline? make-var]]) 14 | (:import clojure.lang.LineNumberingTextReader ;;; LineNumberingPushbackReader 15 | (System.Text StringBuilder) (System.IO TextReader))) ;;; java.io InputStream BufferedReader Closeable 16 | 17 | (defmacro ^:private update! [what f] 18 | (list 'set! what (list f what))) 19 | 20 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 21 | ;; reader protocols 22 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 23 | 24 | (defprotocol Reader 25 | (read-char [reader] 26 | "Returns the next char from the Reader, nil if the end of stream has been reached") 27 | (peek-char [reader] 28 | "Returns the next char from the Reader without removing it from the reader stream")) 29 | 30 | (defprotocol IPushbackReader 31 | (unread [reader ch] 32 | "Pushes back a single character on to the stream")) 33 | 34 | (defprotocol IndexingReader 35 | (get-line-number [reader] 36 | "Returns the line number of the next character to be read from the stream") 37 | (get-column-number [reader] 38 | "Returns the column number of the next character to be read from the stream") 39 | (get-file-name [reader] 40 | "Returns the file name the reader is reading from, or nil")) 41 | 42 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 43 | ;; reader deftypes 44 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 45 | 46 | (deftype StringReader 47 | [^String s ^long s-len ^:unsynchronized-mutable ^long s-pos] 48 | Reader 49 | (read-char [reader] 50 | (when (> s-len s-pos) 51 | (let [r (nth s s-pos)] 52 | (update! s-pos inc) 53 | r))) 54 | (peek-char [reader] 55 | (when (> s-len s-pos) 56 | (nth s s-pos)))) 57 | 58 | (deftype InputStreamReader [^TextReader is ^:unsynchronized-mutable ^"System.Char[]" buf] ;;; ^InputStream ^"[B" -- Should rename this to InpuTextReader or something, 59 | Reader 60 | (read-char [reader] 61 | (if buf 62 | (let [c (aget buf 0)] 63 | (set! buf nil) 64 | (char c)) 65 | (let [c (.Read is)] ;;; .read 66 | (when (>= c 0) 67 | (char c))))) 68 | (peek-char [reader] 69 | (when-not buf 70 | (set! buf (byte-array 1)) 71 | (when (== 0 (.Read is buf 0 (count buf))) ;;; -1 (.read is buf) 72 | (set! buf nil))) 73 | (when buf 74 | (char (aget buf 0)))) 75 | IDisposable ;;; Closeable 76 | (Dispose [this] ;;; Close 77 | (.Close is))) ;;; .close 78 | 79 | (deftype PushbackReader 80 | [rdr ^"System.Object[]" buf ^long buf-len ^:unsynchronized-mutable ^long buf-pos] ;;; ^"[Ljava.lang.Object;" 81 | Reader 82 | (read-char [reader] 83 | (char 84 | (if (< buf-pos buf-len) 85 | (let [r (aget buf buf-pos)] 86 | (update! buf-pos inc) 87 | r) 88 | (read-char rdr)))) 89 | (peek-char [reader] 90 | (char 91 | (if (< buf-pos buf-len) 92 | (aget buf buf-pos) 93 | (peek-char rdr)))) 94 | IPushbackReader 95 | (unread [reader ch] 96 | (when ch 97 | (if (zero? buf-pos) (throw (Exception. "Pushback buffer is full"))) ;;; RuntimeException. 98 | (update! buf-pos dec) 99 | (aset buf buf-pos ch))) 100 | IDisposable ;;; Closeable 101 | (Dispose [this] ;;; Close 102 | (when (instance? IDisposable rdr) ;;; Closeable 103 | (.Dispose ^IDisposable rdr)))) ;;; .close ^Closeable 104 | 105 | (deftype IndexingPushbackReader 106 | [rdr ^:unsynchronized-mutable ^long line ^:unsynchronized-mutable ^long column 107 | ^:unsynchronized-mutable line-start? ^:unsynchronized-mutable prev 108 | ^:unsynchronized-mutable ^long prev-column file-name 109 | ^:unsynchronized-mutable normalize?] 110 | Reader 111 | (read-char [reader] 112 | (when-let [ch (read-char rdr)] 113 | (let [ch (if normalize? 114 | (do (set! normalize? false) 115 | (if (or (identical? \newline ch) 116 | (identical? \formfeed ch)) 117 | (read-char rdr) 118 | ch)) 119 | ch) 120 | ch (if (identical? \return ch) 121 | (do (set! normalize? true) 122 | \newline) 123 | ch)] 124 | (set! prev line-start?) 125 | (set! line-start? (newline? ch)) 126 | (when line-start? 127 | (set! prev-column column) 128 | (set! column 0) 129 | (update! line inc)) 130 | (update! column inc) 131 | ch))) 132 | 133 | (peek-char [reader] 134 | (peek-char rdr)) 135 | 136 | IPushbackReader 137 | (unread [reader ch] 138 | (if line-start? 139 | (do (update! line dec) 140 | (set! column prev-column)) 141 | (update! column dec)) 142 | (set! line-start? prev) 143 | ;; This may look a bit convoluted, but it helps in the following 144 | ;; scenario: 145 | ;; + The underlying reader is about to return \return from the 146 | ;; next read-char, and then \newline after that. 147 | ;; + read-char gets \return, sets normalize? to true, returns 148 | ;; \newline instead. 149 | ;; + Caller calls unread on the \newline it just got. If we 150 | ;; unread the \newline to the underlying reader, now it is ready 151 | ;; to return two \newline chars in a row, which will throw off 152 | ;; the tracked line numbers. 153 | (let [ch (if normalize? 154 | (do (set! normalize? false) 155 | (if (identical? \newline ch) 156 | \return 157 | ch)) 158 | ch)] 159 | (unread rdr ch))) 160 | 161 | IndexingReader 162 | (get-line-number [reader] (int line)) 163 | (get-column-number [reader] (int column)) 164 | (get-file-name [reader] file-name) 165 | 166 | IDisposable ;;; Closeable 167 | (Dispose [this] ;;; close 168 | (when (instance? IDisposable rdr) ;;; Closeable 169 | (.Dispose ^IDisposable rdr)))) ;;; .close ^Closeable 170 | 171 | ;; Java interop 172 | 173 | (extend-type clojure.lang.PushbackTextReader ;;; java.io.PushbackReader 174 | Reader 175 | (read-char [rdr] 176 | (let [c (.Read ^clojure.lang.PushbackTextReader rdr)] ;;; .read ^java.io.PushbackReader 177 | (when (>= c 0) 178 | (char c)))) 179 | 180 | (peek-char [rdr] 181 | (when-let [c (read-char rdr)] 182 | (unread rdr c) 183 | c)) 184 | 185 | IPushbackReader 186 | (unread [rdr c] 187 | (when c 188 | (.Unread ^clojure.lang.PushbackTextReader rdr (int c))))) ;;; .unread ^java.io.PushbackReader 189 | 190 | (extend LineNumberingTextReader ;;; LineNumberingPushbackReader 191 | IndexingReader 192 | {:get-line-number (fn [rdr] (.LineNumber ^LineNumberingTextReader rdr)) ;;; .getLineNumber ^LineNumberingPushbackReader 193 | :get-column-number (fn [rdr] 194 | (.ColumnNumber ^LineNumberingTextReader rdr)) ;;; .getColumnNumber ^LineNumberingPushbackReader 195 | :get-file-name (constantly nil)}) 196 | 197 | (defprotocol ReaderCoercer 198 | (to-rdr [rdr])) 199 | 200 | (declare string-reader push-back-reader) 201 | 202 | (extend-protocol ReaderCoercer 203 | Object 204 | (to-rdr [rdr] 205 | (if (satisfies? Reader rdr) 206 | rdr 207 | (throw (ArgumentException. (str "Argument of type: " (class rdr) " cannot be converted to Reader"))))) ;;; IllegalArgumentException. 208 | clojure.tools.reader.reader_types.Reader 209 | (to-rdr [rdr] rdr) 210 | String 211 | (to-rdr [str] (string-reader str)) 212 | System.IO.TextReader ;;; java.io.Reader 213 | (to-rdr [rdr] (clojure.lang.PushbackTextReader. rdr))) ;;; java.io.PushbackReader. 214 | 215 | (defprotocol PushbackReaderCoercer 216 | (to-pbr [rdr buf-len])) 217 | 218 | (extend-protocol PushbackReaderCoercer 219 | Object 220 | (to-pbr [rdr buf-len] 221 | (if (satisfies? Reader rdr) 222 | (push-back-reader rdr buf-len) 223 | (throw (ArgumentException. (str "Argument of type: " (class rdr) " cannot be converted to IPushbackReader"))))) ;;; IllegalArgumentException. 224 | clojure.tools.reader.reader_types.Reader 225 | (to-pbr [rdr buf-len] (push-back-reader rdr buf-len)) 226 | clojure.tools.reader.reader_types.PushbackReader 227 | (to-pbr [rdr buf-len] (push-back-reader rdr buf-len)) 228 | String 229 | (to-pbr [str buf-len] (push-back-reader str buf-len)) 230 | System.IO.TextReader ;;; java.io.Reader 231 | (to-pbr [rdr buf-len] (clojure.lang.PushbackTextReader. rdr ))) ;;; java.io.PushbackReader. removed buf-len -- no such arg for us. 232 | 233 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 234 | ;; Source Logging support 235 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 236 | (defn merge-meta 237 | "Returns an object of the same type and value as `obj`, with its 238 | metadata merged over `m`." 239 | [obj m] 240 | (let [orig-meta (meta obj)] 241 | (with-meta obj (merge m (dissoc orig-meta :source))))) 242 | 243 | (defn- peek-source-log 244 | "Returns a string containing the contents of the top most source 245 | logging frame." 246 | [source-log-frames] 247 | (let [current-frame @source-log-frames] 248 | (.Substring (.ToString ^StringBuilder (:buffer current-frame)) (:offset current-frame)))) ;;; .substring -- added .ToString beause STringbuilder does not have .substring method. 249 | 250 | (defn- log-source-char 251 | "Logs `char` to all currently active source logging frames." 252 | [source-log-frames char] 253 | (when-let [^StringBuilder buffer (:buffer @source-log-frames)] 254 | (.Append buffer char))) ;;; .append 255 | 256 | (defn- drop-last-logged-char 257 | "Removes the last logged character from all currently active source 258 | logging frames. Called when pushing a character back." 259 | [source-log-frames] 260 | (when-let [^StringBuilder buffer (:buffer @source-log-frames)] 261 | (.Remove buffer (dec (.Length buffer)) 1))) ;;; .deleteCharAt .length , Added 1 arg (lengtH) 262 | 263 | (deftype SourceLoggingPushbackReader 264 | [rdr ^:unsynchronized-mutable ^long line ^:unsynchronized-mutable ^long column 265 | ^:unsynchronized-mutable line-start? ^:unsynchronized-mutable prev 266 | ^:unsynchronized-mutable ^long prev-column file-name source-log-frames 267 | ^:unsynchronized-mutable normalize?] 268 | Reader 269 | (read-char [reader] 270 | (when-let [ch (read-char rdr)] 271 | (let [ch (if normalize? 272 | (do (set! normalize? false) 273 | (if (or (identical? \newline ch) 274 | (identical? \formfeed ch)) 275 | (read-char rdr) 276 | ch)) 277 | ch) 278 | ch (if (identical? \return ch) 279 | (do (set! normalize? true) 280 | \newline) 281 | ch)] 282 | (set! prev line-start?) 283 | (set! line-start? (newline? ch)) 284 | (when line-start? 285 | (set! prev-column column) 286 | (set! column 0) 287 | (update! line inc)) 288 | (update! column inc) 289 | (log-source-char source-log-frames ch) 290 | ch))) 291 | 292 | (peek-char [reader] 293 | (peek-char rdr)) 294 | 295 | IPushbackReader 296 | (unread [reader ch] 297 | (if line-start? 298 | (do (update! line dec) 299 | (set! column prev-column)) 300 | (update! column dec)) 301 | (set! line-start? prev) 302 | (when ch 303 | (drop-last-logged-char source-log-frames)) 304 | (unread rdr ch)) 305 | 306 | IndexingReader 307 | (get-line-number [reader] (int line)) 308 | (get-column-number [reader] (int column)) 309 | (get-file-name [reader] file-name) 310 | 311 | IDisposable ;;; Closeable 312 | (Dispose [this] ;;; close 313 | (when (instance? IDisposable rdr) ;;; Closeable 314 | (.Dispose ^IDisposable rdr)))) ;;; .close ^Closeable 315 | 316 | (defn log-source* 317 | [reader f] 318 | (let [frame (.source-log-frames ^SourceLoggingPushbackReader reader) 319 | ^StringBuilder buffer (:buffer @frame) 320 | new-frame (assoc-in @frame [:offset] (.get_Length buffer))] ;;; .length 321 | (with-bindings {frame new-frame} 322 | (let [ret (f)] 323 | (if (instance? clojure.lang.IObj ret) 324 | (merge-meta ret {:source (peek-source-log frame)}) 325 | ret))))) 326 | 327 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 328 | ;; Public API 329 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 330 | 331 | ;; fast check for provided implementations 332 | (defn indexing-reader? 333 | "Returns true if the reader satisfies IndexingReader" 334 | [rdr] 335 | (or (instance? clojure.tools.reader.reader_types.IndexingReader rdr) 336 | (instance? LineNumberingTextReader rdr) ;;; LineNumberingPushbackReader 337 | (and (not (instance? clojure.tools.reader.reader_types.PushbackReader rdr)) 338 | (not (instance? clojure.tools.reader.reader_types.StringReader rdr)) 339 | (not (instance? clojure.tools.reader.reader_types.InputStreamReader rdr)) 340 | (get (:impls IndexingReader) (class rdr))))) 341 | 342 | (defn string-reader 343 | "Creates a StringReader from a given string" 344 | ([^String s] 345 | (StringReader. s (count s) 0))) 346 | 347 | (defn ^IDisposable push-back-reader ;;; ^Closeable 348 | "Creates a PushbackReader from a given reader or string" 349 | ([rdr] (push-back-reader rdr 1)) 350 | ([rdr buf-len] (PushbackReader. (to-rdr rdr) (object-array buf-len) buf-len buf-len))) 351 | 352 | (defn ^IDisposable string-push-back-reader ;;; ^Closeable 353 | "Creates a PushbackReader from a given string" 354 | ([s] 355 | (string-push-back-reader s 1)) 356 | ([^String s buf-len] 357 | (push-back-reader (string-reader s) buf-len))) 358 | 359 | (defn ^IDisposable input-stream-reader ;;; ^Closeable 360 | "Creates an InputStreamReader from an InputStream" 361 | [is] 362 | (InputStreamReader. is nil)) 363 | 364 | (defn ^IDisposable input-stream-push-back-reader ;;; ^Closeable 365 | "Creates a PushbackReader from a given InputStream" 366 | ([is] 367 | (input-stream-push-back-reader is 1)) 368 | ([^TextReader is buf-len] ;;; InputStream 369 | (push-back-reader (input-stream-reader is) buf-len))) 370 | 371 | (defn ^IDisposable indexing-push-back-reader ;;; ^Closeable 372 | "Creates an IndexingPushbackReader from a given string or PushbackReader" 373 | ([s-or-rdr] 374 | (indexing-push-back-reader s-or-rdr 1)) 375 | ([s-or-rdr buf-len] 376 | (indexing-push-back-reader s-or-rdr buf-len nil)) 377 | ([s-or-rdr buf-len file-name] 378 | (IndexingPushbackReader. 379 | (to-pbr s-or-rdr buf-len) 1 1 true nil 0 file-name false))) 380 | 381 | (defn ^IDisposable source-logging-push-back-reader ;;; ^Closeable 382 | "Creates a SourceLoggingPushbackReader from a given string or PushbackReader" 383 | ([s-or-rdr] 384 | (source-logging-push-back-reader s-or-rdr 1)) 385 | ([s-or-rdr buf-len] 386 | (source-logging-push-back-reader s-or-rdr buf-len nil)) 387 | ([s-or-rdr buf-len file-name] 388 | (SourceLoggingPushbackReader. 389 | (to-pbr s-or-rdr buf-len) 390 | 1 391 | 1 392 | true 393 | nil 394 | 0 395 | file-name 396 | (doto (make-var) 397 | (alter-var-root (constantly {:buffer (StringBuilder.) 398 | :offset 0}))) 399 | false))) 400 | 401 | (defn read-line 402 | "Reads a line from the reader or from *in* if no reader is specified" 403 | ([] (read-line *in*)) 404 | ([rdr] 405 | (if (or (instance? LineNumberingTextReader rdr) ;;; LineNumberingPushbackReader 406 | #_(instance? BufferedReader rdr)) ;;; commented out -- no such thing as a BufferedReader 407 | (binding [*in* rdr] 408 | (clojure.core/read-line)) 409 | (loop [c (read-char rdr) s (StringBuilder.)] 410 | (if (newline? c) 411 | (str s) 412 | (recur (read-char rdr) (.Append s c))))))) ;;; .append 413 | 414 | (defn source-logging-reader? 415 | [rdr] 416 | (instance? SourceLoggingPushbackReader rdr)) 417 | 418 | (defmacro log-source 419 | "If reader is a SourceLoggingPushbackReader, execute body in a source 420 | logging context. Otherwise, execute body, returning the result." 421 | [reader & body] 422 | `(if (and (source-logging-reader? ~reader) 423 | (not (whitespace? (peek-char ~reader)))) 424 | (log-source* ~reader (^:once fn* [] ~@body)) 425 | (do ~@body))) 426 | 427 | (defn line-start? 428 | "Returns true if rdr is an IndexingReader and the current char starts a new line" 429 | [rdr] 430 | (when (indexing-reader? rdr) 431 | (== 1 (int (get-column-number rdr))))) 432 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/reader/edn.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "An EDN reader in clojure" 10 | :author "Bronsa"} 11 | clojure.tools.reader.edn 12 | (:refer-clojure :exclude [read read-string char default-data-readers]) 13 | (:require [clojure.tools.reader.reader-types :refer 14 | [read-char unread peek-char indexing-reader? 15 | get-line-number get-column-number get-file-name string-push-back-reader]] 16 | [clojure.tools.reader.impl.utils :refer 17 | [char ex-info? whitespace? numeric? desugar-meta namespace-keys second' char-value-in-radix ]] ;;; DM: Added char-value-in-radix 18 | [clojure.tools.reader.impl.commons :refer :all] 19 | [clojure.tools.reader.impl.errors :as err] 20 | [clojure.tools.reader :refer [default-data-readers]]) 21 | (:import (clojure.lang PersistentHashSet IMeta RT PersistentVector))) 22 | 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 24 | ;; helpers 25 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 26 | 27 | (declare read macros dispatch-macros) 28 | 29 | (defn- macro-terminating? [ch] 30 | (and (not (identical? \# ch)) 31 | (not (identical? \' ch)) 32 | (not (identical? \: ch)) 33 | (macros ch))) 34 | 35 | (defn- not-constituent? [ch] 36 | (or (identical? \@ ch) 37 | (identical? \` ch) 38 | (identical? \~ ch))) 39 | 40 | ;; Some serious hacking on read-token to make it work with |-quoting on symbols. 41 | 42 | ;; This was the loop after all the leading-character tests in read-token. 43 | ;; Now used for anything other than :symbol 44 | (defn- ^String read-token-not-symbol 45 | [rdr kind initch validate-leading?] 46 | (loop [sb (StringBuilder.) 47 | ch initch] 48 | (if (or (whitespace? ch) 49 | (macro-terminating? ch) 50 | (nil? ch)) 51 | (do (unread rdr ch) 52 | (str sb)) 53 | (if (not-constituent? ch) 54 | (err/throw-bad-char rdr kind ch) 55 | (recur (doto sb (.Append ch)) (read-char rdr)))))) 56 | 57 | ;; This version allows for |-quoting. 58 | 59 | (defn- read-token-symbol 60 | [rdr kind initch validate-leading?] 61 | (let [rawMode (= initch \|) 62 | sb (StringBuilder.) 63 | startch (if rawMode (read-char rdr) initch)] 64 | (when rawMode 65 | (.Append sb initch)) 66 | (loop [sb sb ch startch rawMode rawMode] 67 | (when (and rawMode (nil? ch)) 68 | (err/throw-eof-reading rdr :symbol sb)) 69 | (if rawMode 70 | (cond 71 | (nil? ch) 72 | (err/throw-eof-reading rdr :symbol sb) 73 | (and (= ch \|) (= (peek-char rdr) '\|)) ;; || in raw mode, eat both 74 | (do (read-char rdr) ;; eat the second | 75 | (recur (.Append sb "||") (read-char rdr) (boolean true))) 76 | :else (recur (.Append sb ch) (read-char rdr) (boolean (not= ch \|)))) 77 | (if (or (whitespace? ch) 78 | (macro-terminating? ch) 79 | (nil? ch)) 80 | (do (when ch 81 | (unread rdr ch)) 82 | (str sb)) 83 | (if (not-constituent? ch) 84 | (err/throw-bad-char rdr kind ch) 85 | (recur (.Append sb ch) (read-char rdr) rawMode))))))) 86 | 87 | (defn- ^String read-token 88 | ([rdr kind initch] 89 | (read-token rdr kind initch true)) 90 | 91 | ([rdr kind initch validate-leading?] 92 | (cond 93 | (not initch) 94 | (err/throw-eof-at-start rdr kind) 95 | 96 | (and validate-leading? 97 | (not-constituent? initch)) 98 | (err/throw-bad-char rdr kind initch) 99 | 100 | (= kind :symbol) 101 | (read-token-symbol rdr kind initch validate-leading?) 102 | 103 | :else 104 | (read-token-not-symbol rdr kind initch validate-leading?)))) 105 | 106 | 107 | 108 | (declare read-tagged) 109 | 110 | (defn- read-dispatch 111 | [rdr _ opts] 112 | (if-let [ch (read-char rdr)] 113 | (if-let [dm (dispatch-macros ch)] 114 | (dm rdr ch opts) 115 | (read-tagged (doto rdr (unread ch)) ch opts)) 116 | (err/throw-eof-at-dispatch rdr))) 117 | 118 | (defn- read-unmatched-delimiter 119 | [rdr ch opts] 120 | (err/throw-unmatch-delimiter rdr ch)) 121 | 122 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 123 | ;; readers 124 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 125 | 126 | 127 | (defn- read-unicode-char 128 | ([^String token ^long offset ^long length ^long base] 129 | (let [l (+ offset length)] 130 | (when-not (== (count token) l) 131 | (err/throw-invalid-unicode-literal nil token)) 132 | (loop [i offset uc 0] 133 | (if (== i l) 134 | (char uc) 135 | (let [d (char-value-in-radix (int (nth token i)) (int base))] ;;; Character/digit 136 | (if (== d -1) 137 | (err/throw-invalid-unicode-digit-in-token nil (nth token i) token) 138 | (recur (inc i) (long (+ d (* uc base)))))))))) 139 | 140 | ([rdr initch base length exact?] 141 | (let [length (long length) 142 | base (long base)] 143 | (loop [i 1 uc (char-value-in-radix (int initch) (int base))] ;;; Character/digit 144 | (if (== uc -1) 145 | (err/throw-invalid-unicode-digit rdr initch) 146 | (if-not (== i length) 147 | (let [ch (peek-char rdr)] 148 | (if (or (whitespace? ch) 149 | (macros ch) 150 | (nil? ch)) 151 | (if exact? 152 | (err/throw-invalid-unicode-len rdr i length) 153 | (char uc)) 154 | (let [d (char-value-in-radix (int ch) (int base))] ;;; Character/digit 155 | (read-char rdr) 156 | (if (== d -1) 157 | (err/throw-invalid-unicode-digit rdr ch) 158 | (recur (inc i) (long (+ d (* uc base)))))))) 159 | (char uc))))))) 160 | 161 | (def ^:private ^:const upper-limit (int \uD7ff)) 162 | (def ^:private ^:const lower-limit (int \uE000)) 163 | 164 | (defn- read-char* 165 | [rdr backslash opts] 166 | (let [ch (read-char rdr)] 167 | (if-not (nil? ch) 168 | (let [token (if (or (macro-terminating? ch) 169 | (not-constituent? ch) 170 | (whitespace? ch)) 171 | (str ch) 172 | (read-token rdr :character ch false)) 173 | token-len (count token)] 174 | (cond 175 | 176 | (== 1 token-len) (char (nth token 0)) ;;; Character/valueOf 177 | 178 | (= token "newline") \newline 179 | (= token "space") \space 180 | (= token "tab") \tab 181 | (= token "backspace") \backspace 182 | (= token "formfeed") \formfeed 183 | (= token "return") \return 184 | 185 | (.StartsWith token "u") ;;; .startsWith 186 | (let [c (read-unicode-char token 1 4 16) 187 | ic (int c)] 188 | (if (and (> ic upper-limit) 189 | (< ic lower-limit)) 190 | (err/throw-invalid-character-literal rdr (.ToString ic "x")) ;;; (Integer/toString ic 16) 191 | c)) 192 | 193 | (.StartsWith token "o") ;;; .startsWith 194 | (let [len (dec token-len)] 195 | (if (> len 3) 196 | (err/throw-invalid-octal-len rdr token) 197 | (let [uc (read-unicode-char token 1 len 8)] 198 | (if (> (int uc) 0377) 199 | (err/throw-bad-octal-number rdr) 200 | uc)))) 201 | 202 | :else (err/throw-unsupported-character rdr token))) 203 | (err/throw-eof-in-character rdr)))) 204 | 205 | (defn ^:private starting-line-col-info [rdr] 206 | (when (indexing-reader? rdr) 207 | [(get-line-number rdr) (int (dec (int (get-column-number rdr))))])) 208 | 209 | (defn- ^PersistentVector read-delimited 210 | [kind delim rdr opts] 211 | (let [[start-line start-column] (starting-line-col-info rdr) 212 | delim (char delim)] 213 | (loop [a (transient [])] 214 | (let [ch (read-past whitespace? rdr)] 215 | (when-not ch 216 | (err/throw-eof-delimited rdr kind start-line start-column (count a))) 217 | 218 | (if (identical? delim (char ch)) 219 | (persistent! a) 220 | (if-let [macrofn (macros ch)] 221 | (let [mret (macrofn rdr ch opts)] 222 | (recur (if-not (identical? mret rdr) (conj! a mret) a))) 223 | (let [o (read (doto rdr (unread ch)) true nil opts)] 224 | (recur (if-not (identical? o rdr) (conj! a o) a))))))))) 225 | 226 | (defn- read-list 227 | [rdr _ opts] 228 | (let [the-list (read-delimited :list \) rdr opts)] 229 | (if (empty? the-list) 230 | '() 231 | (clojure.lang.PersistentList/create the-list)))) 232 | 233 | (defn- read-vector 234 | [rdr _ opts] 235 | (read-delimited :vector \] rdr opts)) 236 | 237 | (defn- read-map 238 | [rdr _ opts] 239 | (let [[start-line start-column] (starting-line-col-info rdr) 240 | coll (read-delimited :map \} rdr opts) 241 | l (to-array coll)] 242 | (when (== 1 (bit-and (alength l) 1)) 243 | (err/throw-odd-map rdr start-line start-column coll)) 244 | (RT/map l))) 245 | 246 | (defn- read-number 247 | [rdr initch opts] 248 | (loop [sb (doto (StringBuilder.) (.Append initch)) ;;; .append 249 | ch (read-char rdr)] 250 | (if (or (whitespace? ch) (macros ch) (nil? ch)) 251 | (let [s (str sb)] 252 | (when ch (unread rdr ch)) 253 | (or (match-number s) 254 | (err/throw-invalid-number rdr s))) 255 | (recur (doto sb (.Append ch)) (read-char rdr))))) ;;; .append 256 | 257 | 258 | (defn- escape-char [sb rdr] 259 | (let [ch (read-char rdr)] 260 | (case ch 261 | \t "\t" 262 | \r "\r" 263 | \n "\n" 264 | \\ "\\" 265 | \" "\"" 266 | \b "\b" 267 | \f "\f" 268 | \u (let [ch (read-char rdr)] 269 | (if (== -1 (char-value-in-radix (int ch) 16)) ;;; Character/digit 270 | (err/throw-invalid-unicode-escape rdr ch) 271 | (read-unicode-char rdr ch 16 4 true))) 272 | (if (numeric? ch) 273 | (let [ch (read-unicode-char rdr ch 8 3 false)] 274 | (if (> (int ch) 0377) 275 | (err/throw-bad-octal-number rdr) 276 | ch)) 277 | (err/throw-bad-escape-char rdr ch))))) 278 | 279 | (defn- read-string* 280 | [rdr _ opts] 281 | (loop [sb (StringBuilder.) 282 | ch (read-char rdr)] 283 | (case ch 284 | nil (err/throw-eof-reading rdr :string \" sb) 285 | \\ (recur (doto sb (.Append (escape-char sb rdr))) ;;; .append 286 | (read-char rdr)) 287 | \" (str sb) 288 | (recur (doto sb (.Append ch)) (read-char rdr))))) ;;; .append 289 | 290 | (defn- read-symbol 291 | [rdr initch] 292 | (when-let [token (read-token rdr :symbol initch)] 293 | (case token 294 | 295 | ;; special symbols 296 | "nil" nil 297 | "true" true 298 | "false" false 299 | "/" '/ 300 | 301 | (or (when-let [p (parse-symbol token)] 302 | (symbol (p 0) (p 1))) 303 | (err/throw-invalid rdr :symbol token))))) 304 | 305 | (defn- read-keyword 306 | [reader initch opts] 307 | (let [ch (read-char reader)] 308 | (if-not (whitespace? ch) 309 | (let [token (read-token reader :keyword ch) 310 | s (parse-symbol token)] 311 | (if (and s (== -1 (.IndexOf token "::"))) ;;; .indexOf 312 | (let [^String ns (s 0) 313 | ^String name (s 1)] 314 | (if (identical? \: (nth token 0)) 315 | (err/throw-invalid reader :keyword (str \: token)) ; No ::kw in edn. 316 | (keyword ns name))) 317 | (err/throw-invalid reader :keyword (str \: token)))) 318 | (err/throw-single-colon reader)))) 319 | 320 | (defn- wrapping-reader 321 | [sym] 322 | (fn [rdr _ opts] 323 | (list sym (read rdr true nil opts)))) 324 | 325 | (defn- read-meta 326 | [rdr _ opts] 327 | (let [m (desugar-meta (read rdr true nil opts))] 328 | (when-not (map? m) 329 | (err/throw-bad-metadata rdr m)) 330 | 331 | (let [o (read rdr true nil opts)] 332 | (if (instance? IMeta o) 333 | (with-meta o (merge (meta o) m)) 334 | (err/throw-bad-metadata-target rdr o))))) 335 | 336 | (defn- read-set 337 | [rdr _ opts] 338 | (PersistentHashSet/createWithCheck (read-delimited :set \} rdr opts))) 339 | 340 | (defn- read-discard 341 | [rdr _ opts] 342 | (doto rdr 343 | (read true nil true))) 344 | 345 | (defn- read-namespaced-map 346 | [rdr _ opts] 347 | (let [token (read-token rdr :namespaced-map (read-char rdr))] 348 | (if-let [ns (some-> token parse-symbol second)] 349 | (let [ch (read-past whitespace? rdr)] 350 | (if (identical? ch \{) 351 | (let [items (read-delimited :namespaced-map \} rdr opts)] 352 | (when (odd? (count items)) 353 | (err/throw-odd-map rdr nil nil items)) 354 | (let [keys (take-nth 2 items) 355 | vals (take-nth 2 (rest items))] 356 | (RT/map (to-array (mapcat list (namespace-keys (str ns) keys) vals))))) 357 | (err/throw-ns-map-no-map rdr token))) 358 | (err/throw-bad-ns rdr token)))) 359 | 360 | (defn- read-symbolic-value 361 | [rdr _ opts] 362 | (let [sym (read rdr true nil opts)] 363 | (case sym 364 | Inf Double/PositiveInfinity ;;; Double/POSITIVE_INFINITY 365 | -Inf Double/NegativeInfinity ;;; Double/NEGATIVE_INFINITY 366 | NaN Double/NaN 367 | (err/reader-error rdr (str "Invalid token: ##" sym))))) 368 | 369 | (defn- macros [ch] 370 | (case ch 371 | \" read-string* 372 | \: read-keyword 373 | \; read-comment 374 | \^ read-meta 375 | \( read-list 376 | \) read-unmatched-delimiter 377 | \[ read-vector 378 | \] read-unmatched-delimiter 379 | \{ read-map 380 | \} read-unmatched-delimiter 381 | \\ read-char* 382 | \# read-dispatch 383 | nil)) 384 | 385 | (defn- dispatch-macros [ch] 386 | (case ch 387 | \^ read-meta ;deprecated 388 | \{ read-set 389 | \< (throwing-reader "Unreadable form") 390 | \! read-comment 391 | \_ read-discard 392 | \: read-namespaced-map 393 | \# read-symbolic-value 394 | nil)) 395 | 396 | (defn- read-tagged [rdr initch opts] 397 | (let [tag (read rdr true nil opts) 398 | object (read rdr true nil opts)] 399 | (if-not (symbol? tag) 400 | (err/throw-bad-reader-tag rdr "Reader tag must be a symbol")) 401 | (if-let [f (or (get (:readers opts) tag) 402 | (default-data-readers tag))] 403 | (f object) 404 | (if-let [d (:default opts)] 405 | (d tag object) 406 | (err/throw-unknown-reader-tag rdr tag))))) 407 | 408 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 409 | ;; Public API 410 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 411 | 412 | (defn read 413 | "Reads the first object from an IPushbackReader or a java.io.PushbackReader. 414 | Returns the object read. If EOF, throws if eof-error? is true otherwise returns eof. 415 | If no reader is provided, *in* will be used. 416 | 417 | Reads data in the edn format (subset of Clojure data): 418 | http://edn-format.org 419 | 420 | clojure.tools.reader.edn/read doesn't depend on dynamic Vars, all configuration 421 | is done by passing an opt map. 422 | 423 | opts is a map that can include the following keys: 424 | :eof - value to return on end-of-file. When not supplied, eof throws an exception. 425 | :readers - a map of tag symbols to data-reader functions to be considered before default-data-readers. 426 | When not supplied, only the default-data-readers will be used. 427 | :default - A function of two args, that will, if present and no reader is found for a tag, 428 | be called with the tag and the value." 429 | ([] (read *in*)) 430 | ([reader] (read {} reader)) 431 | ([{:keys [eof] :as opts} reader] 432 | (let [eof-error? (not (contains? opts :eof))] 433 | (read reader eof-error? eof opts))) 434 | ([reader eof-error? eof opts] 435 | (try 436 | (loop [] 437 | (let [ch (read-char reader)] 438 | (cond 439 | (whitespace? ch) (recur) 440 | (nil? ch) (if eof-error? (err/throw-eof-error reader nil) eof) 441 | (number-literal? reader ch) (read-number reader ch opts) 442 | :else (let [f (macros ch)] 443 | (if f 444 | (let [res (f reader ch opts)] 445 | (if (identical? res reader) 446 | (recur) 447 | res)) 448 | (read-symbol reader ch)))))) 449 | (catch Exception e 450 | (if (ex-info? e) 451 | (let [d (ex-data e)] 452 | (if (= :reader-exception (:type d)) 453 | (throw e) 454 | (throw (ex-info (.Message e) ;;; .getMessage 455 | (merge {:type :reader-exception} 456 | d 457 | (if (indexing-reader? reader) 458 | {:line (get-line-number reader) 459 | :column (get-column-number reader) 460 | :file (get-file-name reader)})) 461 | e)))) 462 | (throw (ex-info (.Message e) ;;; .getMessage 463 | (merge {:type :reader-exception} 464 | (if (indexing-reader? reader) 465 | {:line (get-line-number reader) 466 | :column (get-column-number reader) 467 | :file (get-file-name reader)})) 468 | e))))))) 469 | 470 | (defn read-string 471 | "Reads one object from the string s. 472 | Returns nil when s is nil or empty. 473 | 474 | Reads data in the edn format (subset of Clojure data): 475 | http://edn-format.org 476 | 477 | opts is a map as per clojure.tools.reader.edn/read" 478 | ([s] (read-string {:eof nil} s)) 479 | ([opts s] 480 | (when (and s (not (identical? s ""))) 481 | (read opts (string-push-back-reader s))))) 482 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/reader.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "A clojure reader in clojure" 10 | :author "Bronsa"} 11 | clojure.tools.reader 12 | (:refer-clojure :exclude [read read-line read-string char read+string 13 | default-data-readers *default-data-reader-fn* 14 | *read-eval* *data-readers* *suppress-read*]) 15 | (:require [clojure.tools.reader.reader-types :refer 16 | [read-char unread peek-char indexing-reader? source-logging-push-back-reader source-logging-reader? 17 | get-line-number get-column-number get-file-name string-push-back-reader log-source]] 18 | [clojure.tools.reader.impl.utils :refer :all] ;; [char ex-info? whitespace? numeric? desugar-meta] 19 | [clojure.tools.reader.impl.errors :as err] 20 | [clojure.tools.reader.impl.commons :refer :all] 21 | [clojure.tools.reader.default-data-readers :as data-readers]) 22 | (:import (clojure.lang PersistentHashSet IMeta 23 | RT Symbol Reflector Var IObj 24 | PersistentVector IRecord Namespace) 25 | clojure.tools.reader.reader_types.SourceLoggingPushbackReader 26 | ;;; java.lang.reflect.Constructor 27 | (System.Text.RegularExpressions Regex))) ;;; java.util.regex.Pattern) 28 | ;;; (java.util List LinkedList) 29 | 30 | (set! *warn-on-reflection* true) 31 | 32 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 33 | ;; helpers 34 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 35 | 36 | (declare ^:private read* 37 | macros dispatch-macros 38 | ^:dynamic *read-eval* 39 | ^:dynamic *data-readers* 40 | ^:dynamic *default-data-reader-fn* 41 | ^:dynamic *suppress-read* 42 | default-data-readers) 43 | 44 | (defn ^:private ns-name* [x] 45 | (if (instance? Namespace x) 46 | (name (ns-name x)) 47 | (name x))) 48 | 49 | (defn- macro-terminating? [ch] 50 | (case ch 51 | (\" \; \@ \^ \` \~ \( \) \[ \] \{ \} \\) true 52 | false)) 53 | 54 | ;; DM: Serious hacking on read-token to make it work for |-quoting. 55 | ;; 56 | ;; The original read-token just below is renamed to read-token-not-symbol. 57 | ;; Also, moved the initch check to the caller. 58 | 59 | (defn- ^String read-token-not-symbol 60 | "Read in a single logical token from the reader" 61 | [rdr kind initch] 62 | (loop [sb (StringBuilder.) ch initch] 63 | (if (or (whitespace? ch) 64 | (macro-terminating? ch) 65 | (nil? ch)) 66 | (do (when ch 67 | (unread rdr ch)) 68 | (str sb)) 69 | (recur (.Append sb ch) (read-char rdr))))) ;;; .append 70 | 71 | 72 | ;; this version allows for |-escaping 73 | 74 | (defn- ^String read-token-symbol 75 | "Read in a single logical token from the reader" 76 | [rdr kind initch] 77 | (let [rawMode (= initch \|) 78 | sb (StringBuilder.) 79 | startch (if rawMode (read-char rdr) initch)] 80 | (when rawMode 81 | (.Append sb initch)) 82 | 83 | (loop [sb sb ch startch rawMode rawMode] 84 | (when (and rawMode (nil? ch)) 85 | (err/throw-eof-reading rdr :symbol sb)) 86 | (if rawMode 87 | (cond 88 | (nil? ch) 89 | (err/throw-eof-reading rdr :symbol sb) 90 | (and (= ch \|) (= (peek-char rdr) '\|)) ;; || in raw mode, eat both 91 | (do (read-char rdr) ;; eat the second | 92 | (recur (.Append sb "||") (read-char rdr) (boolean true))) 93 | :else (recur (.Append sb ch) (read-char rdr) (boolean (not= ch \|)))) 94 | (if (or (whitespace? ch) 95 | (macro-terminating? ch) 96 | (nil? ch)) 97 | (do (when ch 98 | (unread rdr ch)) 99 | (str sb)) 100 | (recur (.Append sb ch) (read-char rdr) rawMode)))))) 101 | 102 | (defn- ^String read-token 103 | "Read in a single logical token from the reader" 104 | [rdr kind initch] 105 | (if-not initch 106 | (err/throw-eof-at-start rdr kind) 107 | (if (= kind :symbol) 108 | (read-token-symbol rdr kind initch) 109 | (read-token-not-symbol rdr kind initch)))) 110 | 111 | (declare read-tagged) 112 | 113 | (defn- read-dispatch 114 | [rdr _ opts pending-forms] 115 | (if-let [ch (read-char rdr)] 116 | (if-let [dm (dispatch-macros ch)] 117 | (dm rdr ch opts pending-forms) 118 | (read-tagged (doto rdr (unread ch)) ch opts pending-forms)) ;; ctor reader is implemented as a tagged literal 119 | (err/throw-eof-at-dispatch rdr))) 120 | 121 | (defn- read-unmatched-delimiter 122 | [rdr ch opts pending-forms] 123 | (err/throw-unmatch-delimiter rdr ch)) 124 | 125 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 126 | ;; readers 127 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 128 | 129 | (defn read-regex 130 | [rdr ch opts pending-forms] 131 | (let [sb (StringBuilder.)] 132 | (loop [ch (read-char rdr)] 133 | (if (identical? \" ch) 134 | (Regex. (str sb)) ;;; Pattern/compile 135 | (if (nil? ch) 136 | (err/throw-eof-reading rdr :regex sb) 137 | (do 138 | (.Append sb ch ) ;;; .append 139 | (when (identical? \\ ch) 140 | (let [ch (read-char rdr)] 141 | (if (nil? ch) 142 | (err/throw-eof-reading rdr :regex sb)) 143 | (.Append sb ch))) ;;; .append 144 | (recur (read-char rdr)))))))) 145 | 146 | (defn- read-unicode-char 147 | ([^String token ^long offset ^long length ^long base] 148 | (let [l (+ offset length)] 149 | (when-not (== (count token) l) 150 | (err/throw-invalid-unicode-literal nil token)) 151 | (loop [i offset uc 0] 152 | (if (== i l) 153 | (char uc) 154 | (let [d (char-value-in-radix (int (nth token i)) (int base))] ;;; Character/digit 155 | (if (== d -1) 156 | (err/throw-invalid-unicode-digit-in-token nil (nth token i) token) 157 | (recur (inc i) (long (+ d (* uc base)))))))))) 158 | 159 | ([rdr initch base length exact?] 160 | (let [base (long base) 161 | length (long length)] 162 | (loop [i 1 uc (long (char-value-in-radix (int initch) (int base)))] ;;; Character/digit 163 | (if (== uc -1) 164 | (err/throw-invalid-unicode-digit rdr initch) 165 | (if-not (== i length) 166 | (let [ch (peek-char rdr)] 167 | (if (or (whitespace? ch) 168 | (macros ch) 169 | (nil? ch)) 170 | (if exact? 171 | (err/throw-invalid-unicode-len rdr i length) 172 | (char uc)) 173 | (let [d (char-value-in-radix (int ch) (int base))] ;;; Character/digit 174 | (read-char rdr) 175 | (if (== d -1) 176 | (err/throw-invalid-unicode-digit rdr ch) 177 | (recur (inc i) (long (+ d (* uc base)))))))) 178 | (char uc))))))) 179 | 180 | (def ^:private ^:const upper-limit (int \uD7ff)) 181 | (def ^:private ^:const lower-limit (int \uE000)) 182 | 183 | (defn- read-char* 184 | "Read in a character literal" 185 | [rdr backslash opts pending-forms] 186 | (let [ch (read-char rdr)] 187 | (if-not (nil? ch) 188 | (let [token (if (or (macro-terminating? ch) 189 | (whitespace? ch)) 190 | (str ch) 191 | (read-token rdr :character ch)) 192 | token-len (count token)] 193 | (cond 194 | 195 | (== 1 token-len) (char (nth token 0)) ;;; Character/valueOf 196 | 197 | (= token "newline") \newline 198 | (= token "space") \space 199 | (= token "tab") \tab 200 | (= token "backspace") \backspace 201 | (= token "formfeed") \formfeed 202 | (= token "return") \return 203 | 204 | (.StartsWith token "u") ;;; .startsWith 205 | (let [c (read-unicode-char token 1 4 16) 206 | ic (int c)] 207 | (if (and (> ic upper-limit) 208 | (< ic lower-limit)) 209 | (err/throw-invalid-character-literal rdr (.ToString ic "x")) ;;; (Integer/toString ic 16) 210 | c)) 211 | 212 | (.StartsWith token "o") ;;; .startsWith 213 | (let [len (dec token-len)] 214 | (if (> len 3) 215 | (err/throw-invalid-octal-len rdr token) 216 | (let [uc (read-unicode-char token 1 len 8)] 217 | (if (> (int uc) 0377) 218 | (err/throw-bad-octal-number rdr) 219 | uc)))) 220 | 221 | :else (err/throw-unsupported-character rdr token))) 222 | (err/throw-eof-in-character rdr)))) 223 | 224 | (defn ^:private starting-line-col-info [rdr] 225 | (when (indexing-reader? rdr) 226 | [(get-line-number rdr) (int (dec (int (get-column-number rdr))))])) 227 | 228 | (defn ^:private ending-line-col-info [rdr] 229 | (when (indexing-reader? rdr) 230 | [(get-line-number rdr) (get-column-number rdr)])) 231 | 232 | (defonce ^:private READ_EOF (Object.)) 233 | (defonce ^:private READ_FINISHED (Object.)) 234 | 235 | (def ^:dynamic *read-delim* false) 236 | (defn- ^PersistentVector read-delimited 237 | "Reads and returns a collection ended with delim" 238 | [kind delim rdr opts pending-forms] 239 | (let [[start-line start-column] (starting-line-col-info rdr) 240 | delim (char delim)] 241 | (binding [*read-delim* true] 242 | (loop [a (transient [])] 243 | (let [form (read* rdr false READ_EOF delim opts pending-forms)] 244 | (if (identical? form READ_FINISHED) 245 | (persistent! a) 246 | (if (identical? form READ_EOF) 247 | (err/throw-eof-delimited rdr kind start-line start-column (count a)) 248 | (recur (conj! a form))))))))) 249 | 250 | (defn- read-list 251 | "Read in a list, including its location if the reader is an indexing reader" 252 | [rdr _ opts pending-forms] 253 | (let [[start-line start-column] (starting-line-col-info rdr) 254 | the-list (read-delimited :list \) rdr opts pending-forms) 255 | [end-line end-column] (ending-line-col-info rdr)] 256 | (with-meta (if (empty? the-list) 257 | '() 258 | (clojure.lang.PersistentList/create the-list)) 259 | (when start-line 260 | (merge 261 | (when-let [file (get-file-name rdr)] 262 | {:file file}) 263 | {:line start-line 264 | :column start-column 265 | :end-line end-line 266 | :end-column end-column}))))) 267 | 268 | (defn- read-vector 269 | "Read in a vector, including its location if the reader is an indexing reader" 270 | [rdr _ opts pending-forms] 271 | (let [[start-line start-column] (starting-line-col-info rdr) 272 | the-vector (read-delimited :vector \] rdr opts pending-forms) 273 | [end-line end-column] (ending-line-col-info rdr)] 274 | (with-meta the-vector 275 | (when start-line 276 | (merge 277 | (when-let [file (get-file-name rdr)] 278 | {:file file}) 279 | {:line start-line 280 | :column start-column 281 | :end-line end-line 282 | :end-column end-column}))))) 283 | 284 | (defn- read-map 285 | "Read in a map, including its location if the reader is an indexing reader" 286 | [rdr _ opts pending-forms] 287 | (let [[start-line start-column] (starting-line-col-info rdr) 288 | the-map (read-delimited :map \} rdr opts pending-forms) 289 | map-count (count the-map) 290 | [end-line end-column] (ending-line-col-info rdr)] 291 | (when (odd? map-count) 292 | (err/throw-odd-map rdr start-line start-column the-map)) 293 | (with-meta 294 | (if (zero? map-count) 295 | {} 296 | (RT/map (to-array the-map))) 297 | (when start-line 298 | (merge 299 | (when-let [file (get-file-name rdr)] 300 | {:file file}) 301 | {:line start-line 302 | :column start-column 303 | :end-line end-line 304 | :end-column end-column}))))) 305 | 306 | (defn- read-number 307 | [rdr initch] 308 | (loop [sb (doto (StringBuilder.) (.Append initch)) ;;; .append 309 | ch (read-char rdr)] 310 | (if (or (whitespace? ch) (macros ch) (nil? ch)) 311 | (let [s (str sb)] 312 | (when ch (unread rdr ch)) 313 | (or (match-number s) 314 | (err/throw-invalid-number rdr s))) 315 | (recur (doto sb (.Append ch)) (read-char rdr))))) ;;; .append 316 | 317 | (defn- escape-char [sb rdr] 318 | (let [ch (read-char rdr)] 319 | (case ch 320 | \t "\t" 321 | \r "\r" 322 | \n "\n" 323 | \\ "\\" 324 | \" "\"" 325 | \b "\b" 326 | \f "\f" 327 | \u (let [ch (read-char rdr)] 328 | (if (== -1 (char-value-in-radix (int ch) 16)) ;;; Character/digit 329 | (err/throw-invalid-unicode-escape rdr ch) 330 | (read-unicode-char rdr ch 16 4 true))) 331 | (if (numeric? ch) 332 | (let [ch (read-unicode-char rdr ch 8 3 false)] 333 | (if (> (int ch) 0377) 334 | (err/throw-bad-octal-number rdr) 335 | ch)) 336 | (err/throw-bad-escape-char rdr ch))))) 337 | 338 | (defn- read-string* 339 | [reader _ opts pending-forms] 340 | (loop [sb (StringBuilder.) 341 | ch (read-char reader)] 342 | (case ch 343 | nil (err/throw-eof-reading reader :string sb) 344 | \\ (recur (doto sb (.Append (escape-char sb reader))) ;;; .append 345 | (read-char reader)) 346 | \" (str sb) 347 | (recur (doto sb (.Append ch)) (read-char reader))))) ;;; .append 348 | 349 | (defn- read-symbol 350 | [rdr initch] 351 | (let [[line column] (starting-line-col-info rdr)] 352 | (when-let [token (read-token rdr :symbol initch)] 353 | (case token 354 | 355 | ;; special symbols 356 | "nil" nil 357 | "true" true 358 | "false" false 359 | "/" '/ 360 | 361 | (or (when-let [p (parse-symbol token)] 362 | (with-meta (symbol (p 0) (p 1)) 363 | (when line 364 | (merge 365 | (when-let [file (get-file-name rdr)] 366 | {:file file}) 367 | (let [[end-line end-column] (ending-line-col-info rdr)] 368 | {:line line 369 | :column column 370 | :end-line end-line 371 | :end-column end-column}))))) 372 | (err/throw-invalid rdr :symbol token)))))) 373 | 374 | (def ^:dynamic *alias-map* 375 | "Map from ns alias to ns, if non-nil, it will be used to resolve read-time 376 | ns aliases instead of (ns-aliases *ns*). 377 | 378 | Defaults to nil" 379 | nil) 380 | 381 | (defn- resolve-alias [sym] 382 | ((or *alias-map* 383 | (ns-aliases *ns*)) sym)) 384 | 385 | (defn- resolve-ns [sym] 386 | (or (resolve-alias sym) 387 | (find-ns sym))) 388 | 389 | (defn- read-keyword 390 | [reader initch opts pending-forms] 391 | (let [ch (read-char reader)] 392 | (if-not (whitespace? ch) 393 | (let [token (read-token reader :keyword ch) 394 | s (parse-symbol token)] 395 | (if s 396 | (let [^String ns (s 0) 397 | ^String name (s 1)] 398 | (if (identical? \: (nth token 0)) 399 | (if ns 400 | (let [ns (resolve-alias (symbol (subs ns 1)))] 401 | (if ns 402 | (keyword (str ns) name) 403 | (err/throw-invalid reader :keyword (str \: token)))) 404 | (keyword (str *ns*) (subs name 1))) 405 | (keyword ns name))) 406 | (err/throw-invalid reader :keyword (str \: token)))) 407 | (err/throw-single-colon reader)))) 408 | 409 | (defn- wrapping-reader 410 | "Returns a function which wraps a reader in a call to sym" 411 | [sym] 412 | (fn [rdr _ opts pending-forms] 413 | (list sym (read* rdr true nil opts pending-forms)))) 414 | 415 | (defn- read-meta 416 | "Read metadata and return the following object with the metadata applied" 417 | [rdr _ opts pending-forms] 418 | (log-source rdr 419 | (let [[line column] (starting-line-col-info rdr) 420 | m (desugar-meta (read* rdr true nil opts pending-forms))] 421 | (when-not (map? m) 422 | (err/throw-bad-metadata rdr m)) 423 | (let [o (read* rdr true nil opts pending-forms)] 424 | (if (instance? IMeta o) 425 | (let [m (if (and line (seq? o)) 426 | (merge m :line line :column column) 427 | m)] 428 | (if (instance? IObj o) 429 | (with-meta o (merge (meta o) m)) 430 | (reset-meta! o m))) 431 | (err/throw-bad-metadata-target rdr o)))))) 432 | 433 | (defn- read-set 434 | [rdr _ opts pending-forms] 435 | (let [[start-line start-column] (starting-line-col-info rdr) 436 | ;; subtract 1 from start-column so it includes the # in the leading #{ 437 | start-column (if start-column (int (dec (int start-column)))) 438 | the-set (PersistentHashSet/createWithCheck 439 | (read-delimited :set \} rdr opts pending-forms)) 440 | [end-line end-column] (ending-line-col-info rdr)] 441 | (with-meta the-set 442 | (when start-line 443 | (merge 444 | (when-let [file (get-file-name rdr)] 445 | {:file file}) 446 | {:line start-line 447 | :column start-column 448 | :end-line end-line 449 | :end-column end-column}))))) 450 | 451 | (defn- read-discard 452 | "Read and discard the first object from rdr" 453 | [rdr _ opts pending-forms] 454 | (doto rdr 455 | (read* true nil opts pending-forms))) 456 | 457 | (defn- read-symbolic-value 458 | [rdr _ opts pending-forms] 459 | (let [sym (read* rdr true nil opts pending-forms)] 460 | (case sym 461 | Inf Double/PositiveInfinity ;;; Double/POSITIVE_INFINITY 462 | -Inf Double/NegativeInfinity ;;; Double/NEGATIVE_INFINITY 463 | NaN Double/NaN 464 | (err/reader-error rdr (str "Invalid token: ##" sym))))) 465 | 466 | (def ^:private RESERVED_FEATURES #{:else :none}) 467 | 468 | (defn- has-feature? 469 | [rdr feature opts] 470 | (if (keyword? feature) 471 | (or (= :default feature) (contains? (get opts :features) feature)) 472 | (err/throw-feature-not-keyword rdr feature))) 473 | 474 | ;; WIP, move to errors in the future 475 | (defn- check-eof-error 476 | [form rdr ^long first-line] 477 | (when (identical? form READ_EOF) 478 | (err/throw-eof-error rdr (and (< first-line 0) first-line)))) 479 | 480 | (defn- check-reserved-features 481 | [rdr form] 482 | (when (get RESERVED_FEATURES form) 483 | (err/reader-error rdr "Feature name " form " is reserved"))) 484 | 485 | (defn- check-invalid-read-cond 486 | [form rdr ^long first-line] 487 | (when (identical? form READ_FINISHED) 488 | (if (< first-line 0) 489 | (err/reader-error rdr "read-cond requires an even number of forms") 490 | (err/reader-error rdr "read-cond starting on line " first-line " requires an even number of forms")))) 491 | 492 | (defn- read-suppress 493 | "Read next form and suppress. Return nil or READ_FINISHED." 494 | [first-line rdr opts pending-forms] 495 | (binding [*suppress-read* true] 496 | (let [form (read* rdr false READ_EOF \) opts pending-forms)] 497 | (check-eof-error form rdr first-line) 498 | (when (identical? form READ_FINISHED) 499 | READ_FINISHED)))) 500 | 501 | (def ^:private NO_MATCH (Object.)) 502 | 503 | (defn- match-feature 504 | "Read next feature. If matched, read next form and return. 505 | Otherwise, read and skip next form, returning READ_FINISHED or nil." 506 | [first-line rdr opts pending-forms] 507 | (let [feature (read* rdr false READ_EOF \) opts pending-forms)] 508 | (check-eof-error feature rdr first-line) 509 | (if (= feature READ_FINISHED) 510 | READ_FINISHED 511 | (do 512 | (check-reserved-features rdr feature) 513 | (if (has-feature? rdr feature opts) 514 | ;; feature matched, read selected form 515 | (doto (read* rdr false READ_EOF \) opts pending-forms) 516 | (check-eof-error rdr first-line) 517 | (check-invalid-read-cond rdr first-line)) 518 | ;; feature not matched, ignore next form 519 | (or (read-suppress first-line rdr opts pending-forms) 520 | NO_MATCH)))))) 521 | 522 | (defn- read-cond-delimited 523 | [rdr splicing opts pending-forms] 524 | (let [first-line (if (indexing-reader? rdr) (get-line-number rdr) -1) 525 | result (loop [matched NO_MATCH 526 | finished nil] 527 | (cond 528 | ;; still looking for match, read feature+form 529 | (identical? matched NO_MATCH) 530 | (let [match (match-feature first-line rdr opts pending-forms)] 531 | (if (identical? match READ_FINISHED) 532 | READ_FINISHED 533 | (recur match nil))) 534 | 535 | ;; found match, just read and ignore the rest 536 | (not (identical? finished READ_FINISHED)) 537 | (recur matched (read-suppress first-line rdr opts pending-forms)) 538 | 539 | :else 540 | matched))] 541 | (if (identical? result READ_FINISHED) 542 | rdr 543 | (if splicing 544 | (if (instance? |System.Collections.Generic.IList`1[System.Object]| result) ;;; List 545 | (do 546 | (add-front pending-forms result) ;;; (.addAll ^List pending-forms 0 ^List result) 547 | rdr) 548 | (err/reader-error rdr "Spliced form list in read-cond-splicing must implement java.util.List.")) 549 | result)))) 550 | 551 | (defn- read-cond 552 | [rdr _ opts pending-forms] 553 | (when (not (and opts (#{:allow :preserve} (:read-cond opts)))) 554 | (throw (Exception. "Conditional read not allowed"))) ;;; RuntimeException. 555 | (if-let [ch (read-char rdr)] 556 | (let [splicing (= ch \@) 557 | ch (if splicing (read-char rdr) ch)] 558 | (when splicing 559 | (when-not *read-delim* 560 | (err/reader-error rdr "cond-splice not in list"))) 561 | (if-let [ch (if (whitespace? ch) (read-past whitespace? rdr) ch)] 562 | (if (not= ch \() 563 | (throw (Exception. "read-cond body must be a list")) ;;; RuntimeException. 564 | (binding [*suppress-read* (or *suppress-read* (= :preserve (:read-cond opts)))] 565 | (if *suppress-read* 566 | (reader-conditional (read-list rdr ch opts pending-forms) splicing) 567 | (read-cond-delimited rdr splicing opts pending-forms)))) 568 | (err/throw-eof-in-character rdr))) 569 | (err/throw-eof-in-character rdr))) 570 | 571 | (def ^:private ^:dynamic arg-env) 572 | 573 | (defn- garg 574 | "Get a symbol for an anonymous ?argument?" 575 | [^long n] 576 | (symbol (str (if (== -1 n) "rest" (str "p" n)) 577 | "__" (RT/nextID) "#"))) 578 | 579 | (defn- read-fn 580 | [rdr _ opts pending-forms] 581 | (if (thread-bound? #'arg-env) 582 | (throw (InvalidOperationException. "Nested #()s are not allowed"))) ;;; IllegalStateException 583 | (binding [arg-env (sorted-map)] 584 | (let [form (read* (doto rdr (unread \()) true nil opts pending-forms) ;; this sets bindings 585 | rargs (rseq arg-env) 586 | args (if rargs 587 | (let [higharg (long (key ( first rargs)))] 588 | (let [args (loop [i 1 args (transient [])] 589 | (if (> i higharg) 590 | (persistent! args) 591 | (recur (inc i) (conj! args (or (get arg-env i) 592 | (garg i)))))) 593 | args (if (arg-env -1) 594 | (conj args '& (arg-env -1)) 595 | args)] 596 | args)) 597 | [])] 598 | (list 'fn* args form)))) 599 | 600 | (defn- register-arg 601 | "Registers an argument to the arg-env" 602 | [n] 603 | (if (thread-bound? #'arg-env) 604 | (if-let [ret (arg-env n)] 605 | ret 606 | (let [g (garg n)] 607 | (set! arg-env (assoc arg-env n g)) 608 | g)) 609 | (throw (InvalidOperationException. "Arg literal not in #()")))) ;; should never hit this ;;; IllegalStateException 610 | 611 | (declare read-symbol) 612 | 613 | (defn- read-arg 614 | [rdr pct opts pending-forms] 615 | (if-not (thread-bound? #'arg-env) 616 | (read-symbol rdr pct) 617 | (let [ch (peek-char rdr)] 618 | (cond 619 | (or (whitespace? ch) 620 | (macro-terminating? ch) 621 | (nil? ch)) 622 | (register-arg 1) 623 | 624 | (identical? ch \&) 625 | (do (read-char rdr) 626 | (register-arg -1)) 627 | 628 | :else 629 | (let [n (read* rdr true nil opts pending-forms)] 630 | (if-not (integer? n) 631 | (throw (InvalidOperationException. "Arg literal must be %, %& or %integer")) ;;; IllegalStateException 632 | (register-arg n))))))) 633 | 634 | (defn- read-eval 635 | "Evaluate a reader literal" 636 | [rdr _ opts pending-forms] 637 | (when-not *read-eval* 638 | (err/reader-error rdr "#= not allowed when *read-eval* is false")) 639 | (eval (read* rdr true nil opts pending-forms))) 640 | 641 | (def ^:private ^:dynamic gensym-env nil) 642 | 643 | (defn- read-unquote 644 | [rdr comma opts pending-forms] 645 | (if-let [ch (peek-char rdr)] 646 | (if (identical? \@ ch) 647 | ((wrapping-reader 'clojure.core/unquote-splicing) (doto rdr read-char) \@ opts pending-forms) 648 | ((wrapping-reader 'clojure.core/unquote) rdr \~ opts pending-forms)))) 649 | 650 | (declare syntax-quote*) 651 | (defn- unquote-splicing? [form] 652 | (and (seq? form) 653 | (= (first form) 'clojure.core/unquote-splicing))) 654 | 655 | (defn- unquote? [form] 656 | (and (seq? form) 657 | (= (first form) 'clojure.core/unquote))) 658 | 659 | (defn- expand-list 660 | "Expand a list by resolving its syntax quotes and unquotes" 661 | [s] 662 | (loop [s (seq s) r (transient [])] 663 | (if s 664 | (let [item (first s) 665 | ret (conj! r 666 | (cond 667 | (unquote? item) (list 'clojure.core/list (second item)) 668 | (unquote-splicing? item) (second item) 669 | :else (list 'clojure.core/list (syntax-quote* item))))] 670 | (recur (next s) ret)) 671 | (seq (persistent! r))))) 672 | 673 | (defn- flatten-map 674 | "Flatten a map into a seq of alternate keys and values" 675 | [form] 676 | (loop [s (seq form) key-vals (transient [])] 677 | (if s 678 | (let [e (first s)] 679 | (recur (next s) (-> key-vals 680 | (conj! (key e)) 681 | (conj! (val e))))) 682 | (seq (persistent! key-vals))))) 683 | 684 | (defn- register-gensym [sym] 685 | (if-not gensym-env 686 | (throw (InvalidOperationException. "Gensym literal not in syntax-quote"))) ;;; IllegalStateException 687 | (or (get gensym-env sym) 688 | (let [gs (symbol (str (subs (name sym) 689 | 0 (dec (count (name sym)))) 690 | "__" (RT/nextID) "__auto__"))] 691 | (set! gensym-env (assoc gensym-env sym gs)) 692 | gs))) 693 | 694 | (defn ^:dynamic resolve-symbol 695 | "Resolve a symbol s into its fully qualified namespace version" 696 | [s] 697 | (if (pos? (.IndexOf (name s) ".")) ;;; .indexOf 698 | (if (.EndsWith (name s) ".") ;;; .endsWith 699 | (let [csym (symbol (subs (name s) 0 (dec (count (name s)))))] 700 | (symbol (str (name (resolve-symbol csym)) "."))) 701 | s) 702 | (if-let [ns-str (namespace s)] 703 | (let [ns (resolve-ns (symbol ns-str))] 704 | (if (or (nil? ns) 705 | (= (ns-name* ns) ns-str)) ;; not an alias 706 | s 707 | (symbol (ns-name* ns) (name s)))) 708 | (if-let [o ((ns-map *ns*) s)] 709 | (if (class? o) 710 | (symbol (clojure.lang.Util/NameForType o)) ;;; (.getName ^Class o) -- need NameForType to handle nastiness 711 | (if (var? o) 712 | (symbol (-> ^Var o .ns ns-name*) (-> ^Var o .sym name)))) 713 | (symbol (ns-name* *ns*) (name s)))))) 714 | 715 | (defn- add-meta [form ret] 716 | (if (and (instance? IObj form) 717 | (seq (dissoc (meta form) :line :column :end-line :end-column :file :source))) 718 | (list 'clojure.core/with-meta ret (syntax-quote* (meta form))) 719 | ret)) 720 | 721 | (defn- syntax-quote-coll [type coll] 722 | ;; We use sequence rather than seq here to fix http://dev.clojure.org/jira/browse/CLJ-1444 723 | ;; But because of http://dev.clojure.org/jira/browse/CLJ-1586 we still need to call seq on the form 724 | (let [res (list 'clojure.core/sequence 725 | (list 'clojure.core/seq 726 | (cons 'clojure.core/concat 727 | (expand-list coll))))] 728 | (if type 729 | (list 'clojure.core/apply type res) 730 | res))) 731 | 732 | (defn map-func 733 | "Decide which map type to use, array-map if less than 16 elements" 734 | [coll] 735 | (if (>= (count coll) 16) 736 | 'clojure.core/hash-map 737 | 'clojure.core/array-map)) 738 | 739 | (defn- syntax-quote* [form] 740 | (->> 741 | (cond 742 | (special-symbol? form) (list 'quote form) 743 | 744 | (symbol? form) 745 | (list 'quote 746 | (if (namespace form) 747 | (let [maybe-class ((ns-map *ns*) 748 | (symbol (namespace form)))] 749 | (if (class? maybe-class) 750 | (symbol (.Name ^Type maybe-class) (name form)) ;;; .getName ^Class 751 | (resolve-symbol form))) 752 | (let [sym (str form)] 753 | (cond 754 | (.EndsWith sym "#") ;;; .endsWith 755 | (register-gensym form) 756 | 757 | (.StartsWith sym ".") ;;; .startsWith 758 | form 759 | 760 | :else (resolve-symbol form))))) 761 | 762 | (unquote? form) (second form) 763 | (unquote-splicing? form) (throw (InvalidOperationException. "unquote-splice not in list")) ;;; IllegalStateException. 764 | 765 | (coll? form) 766 | (cond 767 | 768 | (instance? IRecord form) form 769 | (map? form) (syntax-quote-coll (map-func form) (flatten-map form)) 770 | (vector? form) (list 'clojure.core/vec (syntax-quote-coll nil form)) 771 | (set? form) (syntax-quote-coll 'clojure.core/hash-set form) 772 | (or (seq? form) (list? form)) 773 | (let [seq (seq form)] 774 | (if seq 775 | (syntax-quote-coll nil seq) 776 | '(clojure.core/list))) 777 | 778 | :else (throw (InvalidOperationException. "Unknown Collection type"))) ;;; UnsupportedOperationException. 779 | 780 | (or (keyword? form) 781 | (number? form) 782 | (char? form) 783 | (string? form) 784 | (nil? form) 785 | (instance? Boolean form) 786 | (instance? Regex form)) ;;; Pattern 787 | form 788 | 789 | :else (list 'quote form)) 790 | (add-meta form))) 791 | 792 | (defn- read-syntax-quote 793 | [rdr backquote opts pending-forms] 794 | (binding [gensym-env {}] 795 | (-> (read* rdr true nil opts pending-forms) 796 | syntax-quote*))) 797 | 798 | (defn- read-namespaced-map 799 | [rdr _ opts pending-forms] 800 | (let [[start-line start-column] (starting-line-col-info rdr) 801 | token (read-token rdr :namespaced-map (read-char rdr))] 802 | (if-let [ns (cond 803 | (= token ":") 804 | (ns-name *ns*) 805 | 806 | (= \: (first token)) 807 | (some-> token (subs 1) parse-symbol second' symbol resolve-ns) 808 | 809 | :else 810 | (some-> token parse-symbol second'))] 811 | 812 | (let [ch (read-past whitespace? rdr)] 813 | (if (identical? ch \{) 814 | (let [items (read-delimited :namespaced-map \} rdr opts pending-forms) 815 | [end-line end-column] (ending-line-col-info rdr)] 816 | (when (odd? (count items)) 817 | (err/throw-odd-map rdr nil nil items)) 818 | (let [keys (take-nth 2 items) 819 | vals (take-nth 2 (rest items))] 820 | (with-meta 821 | (RT/map (to-array (mapcat list (namespace-keys (str ns) keys) vals))) 822 | (when start-line 823 | (merge 824 | (when-let [file (get-file-name rdr)] 825 | {:file file}) 826 | {:line start-line 827 | :column start-column 828 | :end-line end-line 829 | :end-column end-column}))))) 830 | (err/throw-ns-map-no-map rdr token))) 831 | (err/throw-bad-ns rdr token)))) 832 | 833 | (defn- macros [ch] 834 | (case ch 835 | \" read-string* 836 | \: read-keyword 837 | \; read-comment 838 | \' (wrapping-reader 'quote) 839 | \@ (wrapping-reader 'clojure.core/deref) 840 | \^ read-meta 841 | \` read-syntax-quote ;;(wrapping-reader 'syntax-quote) 842 | \~ read-unquote 843 | \( read-list 844 | \) read-unmatched-delimiter 845 | \[ read-vector 846 | \] read-unmatched-delimiter 847 | \{ read-map 848 | \} read-unmatched-delimiter 849 | \\ read-char* 850 | \% read-arg 851 | \# read-dispatch 852 | nil)) 853 | 854 | (defn- dispatch-macros [ch] 855 | (case ch 856 | \^ read-meta ;deprecated 857 | \' (wrapping-reader 'var) 858 | \( read-fn 859 | \= read-eval 860 | \{ read-set 861 | \< (throwing-reader "Unreadable form") 862 | \" read-regex 863 | \! read-comment 864 | \_ read-discard 865 | \? read-cond 866 | \: read-namespaced-map 867 | \# read-symbolic-value 868 | nil)) 869 | 870 | (defn- read-ctor [rdr class-name opts pending-forms] 871 | (when-not *read-eval* 872 | (err/reader-error rdr "Record construction syntax can only be used when *read-eval* == true")) 873 | (let [class (RT/classForName (name class-name)) ;;; (Class/forName (name class-name) false (RT/baseLoader) 874 | ch (read-past whitespace? rdr)] ;; differs from clojure 875 | (if-let [[end-ch form] (case ch 876 | \[ [\] :short] 877 | \{ [\} :extended] 878 | nil)] 879 | (let [entries (to-array (read-delimited :record-ctor end-ch rdr opts pending-forms)) 880 | numargs (count entries) 881 | all-ctors (.GetConstructors class) 882 | ctors-num (count all-ctors)] ;;; .getConstructors 883 | (case form 884 | :short 885 | (loop [i 0] 886 | (if (>= i ctors-num) 887 | (err/reader-error rdr "Unexpected number of constructor arguments to " (str class) 888 | ": got " numargs) 889 | (if (== (count (.GetParameters ^System.Reflection.ConstructorInfo (aget all-ctors i))) ;;; .getParameterTypes ^Constructor 890 | numargs) 891 | (Reflector/InvokeConstructor class entries) ;;; invokeConstructor 892 | (recur (inc i))))) 893 | :extended 894 | (let [vals (RT/map entries)] 895 | (loop [s (keys vals)] 896 | (if s 897 | (if-not (keyword? (first s)) 898 | (err/reader-error rdr "Unreadable ctor form: key must be of type clojure.lang.Keyword") 899 | (recur (next s))))) 900 | (Reflector/InvokeStaticMethod class "create" (object-array [vals]))))) ;;; invokeStaticMethod 901 | (err/reader-error rdr "Invalid reader constructor form")))) 902 | 903 | (defn- read-tagged [rdr initch opts pending-forms] 904 | (let [tag (read* rdr true nil opts pending-forms)] 905 | (if-not (symbol? tag) 906 | (err/throw-bad-reader-tag rdr tag)) 907 | (if *suppress-read* 908 | (tagged-literal tag (read* rdr true nil opts pending-forms)) 909 | (if-let [f (or (*data-readers* tag) 910 | (default-data-readers tag))] 911 | (f (read* rdr true nil opts pending-forms)) 912 | (if (.Contains (name tag) ".") ;;; .contains 913 | (read-ctor rdr tag opts pending-forms) 914 | (if-let [f *default-data-reader-fn*] 915 | (f tag (read* rdr true nil opts pending-forms)) 916 | (err/throw-unknown-reader-tag rdr tag))))))) 917 | 918 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 919 | ;; Public API 920 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 921 | 922 | (def ^:dynamic *read-eval* 923 | "Defaults to true. 924 | 925 | ***WARNING*** 926 | This setting implies that the full power of the reader is in play, 927 | including syntax that can cause code to execute. It should never be 928 | used with untrusted sources. See also: clojure.tools.reader.edn/read. 929 | 930 | When set to logical false in the thread-local binding, 931 | the eval reader (#=) and *record/type literal syntax* are disabled in read/load. 932 | Example (will fail): (binding [*read-eval* false] (read-string \"#=(* 2 21)\")) 933 | 934 | When set to :unknown all reads will fail in contexts where *read-eval* 935 | has not been explicitly bound to either true or false. This setting 936 | can be a useful diagnostic tool to ensure that all of your reads 937 | occur in considered contexts." 938 | true) 939 | 940 | (def ^:dynamic *data-readers* 941 | "Map from reader tag symbols to data reader Vars. 942 | Reader tags without namespace qualifiers are reserved for Clojure. 943 | Default reader tags are defined in clojure.tools.reader/default-data-readers 944 | and may be overridden by binding this Var." 945 | {}) 946 | 947 | (def ^:dynamic *default-data-reader-fn* 948 | "When no data reader is found for a tag and *default-data-reader-fn* 949 | is non-nil, it will be called with two arguments, the tag and the value. 950 | If *default-data-reader-fn* is nil (the default value), an exception 951 | will be thrown for the unknown tag." 952 | nil) 953 | 954 | (def ^:dynamic *suppress-read* false) 955 | 956 | (def default-data-readers 957 | "Default map of data reader functions provided by Clojure. 958 | May be overridden by binding *data-readers*" 959 | {'inst #'data-readers/read-instant-datetime ;;; read-instant-date 960 | 'uuid #'data-readers/default-uuid-reader}) 961 | 962 | (defn ^:private read* 963 | ([reader eof-error? sentinel opts pending-forms] 964 | (read* reader eof-error? sentinel nil opts pending-forms)) 965 | ([reader eof-error? sentinel return-on opts pending-forms] 966 | (when (= :unknown *read-eval*) 967 | (err/reader-error "Reading disallowed - *read-eval* bound to :unknown")) 968 | (try 969 | (loop [] 970 | (let [ret (log-source reader 971 | (if (seq pending-forms) 972 | (let [pf ^|System.Collections.Generic.LinkedList`1[System.Object]| pending-forms val (-> pf .First .Value)] (.RemoveFirst pf) val) ;;; (.remove ^List pending-forms 0) 973 | (let [ch (read-char reader)] 974 | (cond 975 | (whitespace? ch) reader 976 | (nil? ch) (if eof-error? (err/throw-eof-error reader nil) sentinel) 977 | (= ch return-on) READ_FINISHED 978 | (number-literal? reader ch) (read-number reader ch) 979 | :else (if-let [f (macros ch)] 980 | (f reader ch opts pending-forms) 981 | (read-symbol reader ch))))))] 982 | (if (identical? ret reader) 983 | (recur) 984 | ret))) 985 | (catch Exception e 986 | (if (ex-info? e) 987 | (let [d (ex-data e)] 988 | (if (= :reader-exception (:type d)) 989 | (throw e) 990 | (throw (ex-info (.Message e) ;;; .getMessage 991 | (merge {:type :reader-exception} 992 | d 993 | (if (indexing-reader? reader) 994 | {:line (get-line-number reader) 995 | :column (get-column-number reader) 996 | :file (get-file-name reader)})) 997 | e)))) 998 | (throw (ex-info (.Message e) ;;; .getMessage 999 | (merge {:type :reader-exception} 1000 | (if (indexing-reader? reader) 1001 | {:line (get-line-number reader) 1002 | :column (get-column-number reader) 1003 | :file (get-file-name reader)})) 1004 | e))))))) 1005 | 1006 | (defn read 1007 | "Reads the first object from an IPushbackReader or a java.io.PushbackReader. 1008 | Returns the object read. If EOF, throws if eof-error? is true. 1009 | Otherwise returns sentinel. If no stream is provided, *in* will be used. 1010 | 1011 | Opts is a persistent map with valid keys: 1012 | :read-cond - :allow to process reader conditionals, or 1013 | :preserve to keep all branches 1014 | :features - persistent set of feature keywords for reader conditionals 1015 | :eof - on eof, return value unless :eofthrow, then throw. 1016 | if not specified, will throw 1017 | 1018 | ***WARNING*** 1019 | Note that read can execute code (controlled by *read-eval*), 1020 | and as such should be used only with trusted sources. 1021 | 1022 | To read data structures only, use clojure.tools.reader.edn/read 1023 | 1024 | Note that the function signature of clojure.tools.reader/read and 1025 | clojure.tools.reader.edn/read is not the same for eof-handling" 1026 | {:arglists '([] [reader] [opts reader] [reader eof-error? eof-value])} 1027 | ([] (read *in* true nil)) 1028 | ([reader] (read reader true nil)) 1029 | ([{eof :eof :as opts :or {eof :eofthrow}} reader] 1030 | (when (source-logging-reader? reader) 1031 | (let [^StringBuilder buf (:buffer @(.source-log-frames ^SourceLoggingPushbackReader reader))] 1032 | (.set_Length buf 0))) ;;; .set_Length 1033 | (read* reader (= eof :eofthrow) eof nil opts (|System.Collections.Generic.LinkedList`1[System.Object]|.))) ;;; LinkedList. 1034 | ([reader eof-error? sentinel] 1035 | (when (source-logging-reader? reader) 1036 | (let [^StringBuilder buf (:buffer @(.source-log-frames ^SourceLoggingPushbackReader reader))] 1037 | (.set_Length buf 0))) ;;; .set_Length 1038 | (read* reader eof-error? sentinel nil {} (|System.Collections.Generic.LinkedList`1[System.Object]|.)))) ;;; LinkedList. 1039 | 1040 | (defn read-string 1041 | "Reads one object from the string s. 1042 | Returns nil when s is nil or empty. 1043 | 1044 | ***WARNING*** 1045 | Note that read-string can execute code (controlled by *read-eval*), 1046 | and as such should be used only with trusted sources. 1047 | 1048 | To read data structures only, use clojure.tools.reader.edn/read-string 1049 | 1050 | Note that the function signature of clojure.tools.reader/read-string and 1051 | clojure.tools.reader.edn/read-string is not the same for eof-handling" 1052 | ([s] 1053 | (read-string {} s)) 1054 | ([opts s] 1055 | (when (and s (not (identical? s ""))) 1056 | (read opts (string-push-back-reader s))))) 1057 | 1058 | (defmacro syntax-quote 1059 | "Macro equivalent to the syntax-quote reader macro (`)." 1060 | [form] 1061 | (binding [gensym-env {}] 1062 | (syntax-quote* form))) 1063 | 1064 | (defn read+string 1065 | "Like read, and taking the same args. reader must be a SourceLoggingPushbackReader. 1066 | Returns a vector containing the object read and the (whitespace-trimmed) string read." 1067 | ([] (read+string (source-logging-push-back-reader *in*))) 1068 | ([stream] (read+string stream true nil)) 1069 | ([^SourceLoggingPushbackReader stream eof-error? eof-value] 1070 | (let [^StringBuilder buf (doto ^StringBuilder (:buffer @(.source-log-frames stream)) (.set_Length 0)) ;;; .setLength 1071 | o (log-source stream (read stream eof-error? eof-value)) 1072 | s (.Trim (str (:buffer @(.source-log-frames stream))))] ;;; .trim 1073 | [o s])) 1074 | ([opts ^SourceLoggingPushbackReader stream] 1075 | (let [^StringBuilder buf (doto ^StringBuilder (:buffer @(.source-log-frames stream)) (.set_Length 0)) ;;; .setLength 1076 | o (log-source stream (read opts stream)) 1077 | s (.Trim (str (:buffer @(.source-log-frames stream))))] ;;; .trim ;;; .trim 1078 | [o s]))) --------------------------------------------------------------------------------