449 lines
15 KiB
Clojure
449 lines
15 KiB
Clojure
;; Copyright (c) Nicola Mometto, Rich Hickey & contributors.
|
|
;; The use and distribution terms for this software are covered by the
|
|
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
|
;; which can be found in the file epl-v10.html at the root of this distribution.
|
|
;; By using this software in any fashion, you are agreeing to be bound by
|
|
;; the terms of this license.
|
|
;; You must not remove this notice, or any other, from this software.
|
|
|
|
(ns ^{:doc "An EDN reader in clojure"
|
|
:author "Bronsa"}
|
|
cljs.tools.reader.edn
|
|
(:refer-clojure :exclude [read read-string char default-data-readers])
|
|
(:require [cljs.tools.reader.impl.errors :as err]
|
|
[cljs.tools.reader.reader-types :refer
|
|
[read-char unread peek-char indexing-reader?
|
|
get-line-number get-column-number get-file-name string-push-back-reader]]
|
|
[cljs.tools.reader.impl.utils :refer
|
|
[char ex-info? whitespace? numeric? desugar-meta namespace-keys second' char-code]]
|
|
[cljs.tools.reader.impl.commons :refer
|
|
[number-literal? read-past match-number parse-symbol read-comment throwing-reader]]
|
|
[cljs.tools.reader :refer [default-data-readers]]
|
|
[goog.string :as gstring])
|
|
(:import goog.string.StringBuffer))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; helpers
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(declare read macros dispatch-macros)
|
|
|
|
(defn- ^boolean macro-terminating? [ch]
|
|
(and (not (identical? \# ch))
|
|
(not (identical? \' ch))
|
|
(not (identical? \: ch))
|
|
(macros ch)))
|
|
|
|
(defn- ^boolean not-constituent? [ch]
|
|
(or (identical? \@ ch)
|
|
(identical? \` ch)
|
|
(identical? \~ ch)))
|
|
|
|
(defn- read-token
|
|
([rdr kind initch]
|
|
(read-token rdr kind initch true))
|
|
([rdr kind initch validate-leading?]
|
|
(cond
|
|
(not initch)
|
|
(err/throw-eof-at-start rdr kind)
|
|
|
|
(and validate-leading?
|
|
(not-constituent? initch))
|
|
(err/throw-bad-char rdr kind initch)
|
|
|
|
:else
|
|
(loop [sb (StringBuffer.)
|
|
ch (do (unread rdr initch) initch)]
|
|
(if (or (whitespace? ch)
|
|
(macro-terminating? ch)
|
|
(nil? ch))
|
|
(str sb)
|
|
(if (not-constituent? ch)
|
|
(err/throw-bad-char rdr kind 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
|
|
(err/throw-no-dispatch rdr ch)))
|
|
(err/throw-eof-at-dispatch rdr)))
|
|
|
|
(defn- read-unmatched-delimiter
|
|
[rdr ch opts]
|
|
(err/throw-unmatch-delimiter rdr ch))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; readers
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn- read-unicode-char
|
|
([token offset length base]
|
|
(let [l (+ offset length)]
|
|
(when-not (== (count token) l)
|
|
(err/throw-invalid-unicode-literal nil token))
|
|
(loop [i offset uc 0]
|
|
(if (== i l)
|
|
(js/String.fromCharCode uc)
|
|
(let [d (char-code (nth token i) base)]
|
|
(if (== d -1)
|
|
(err/throw-invalid-unicode-digit-in-token nil (nth token i) token)
|
|
(recur (inc i) (+ d (* uc base)))))))))
|
|
|
|
([rdr initch base length exact?]
|
|
(loop [i 1 uc (char-code initch base)]
|
|
(if (== uc -1)
|
|
(err/throw-invalid-unicode-digit rdr initch)
|
|
(if-not (== i length)
|
|
(let [ch (peek-char rdr)]
|
|
(if (or (whitespace? ch)
|
|
(macros ch)
|
|
(nil? ch))
|
|
(if exact?
|
|
(err/throw-invalid-unicode-len rdr i length)
|
|
(js/String.fromCharCode uc))
|
|
(let [d (char-code ch base)]
|
|
(read-char rdr)
|
|
(if (== d -1)
|
|
(err/throw-invalid-unicode-digit rdr ch)
|
|
(recur (inc i) (+ d (* uc base)))))))
|
|
(js/String.fromCharCode uc))))))
|
|
|
|
(def ^:private ^:const upper-limit (.charCodeAt \uD7ff 0))
|
|
(def ^:private ^:const lower-limit (.charCodeAt \uE000 0))
|
|
|
|
(defn- read-char*
|
|
[rdr backslash opts]
|
|
(let [ch (read-char rdr)]
|
|
(if-not (nil? ch)
|
|
(let [token (if (or (macro-terminating? ch)
|
|
(not-constituent? ch)
|
|
(whitespace? ch))
|
|
(str ch)
|
|
(read-token rdr :character ch false))
|
|
token-len (count token)]
|
|
(cond
|
|
|
|
(== 1 token-len) (nth token 0)
|
|
|
|
(identical? token "newline") \newline
|
|
(identical? token "space") \space
|
|
(identical? token "tab") \tab
|
|
(identical? token "backspace") \backspace
|
|
(identical? token "formfeed") \formfeed
|
|
(identical? token "return") \return
|
|
|
|
(gstring/startsWith token "u")
|
|
(let [c (read-unicode-char token 1 4 16)
|
|
ic (.charCodeAt c)]
|
|
(if (and (> ic upper-limit)
|
|
(< ic lower-limit))
|
|
(err/throw-invalid-character-literal rdr (.toString ic 16))
|
|
c))
|
|
|
|
(gstring/startsWith token "o")
|
|
(let [len (dec token-len)]
|
|
(if (> len 3)
|
|
(err/throw-invalid-octal-len rdr token)
|
|
(let [uc (read-unicode-char token 1 len 8)]
|
|
(if (> (int uc) 0377)
|
|
(err/throw-bad-octal-number rdr)
|
|
uc))))
|
|
|
|
:else (err/throw-unsupported-character rdr token)))
|
|
(err/throw-eof-in-character rdr))))
|
|
|
|
(defn ^:private starting-line-col-info [rdr]
|
|
(when (indexing-reader? rdr)
|
|
[(get-line-number rdr) (int (dec (int (get-column-number rdr))))]))
|
|
|
|
(defn- read-delimited
|
|
[kind delim rdr opts]
|
|
(let [[start-line start-column] (starting-line-col-info rdr)
|
|
delim (char delim)]
|
|
(loop [a (transient [])]
|
|
(let [ch (read-past whitespace? rdr)]
|
|
(when-not ch
|
|
(err/throw-eof-delimited rdr kind start-line start-column (count a)))
|
|
(if (= 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 :list \) rdr opts)]
|
|
(if (empty? the-list)
|
|
'()
|
|
(apply list the-list))))
|
|
|
|
(defn- read-vector
|
|
[rdr _ opts]
|
|
(read-delimited :vector \] rdr opts))
|
|
|
|
|
|
(defn- read-map
|
|
[rdr _ opts]
|
|
(let [[start-line start-column] (starting-line-col-info rdr)
|
|
the-map (read-delimited :map \} rdr opts)
|
|
map-count (count the-map)
|
|
ks (take-nth 2 the-map)
|
|
key-set (set ks)]
|
|
(when (odd? map-count)
|
|
(err/throw-odd-map rdr start-line start-column the-map))
|
|
(when-not (= (count key-set) (count ks))
|
|
(err/throw-dup-keys rdr :map ks))
|
|
(if (<= map-count (* 2 (.-HASHMAP-THRESHOLD cljs.core/PersistentArrayMap)))
|
|
(.fromArray cljs.core/PersistentArrayMap (to-array the-map) true true)
|
|
(.fromArray cljs.core/PersistentHashMap (to-array the-map) true))))
|
|
|
|
(defn- read-number
|
|
[rdr initch opts]
|
|
(loop [sb (doto (StringBuffer.) (.append initch))
|
|
ch (read-char rdr)]
|
|
(if (or (whitespace? ch) (macros ch) (nil? ch))
|
|
(let [s (str sb)]
|
|
(unread rdr ch)
|
|
(or (match-number s)
|
|
(err/throw-invalid-number rdr s)))
|
|
(recur (doto sb (.append ch)) (read-char rdr)))))
|
|
|
|
(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 (js/parseInt (int ch) 16))
|
|
(err/throw-invalid-unicode-escape rdr ch)
|
|
(read-unicode-char rdr ch 16 4 true)))
|
|
(if (numeric? ch)
|
|
(let [ch (read-unicode-char rdr ch 8 3 false)]
|
|
(if (> (int ch) 0377)
|
|
(err/throw-bad-octal-number rdr)
|
|
ch))
|
|
(err/throw-bad-escape-char rdr ch)))))
|
|
|
|
(defn- read-string*
|
|
[rdr _ opts]
|
|
(loop [sb (StringBuffer.)
|
|
ch (read-char rdr)]
|
|
(case ch
|
|
nil (err/throw-eof-reading rdr :string \" sb)
|
|
\\ (recur (doto sb (.append (escape-char sb rdr)))
|
|
(read-char rdr))
|
|
\" (str sb)
|
|
(recur (doto sb (.append ch)) (read-char rdr)))))
|
|
|
|
(defn- read-symbol
|
|
[rdr initch]
|
|
(when-let [token (read-token rdr :symbol initch)]
|
|
(case token
|
|
|
|
;; special symbols
|
|
"nil" nil
|
|
"true" true
|
|
"false" false
|
|
"/" '/
|
|
|
|
(or (when-let [p (parse-symbol token)]
|
|
(symbol (p 0) (p 1)))
|
|
(err/throw-invalid rdr :symbol token)))))
|
|
|
|
(defn- read-keyword
|
|
[reader initch opts]
|
|
(let [ch (read-char reader)]
|
|
(if-not (whitespace? ch)
|
|
(let [token (read-token reader :keyword ch)
|
|
s (parse-symbol token)]
|
|
(if (and s (== -1 (.indexOf token "::")))
|
|
(let [ns (s 0)
|
|
name (s 1)]
|
|
(if (identical? \: (nth token 0))
|
|
(err/throw-invalid reader :keyword token) ;; no ::keyword in edn
|
|
(keyword ns name)))
|
|
(err/throw-invalid reader :keyword token)))
|
|
(err/throw-single-colon reader))))
|
|
|
|
(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)
|
|
(err/throw-bad-metadata rdr m))
|
|
(let [o (read rdr true nil opts)]
|
|
(if (implements? IMeta o)
|
|
(with-meta o (merge (meta o) m))
|
|
(err/throw-bad-metadata-target rdr o)))))
|
|
|
|
(defn- read-set
|
|
[rdr _ opts]
|
|
(let [coll (read-delimited :set \} rdr opts)
|
|
the-set (set coll)]
|
|
(when-not (= (count coll) (count the-set))
|
|
(err/throw-dup-keys rdr :set coll))
|
|
the-set))
|
|
|
|
(defn- read-discard
|
|
[rdr _ opts]
|
|
(doto rdr
|
|
(read true nil true)))
|
|
|
|
(defn- read-namespaced-map
|
|
[rdr _ opts]
|
|
(let [token (read-token rdr :namespaced-map (read-char rdr))]
|
|
(if-let [ns (some-> token parse-symbol second')]
|
|
(let [ch (read-past whitespace? rdr)]
|
|
(if (identical? ch \{)
|
|
(let [items (read-delimited :namespaced-map \} rdr opts)]
|
|
(when (odd? (count items))
|
|
(err/throw-odd-map rdr nil nil items))
|
|
(let [keys (namespace-keys (str ns) (take-nth 2 items))
|
|
vals (take-nth 2 (rest items))]
|
|
(when-not (= (count (set keys)) (count keys))
|
|
(err/throw-dup-keys rdr :namespaced-map keys))
|
|
(zipmap keys vals)))
|
|
(err/throw-ns-map-no-map rdr token)))
|
|
(err/throw-bad-ns rdr token))))
|
|
|
|
(defn- read-symbolic-value
|
|
[rdr _ opts]
|
|
(let [sym (read rdr true nil opts)]
|
|
(case sym
|
|
|
|
NaN js/Number.NaN
|
|
-Inf js/Number.NEGATIVE_INFINITY
|
|
Inf js/Number.POSITIVE_INFINITY
|
|
|
|
(err/reader-error rdr (str "Invalid token: ##" sym)))))
|
|
|
|
(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
|
|
\: read-namespaced-map
|
|
\# read-symbolic-value
|
|
nil))
|
|
|
|
(defn- read-tagged [rdr initch opts]
|
|
(let [tag (read rdr true nil opts)
|
|
object (read rdr true nil opts)]
|
|
(if-not (symbol? tag)
|
|
(err/throw-bad-reader-tag 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)
|
|
(err/throw-unknown-reader-tag rdr tag)))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Public API
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn read
|
|
"Reads the first object from an IPushbackReader.
|
|
Returns the object read. If EOF, throws if eof-error? is true otherwise returns eof.
|
|
If no reader is provided, *in* will be used.
|
|
|
|
Reads data in the edn format (subset of Clojure data):
|
|
http://edn-format.org
|
|
|
|
clojure.tools.reader.edn/read doesn't depend on dynamic Vars, all configuration
|
|
is done by passing an opt map.
|
|
|
|
opts is a map that can include the following keys:
|
|
:eof - value to return on end-of-file. When not supplied, eof throws an exception.
|
|
:readers - a map of tag symbols to data-reader functions to be considered before default-data-readers.
|
|
When not supplied, only the default-data-readers will be used.
|
|
:default - A function of two args, that will, if present and no reader is found for a tag,
|
|
be called with the tag and the value."
|
|
([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
|
|
(loop []
|
|
(let [ch (read-char reader)]
|
|
(cond
|
|
(whitespace? ch) (recur)
|
|
(nil? ch) (if eof-error? (err/throw-eof-error reader nil) eof)
|
|
(number-literal? reader ch) (read-number reader ch opts)
|
|
:else (let [f (macros ch)]
|
|
(if f
|
|
(let [res (f reader ch opts)]
|
|
(if (identical? res reader)
|
|
(recur)
|
|
res))
|
|
(read-symbol reader ch))))))
|
|
(catch js/Error e
|
|
(if (ex-info? e)
|
|
(let [d (ex-data e)]
|
|
(if (= :reader-exception (:type d))
|
|
(throw e)
|
|
(throw (ex-info (.-message e)
|
|
(merge {:type :reader-exception}
|
|
d
|
|
(if (indexing-reader? reader)
|
|
{:line (get-line-number reader)
|
|
:column (get-column-number reader)
|
|
:file (get-file-name reader)}))
|
|
e))))
|
|
(throw (ex-info (.-message e)
|
|
(merge {:type :reader-exception}
|
|
(if (indexing-reader? reader)
|
|
{:line (get-line-number reader)
|
|
:column (get-column-number reader)
|
|
:file (get-file-name reader)}))
|
|
e)))))))
|
|
|
|
(defn read-string
|
|
"Reads one object from the string s.
|
|
Returns nil when s is nil or empty.
|
|
|
|
Reads data in the edn format (subset of Clojure data):
|
|
http://edn-format.org
|
|
|
|
opts is a map as per clojure.tools.reader.edn/read"
|
|
([s] (read-string {:eof nil} s))
|
|
([opts s]
|
|
(when (and s (not= s ""))
|
|
(read opts (string-push-back-reader s)))))
|