Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

366 lines (323 sloc) 12.093 kB
(ns clojure.tools.reader.edn
(:refer-clojure :exclude [read read-line read-string char])
(:require [clojure.tools.reader.reader-types :refer :all]
[clojure.tools.reader.impl
[utils :refer :all]
[commons :refer :all]])
(:import (clojure.lang PersistentHashSet IMeta RT PersistentVector)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare read macros dispatch-macros)
(defn macro-terminating? [ch]
(and (not (identical? \# ch))
(not (identical? \' ch))
(not (identical? \: ch))
(macros ch)))
(defn not-constituent? [ch]
(or (identical? \@ ch)
(identical? \` ch)
(identical? \~ ch)))
(defn ^String read-token
([rdr initch]
(read-token rdr initch true))
([rdr initch validate-leading?]
(cond
(not initch)
(reader-error rdr "EOF while reading")
(and validate-leading?
(not-constituent? initch))
(reader-error rdr "Invalid leading character: " initch)
:else
(loop [sb (doto (StringBuilder.) (.append initch))
ch (peek-char rdr)]
(if (or (whitespace? ch)
(macro-terminating? ch)
(nil? ch))
(str sb)
(if (not-constituent? ch)
(reader-error rdr "Invalid constituent character: " ch)
(recur (doto sb (.append (read-char rdr))) (peek-char rdr))))))))
(declare read-tagged)
(defn read-dispatch
[rdr _ opts]
(if-let [ch (read-char rdr)]
(if-let [dm (dispatch-macros ch)]
(dm rdr ch opts)
(if-let [obj (read-tagged (doto rdr (unread ch)) ch opts)]
obj
(reader-error rdr "No dispatch macro for " ch)))
(reader-error rdr "EOF while reading character")))
(defn read-unmatched-delimiter
[rdr ch opts]
(reader-error rdr "Unmatched delimiter " ch))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; readers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn read-unicode-char
([^String token offset length base]
(let [l (+ offset length)]
(when-not (== (count token) l)
(throw (IllegalArgumentException. (str "Invalid unicode character: \\" token))))
(loop [i offset uc 0]
(if (== i l)
(char uc)
(let [d (Character/digit ^char (nth token i) ^int base)]
(if (== d -1)
(throw (IllegalArgumentException. (str "Invalid digit: " (nth token i))))
(recur (inc i) (long (+ d (* uc base))))))))))
([rdr initch base length exact?]
(loop [i 1 uc (Character/digit ^char initch ^int base)]
(if (== uc -1)
(throw (IllegalArgumentException. (str "Invalid digit: " initch)))
(if-not (== i length)
(let [ch (peek-char rdr)]
(if (or (whitespace? ch)
(macros ch)
(nil? ch))
(if exact?
(throw (IllegalArgumentException.
(str "Invalid character length: " i ", should be: " length)))
(char uc))
(let [d (Character/digit ^char ch ^int base)]
(read-char rdr)
(if (== d -1)
(throw (IllegalArgumentException. (str "Invalid digit: " ch)))
(recur (inc i) (long (+ d (* uc base))))))))
(char uc))))))
(let [upper-limit (int \uD7ff)
lower-limit (int \uE000)]
(defn read-char*
[rdr backslash opts]
(let [ch (read-char rdr)]
(if-not (nil? ch)
(let [token (read-token rdr ch false)
token-len (count token)]
(cond
(== 1 token-len) (Character/valueOf (nth token 0))
(= token "newline") \newline
(= token "space") \space
(= token "tab") \tab
(= token "backspace") \backspace
(= token "formfeed") \formfeed
(= token "return") \return
(.startsWith token "u")
(let [c (read-unicode-char token 1 4 16)
ic (int c)]
(if (and (> ic upper-limit)
(< ic lower-limit))
(reader-error rdr "Invalid character constant: \\u" (Integer/toString ic 16))
c))
(.startsWith token "x")
(read-unicode-char token 1 2 16)
(.startsWith token "o")
(let [len (dec token-len)]
(if (> len 3)
(reader-error rdr "Invalid octal escape sequence length: " len)
(let [uc (read-unicode-char token 1 len 8)]
(if (> (int uc) 0377)
(reader-error rdr "Octal escape sequence must be in range [0, 377]")
uc))))
:else (reader-error rdr "Unsupported character: \\" token)))
(reader-error rdr "EOF while reading character")))))
(defn ^PersistentVector read-delimited
[delim rdr opts]
(let [first-line (when (indexing-reader? rdr)
(get-line-number rdr))
delim ^char delim]
(loop [a (transient [])]
(let [ch (read-past whitespace? rdr)]
(when-not ch
(reader-error rdr "EOF while reading"
(if first-line
(str ", starting at line" first-line))))
(if (identical? delim ^char ch)
(persistent! a)
(if-let [macrofn (macros ch)]
(let [mret (macrofn rdr ch opts)]
(recur (if-not (identical? mret rdr) (conj! a mret) a)))
(let [o (read (doto rdr (unread ch)) true nil opts)]
(recur (if-not (identical? o rdr) (conj! a o) a)))))))))
(defn read-list
[rdr _ opts]
(let [the-list (read-delimited \) rdr opts)]
(if (empty? the-list)
'()
(clojure.lang.PersistentList/create the-list))))
(defn read-vector
[rdr _ opts]
(read-delimited \] rdr opts))
(defn read-map
[rdr _ opts]
(let [l (to-array (read-delimited \} rdr opts))]
(when (== 1 (bit-and (alength l) 1))
(reader-error rdr "Map literal must contain an even number of forms"))
(RT/map l)))
(defn read-number
[reader initch opts]
(loop [sb (doto (StringBuilder.) (.append initch))
ch (read-char reader)]
(if (or (whitespace? ch) (macros ch) (nil? ch))
(let [s (str sb)]
(unread reader ch)
(or (match-number s)
(reader-error reader "Invalid number format [" s "]")))
(recur (doto sb (.append ch)) (read-char reader)))))
(defn escape-char [sb rdr]
(let [ch (read-char rdr)]
(case ch
\t "\t"
\r "\r"
\n "\n"
\\ "\\"
\" "\""
\b "\b"
\f "\f"
\u (let [ch (read-char rdr)]
(if (== -1 (Character/digit ^char ch 16))
(reader-error rdr "Invalid unicode escape: \\u" ch)
(read-unicode-char rdr ch 16 4 true)))
\x (let [ch (read-char rdr)]
(if (== -1 (Character/digit ^char ch 16))
(reader-error rdr "Invalid unicode escape: \\x" ch)
(read-unicode-char rdr ch 16 2 true)))
(if (numeric? ch)
(let [ch (read-unicode-char rdr ch 8 3 false)]
(if (> (int ch) 0337)
(reader-error rdr "Octal escape sequence must be in range [0, 377]")
ch))
(reader-error rdr "Unsupported escape character: \\" ch)))))
(defn read-string*
[reader _ opts]
(loop [sb (StringBuilder.)
ch (read-char reader)]
(case ch
nil (reader-error reader "EOF while reading string")
\\ (recur (doto sb (.append (escape-char sb reader)))
(read-char reader))
\" (str sb)
(recur (doto sb (.append ch)) (read-char reader)))))
(defn read-symbol
[rdr initch]
(when-let [token (read-token rdr initch)]
(case token
;; special symbols
"nil" nil
"true" true
"false" false
"/" '/
"NaN" Double/NaN
"-Infinity" Double/NEGATIVE_INFINITY
("Infinity" "+Infinity") Double/POSITIVE_INFINITY
(or (when-let [p (parse-symbol token)]
(symbol (p 0) (p 1)))
(reader-error rdr "Invalid token: " token)))))
(defn read-keyword
[reader initch opts]
(let [ch (read-char reader)]
(if-not (whitespace? ch)
(let [token (read-token reader ch)
s (parse-symbol token)]
(if (and s (== -1 (.indexOf token "::")))
(let [^String ns (s 0)
^String name (s 1)]
(if (identical? \: (nth token 0))
(reader-error reader "Invalid token: :" token) ;; no ::keyword in edn
(keyword ns name)))
(reader-error reader "Invalid token: :" token)))
(reader-error reader "Invalid token: :"))))
(defn wrapping-reader
[sym]
(fn [rdr _ opts]
(list sym (read rdr true nil opts))))
(defn read-meta
[rdr _ opts]
(let [m (desugar-meta (read rdr true nil opts))]
(when-not (map? m)
(reader-error rdr "Metadata must be Symbol, Keyword, String or Map"))
(let [o (read rdr true nil opts)]
(if (instance? IMeta o)
(with-meta o (merge (meta o) m))
(reader-error rdr "Metadata can only be applied to IMetas")))))
(defn read-set
[rdr _ opts]
(PersistentHashSet/createWithCheck (read-delimited \} rdr opts)))
(defn read-discard
[rdr _ opts]
(read rdr true nil opts)
rdr)
(defn macros [ch]
(case ch
\" read-string*
\: read-keyword
\; read-comment
\^ read-meta
\( read-list
\) read-unmatched-delimiter
\[ read-vector
\] read-unmatched-delimiter
\{ read-map
\} read-unmatched-delimiter
\\ read-char*
\# read-dispatch
nil))
(defn dispatch-macros [ch]
(case ch
\^ read-meta ;deprecated
\{ read-set
\< (throwing-reader "Unreadable form")
\! read-comment
\_ read-discard
nil))
(defn read-tagged [rdr initch opts]
(let [tag (read rdr true nil opts)
object (read rdr true nil opts)]
(if-not (symbol? tag)
(reader-error rdr "Reader tag must be a symbol"))
(if-let [f (or (get (:readers opts) tag)
(default-data-readers tag))]
(f object)
(if-let [d (:default opts)]
(d tag object)
(reader-error rdr "No reader function for tag " (name tag))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Public API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn read
"Reads the first object from an IPushbackReader or a java.io.PushbackReader.
Returns the object read. If EOF, throws if eof-error? is true. Otherwise returns eof."
([] (read *in*))
([reader] (read {} reader))
([{:keys [eof] :as opts} reader]
(let [eof-error? (not (contains? opts :eof))]
(read reader eof-error? eof opts)))
([reader eof-error? eof opts]
(try
(let [ch (read-char reader)]
(cond
(whitespace? ch) (read opts reader)
(nil? ch) (if eof-error? (reader-error reader "EOF") eof)
(number-literal? reader ch) (read-number reader ch opts)
(comment-prefix? ch) (read opts (read-comment reader ch opts))
:else (let [f (macros ch)]
(if f
(let [res (f reader ch opts)]
(if (identical? res reader)
(read opts reader)
res))
(read-symbol reader ch)))))
(catch Exception e
(if (instance? clojure.lang.ExceptionInfo e)
(throw e)
(throw (ex-info (.getMessage e)
(merge {:type :reader-exception}
(if (indexing-reader? reader)
{:line (get-line-number reader)
:column (get-column-number reader)}))
e)))))))
(defn read-string
"Reads one object from the string s"
([s] (read-string {:eof nil} s))
([opts s]
(when s
(read opts (string-push-back-reader s)))))
Jump to Line
Something went wrong with that request. Please try again.