diff --git a/deps.edn b/deps.edn index 37be73d85..c1f13dc16 100644 --- a/deps.edn +++ b/deps.edn @@ -1,10 +1,9 @@ {:paths ["src/main/clojure" "src/main/cljs" "resources"] :deps {com.google.javascript/closure-compiler-unshaded {:mvn/version "v20220502"} - com.cognitect/transit-clj {:mvn/version "1.0.329"} + com.cognitect/transit-java {:mvn/version "1.0.362"} org.clojure/clojure {:mvn/version "1.10.0"} org.clojure/core.specs.alpha {:mvn/version "0.1.24"} - org.clojure/data.json {:mvn/version "2.4.0"} org.clojure/google-closure-library {:mvn/version "0.0-20211011-0726fdeb"} org.clojure/spec.alpha {:mvn/version "0.1.143"} org.clojure/tools.reader {:mvn/version "1.3.6"} diff --git a/pom.template.xml b/pom.template.xml index 6b50ac1f9..28fb75858 100644 --- a/pom.template.xml +++ b/pom.template.xml @@ -37,11 +37,6 @@ google-closure-library 0.0-20211011-0726fdeb - - org.clojure - data.json - 2.4.0 - org.clojure tools.reader @@ -49,8 +44,8 @@ com.cognitect - transit-clj - 1.0.329 + transit-java + 1.0.362 org.clojure @@ -284,8 +279,6 @@ true !clojure.tools.reader.* - !clojure.data.json.* - !cognitect.transit.* diff --git a/project.clj b/project.clj index fbc2417ab..821f29dd7 100644 --- a/project.clj +++ b/project.clj @@ -11,10 +11,9 @@ :dependencies [[org.clojure/clojure "1.10.0"] [org.clojure/spec.alpha "0.1.143"] [org.clojure/core.specs.alpha "0.1.24"] - [org.clojure/data.json "2.4.0"] [org.clojure/tools.reader "1.3.6"] [org.clojure/test.check "1.1.1" :scope "test"] - [com.cognitect/transit-clj "1.0.329"] + [com.cognitect/transit-java "1.0.362"] [org.clojure/google-closure-library "0.0-20211011-0726fdeb"] [com.google.javascript/closure-compiler-unshaded "v20220502"]] :profiles {:1.6 {:dependencies [[org.clojure/clojure "1.6.0"]]} diff --git a/script/bootstrap b/script/bootstrap index 3d78cce70..f28d6e9ea 100755 --- a/script/bootstrap +++ b/script/bootstrap @@ -6,8 +6,6 @@ CLOJURE_RELEASE="1.9.0" SPEC_ALPHA_RELEASE="0.1.143" CORE_SPECS_ALPHA_RELEASE="0.1.24" CLOSURE_RELEASE="20220502" -DJSON_RELEASE="2.4.0" -TRANSIT_RELEASE="1.0.329" GCLOSURE_LIB_RELEASE="0.0-20211011-0726fdeb" TREADER_RELEASE="1.3.6" TEST_CHECK_RELEASE="1.1.1" @@ -41,20 +39,6 @@ cp core.specs.alpha-$CORE_SPECS_ALPHA_RELEASE.jar lib/core.specs.alpha-$CORE_SPE echo "Cleaning up core.specs.alpha..." rm core.specs.alpha-$CORE_SPECS_ALPHA_RELEASE.jar -echo "Fetching data.json..." -curl --retry 3 -O -s https://repo1.maven.org/maven2/org/clojure/data.json/$DJSON_RELEASE/data.json-$DJSON_RELEASE.jar || { echo "Download failed."; exit 1; } -echo "Copying data.json-$DJSON_RELEASE.jar to lib/data.json-$DJSON_RELEASE.jar..." -cp data.json-$DJSON_RELEASE.jar lib/data.json-$DJSON_RELEASE.jar -echo "Cleaning up data.json..." -rm data.json-$DJSON_RELEASE.jar - -echo "Fetching transit-clj..." -curl --retry 3 -O -s https://repo1.maven.org/maven2/com/cognitect/transit-clj/$TRANSIT_RELEASE/transit-clj-$TRANSIT_RELEASE.jar || { echo "Download failed."; exit 1; } -echo "Copying transit-clj-$TRANSIT_RELEASE.jar to lib/transit-clj-$TRANSIT_RELEASE.jar..." -cp transit-clj-$TRANSIT_RELEASE.jar lib/transit-clj-$TRANSIT_RELEASE.jar -echo "Cleaning up transit-clj..." -rm transit-clj-$TRANSIT_RELEASE.jar - echo "Fetching Google Closure library..." mkdir -p closure/library cd closure/library diff --git a/script/vendorize_deps b/script/vendorize_deps new file mode 100755 index 000000000..419adca8a --- /dev/null +++ b/script/vendorize_deps @@ -0,0 +1,42 @@ +#!/usr/bin/env bash + +set -e + +mkdir -p src/main/clojure/cljs/vendor +cd src/main/clojure/cljs + +DJSON_RELEASE="2.4.0" +TRANSIT_RELEASE="1.0.329" +TREADER_RELEASE="1.3.6" + +rm -rf data.json +git clone -b "v$DJSON_RELEASE" --depth 1 git@github.com:clojure/data.json.git +mkdir -p vendor/clojure/data +mv data.json/src/main/clojure/clojure/data/json.clj vendor/clojure/data/ +rm -rf data.json +DATA_JSON_FILE=`mktemp /tmp/json.clj.XXXXXXXXXXX` +sed -e 's/clojure.data.json/cljs.vendor.clojure.data.json/' vendor/clojure/data/json.clj > $DATA_JSON_FILE +mv $DATA_JSON_FILE vendor/clojure/data/json.clj + +rm -rf transit-clj +git clone -b "v$TRANSIT_RELEASE" --depth 1 git@github.com:cognitect/transit-clj.git +mkdir -p vendor/cognitect +mv transit-clj/src/cognitect/transit.clj vendor/cognitect/ +rm -rf transit-clj +TRANSIT_FILE=`mktemp /tmp/transit.clj.XXXXXXXXXXX` +sed -e 's/ns cognitect.transit/ns cljs.vendor.cognitect.transit/' vendor/cognitect/transit.clj > $TRANSIT_FILE +mv $TRANSIT_FILE vendor/cognitect/transit.clj +TRANSIT_FILE=`mktemp /tmp/transit.clj.XXXXXXXXXXX` +sed -e 's/cognitect.transit.WithMeta/cljs.vendor.cognitect.transit.WithMeta/' vendor/cognitect/transit.clj > $TRANSIT_FILE +mv $TRANSIT_FILE vendor/cognitect/transit.clj + +rm -rf tools.reader +rm -rf vendor/clojure/tools +git clone -b "v$TREADER_RELEASE" --depth 1 git@github.com:clojure/tools.reader.git +mkdir -p vendor/clojure/tools +mv tools.reader/src/main/clojure/clojure/tools/* vendor/clojure/tools/ +rm -rf tools.reader + +echo "rewriting tool.reader namespaces" +find vendor/clojure/tools -name '*.clj' -print0 | xargs -0 sed -iBAK 's/clojure.tools/cljs.vendor.clojure.tools/g' +find vendor/clojure/tools -name '*BAK' -delete diff --git a/src/main/cljs/cljs/stacktrace.cljc b/src/main/cljs/cljs/stacktrace.cljc index b1ee6b965..4e2d5bbc7 100644 --- a/src/main/cljs/cljs/stacktrace.cljc +++ b/src/main/cljs/cljs/stacktrace.cljc @@ -542,7 +542,7 @@ goog.events.getProxy/f<@http://localhost:9000/out/goog/events/events.js:276:16" (comment (require '[cljs.closure :as cljsc] - '[clojure.data.json :as json] + '[cljs.vendor.clojure.data.json :as json] '[cljs.source-map :as sm] '[clojure.pprint :as pp]) diff --git a/src/main/clojure/cljs/analyzer.cljc b/src/main/clojure/cljs/analyzer.cljc index 05706ae2e..5017d747e 100644 --- a/src/main/clojure/cljs/analyzer.cljc +++ b/src/main/clojure/cljs/analyzer.cljc @@ -25,8 +25,8 @@ [clojure.java.io :as io] [clojure.set :as set] [clojure.string :as string] - [clojure.tools.reader :as reader] - [clojure.tools.reader.reader-types :as readers]) + [cljs.vendor.clojure.tools.reader :as reader] + [cljs.vendor.clojure.tools.reader.reader-types :as readers]) :cljs (:require [cljs.analyzer.impl :as impl] [cljs.analyzer.impl.namespaces :as nses] [cljs.analyzer.passes.and-or :as and-or] @@ -77,8 +77,8 @@ #?(:clj (def transit-read-opts (try - (require '[cognitect.transit]) - (when-some [ns (find-ns 'cognitect.transit)] + (require '[cljs.vendor.cognitect.transit]) + (when-some [ns (find-ns 'cljs.vendor.cognitect.transit)] (let [read-handler @(ns-resolve ns 'read-handler) read-handler-map @(ns-resolve ns 'read-handler-map)] {:handlers @@ -91,8 +91,8 @@ #?(:clj (def transit-write-opts (try - (require '[cognitect.transit]) - (when-some [ns (find-ns 'cognitect.transit)] + (require '[cljs.vendor.cognitect.transit]) + (when-some [ns (find-ns 'cljs.vendor.cognitect.transit)] (let [write-handler @(ns-resolve ns 'write-handler) write-handler-map @(ns-resolve ns 'write-handler-map)] {:handlers @@ -112,8 +112,8 @@ (def transit (delay (try - (require '[cognitect.transit]) - (when-some [ns (find-ns 'cognitect.transit)] + (require '[cljs.vendor.cognitect.transit]) + (when-some [ns (find-ns 'cljs.vendor.cognitect.transit)] {:writer @(ns-resolve ns 'writer) :reader @(ns-resolve ns 'reader) :write @(ns-resolve ns 'write) diff --git a/src/main/clojure/cljs/closure.clj b/src/main/clojure/cljs/closure.clj index 0cff465ed..86c80cf0e 100644 --- a/src/main/clojure/cljs/closure.clj +++ b/src/main/clojure/cljs/closure.clj @@ -20,9 +20,7 @@ [clojure.reflect] [clojure.set :as set] [clojure.string :as string] - [clojure.data.json :as json] - [clojure.tools.reader :as reader] - [clojure.tools.reader.reader-types :as readers] + [cljs.vendor.clojure.data.json :as json] [cljs.module-graph :as module-graph]) (:import [java.lang ProcessBuilder] [java.io diff --git a/src/main/clojure/cljs/compiler.cljc b/src/main/clojure/cljs/compiler.cljc index 8d0bdcb14..dfc37fb67 100644 --- a/src/main/clojure/cljs/compiler.cljc +++ b/src/main/clojure/cljs/compiler.cljc @@ -17,11 +17,11 @@ [cljs.source-map :as sm] [cljs.tagged-literals :as tags] [cljs.util :as util] - [clojure.data.json :as json] + [cljs.vendor.clojure.data.json :as json] [clojure.java.io :as io] [clojure.set :as set] [clojure.string :as string] - [clojure.tools.reader :as reader]) + [cljs.vendor.clojure.tools.reader :as reader]) :cljs (:require [cljs.analyzer :as ana] [cljs.analyzer.impl :as ana.impl] [cljs.env :as env] diff --git a/src/main/clojure/cljs/core/macros.clj b/src/main/clojure/cljs/core/macros.clj index 8aaa87954..1b0e117b1 100644 --- a/src/main/clojure/cljs/core/macros.clj +++ b/src/main/clojure/cljs/core/macros.clj @@ -9,8 +9,8 @@ (ns cljs.core.macros (:refer-clojure :exclude [alias]) (:require [clojure.java.io :as io] - [clojure.tools.reader :as reader] - [clojure.tools.reader.reader-types :as readers] + [cljs.vendor.clojure.tools.reader :as reader] + [cljs.vendor.clojure.tools.reader.reader-types :as readers] [cljs.env :as env] [cljs.analyzer :as ana] [cljs.repl :refer [source]]) @@ -40,4 +40,4 @@ (defmacro alias [[_ ns] [_ alias]] (swap! env/*compiler* assoc-in [::namespaces (.getName *ns*) :requires alias] ns) - nil) \ No newline at end of file + nil) diff --git a/src/main/clojure/cljs/core/server.clj b/src/main/clojure/cljs/core/server.clj index e2661b59f..0c8923b9e 100644 --- a/src/main/clojure/cljs/core/server.clj +++ b/src/main/clojure/cljs/core/server.clj @@ -8,8 +8,8 @@ (ns cljs.core.server (:refer-clojure :exclude [with-bindings resolve-fn prepl io-prepl]) - (:require [clojure.tools.reader.reader-types :as readers] - [clojure.tools.reader :as reader] + (:require [cljs.vendor.clojure.tools.reader.reader-types :as readers] + [cljs.vendor.clojure.tools.reader :as reader] [cljs.env :as env] [cljs.closure :as closure] [cljs.analyzer :as ana] diff --git a/src/main/clojure/cljs/js_deps.cljc b/src/main/clojure/cljs/js_deps.cljc index 2aa450af1..e13c8ada8 100644 --- a/src/main/clojure/cljs/js_deps.cljc +++ b/src/main/clojure/cljs/js_deps.cljc @@ -8,7 +8,7 @@ (ns cljs.js-deps (:require [cljs.util :as util :refer [distinct-by]] - [clojure.data.json :as json] + [cljs.vendor.clojure.data.json :as json] [clojure.java.io :as io] [clojure.string :as string]) (:import [java.io File] diff --git a/src/main/clojure/cljs/repl.cljc b/src/main/clojure/cljs/repl.cljc index 649ddf8f0..511750696 100644 --- a/src/main/clojure/cljs/repl.cljc +++ b/src/main/clojure/cljs/repl.cljc @@ -11,9 +11,9 @@ (:require [clojure.java.io :as io] [clojure.string :as string] [clojure.set :as set] - [clojure.data.json :as json] - [clojure.tools.reader :as reader] - [clojure.tools.reader.reader-types :as readers] + [cljs.vendor.clojure.data.json :as json] + [cljs.vendor.clojure.tools.reader :as reader] + [cljs.vendor.clojure.tools.reader.reader-types :as readers] [cljs.tagged-literals :as tags] [clojure.edn :as edn] [cljs.util :as util] diff --git a/src/main/clojure/cljs/repl/browser.clj b/src/main/clojure/cljs/repl/browser.clj index e51d9499b..4c5b516d5 100644 --- a/src/main/clojure/cljs/repl/browser.clj +++ b/src/main/clojure/cljs/repl/browser.clj @@ -12,7 +12,7 @@ [clojure.java.browse :as browse] [clojure.string :as string] [clojure.edn :as edn] - [clojure.data.json :as json] + [cljs.vendor.clojure.data.json :as json] [cljs.util :as util] [cljs.closure :as cljsc] [cljs.repl :as repl] diff --git a/src/main/clojure/cljs/repl/node.clj b/src/main/clojure/cljs/repl/node.clj index 18bd4bf68..a147808bd 100644 --- a/src/main/clojure/cljs/repl/node.clj +++ b/src/main/clojure/cljs/repl/node.clj @@ -16,7 +16,7 @@ [cljs.repl.bootstrap :as bootstrap] [cljs.cli :as cli] [cljs.closure :as closure] - [clojure.data.json :as json]) + [cljs.vendor.clojure.data.json :as json]) (:import [java.net Socket] [java.lang StringBuilder] [java.io File BufferedReader BufferedWriter IOException] diff --git a/src/main/clojure/cljs/source_map.clj b/src/main/clojure/cljs/source_map.clj index 1fdddf4ec..ed33d4ef0 100644 --- a/src/main/clojure/cljs/source_map.clj +++ b/src/main/clojure/cljs/source_map.clj @@ -9,7 +9,7 @@ (ns cljs.source-map (:require [clojure.java.io :as io] [clojure.string :as string] - [clojure.data.json :as json] + [cljs.vendor.clojure.data.json :as json] [clojure.set :as set] [cljs.source-map.base64-vlq :as base64-vlq])) @@ -104,7 +104,7 @@ (sorted-map))))) (defn decode-reverse - "Convert a v3 source map JSON object into a nested sorted map + "Convert a v3 source map JSON object into a nested sorted map organized as file, line, and column. Note this source map maps from *original* source location to generated source location." ([source-map] @@ -345,11 +345,11 @@ (comment ;; INSTRUCTIONS: - + ;; switch into samples/hello ;; run repl to start clojure ;; build with - + (require '[cljs.closure :as cljsc]) (cljsc/build "src" {:optimizations :simple diff --git a/src/main/clojure/cljs/vendor/clojure/data/json.clj b/src/main/clojure/cljs/vendor/clojure/data/json.clj new file mode 100644 index 000000000..361a306e2 --- /dev/null +++ b/src/main/clojure/cljs/vendor/clojure/data/json.clj @@ -0,0 +1,809 @@ +;; Copyright (c) Stuart Sierra, 2012. All rights reserved. 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 ^{:author "Stuart Sierra" + :doc "JavaScript Object Notation (JSON) parser/generator. + See http://www.json.org/"} + cljs.vendor.clojure.data.json + (:refer-clojure :exclude (read)) + (:require [clojure.pprint :as pprint]) + (:import (java.io PrintWriter PushbackReader StringWriter + Writer StringReader EOFException))) + +;;; JSON READER + +(set! *warn-on-reflection* true) + +(defn- default-write-key-fn + [x] + (cond (instance? clojure.lang.Named x) + (name x) + (nil? x) + (throw (Exception. "JSON object properties may not be nil")) + :else (str x))) + +(defn- default-value-fn [k v] v) + +(declare -read) + +(defmacro ^:private codepoint [c] + (int c)) + +(defn- codepoint-clause [[test result]] + (cond (list? test) + [(map int test) result] + (= test :whitespace) + ['(9 10 13 32) result] + (= test :js-separators) + ['(16r2028 16r2029) result] + :else + [(int test) result])) + +(defmacro ^:private codepoint-case [e & clauses] + `(case ~e + ~@(mapcat codepoint-clause (partition 2 clauses)) + ~@(when (odd? (count clauses)) + [(last clauses)]))) + +(defn- read-hex-char [^PushbackReader stream] + ;; Expects to be called with the head of the stream AFTER the + ;; initial "\u". Reads the next four characters from the stream. + (let [a (.read stream) + b (.read stream) + c (.read stream) + d (.read stream)] + (when (or (neg? a) (neg? b) (neg? c) (neg? d)) + (throw (EOFException. + "JSON error (end-of-file inside Unicode character escape)"))) + (let [s (str (char a) (char b) (char c) (char d))] + (char (Integer/parseInt s 16))))) + +(defn- read-escaped-char [^PushbackReader stream] + ;; Expects to be called with the head of the stream AFTER the + ;; initial backslash. + (let [c (.read stream)] + (when (neg? c) + (throw (EOFException. "JSON error (end-of-file inside escaped char)"))) + (codepoint-case c + (\" \\ \/) (char c) + \b \backspace + \f \formfeed + \n \newline + \r \return + \t \tab + \u (read-hex-char stream)))) + +(defn- slow-read-string [^PushbackReader stream ^String already-read] + (let [buffer (StringBuilder. already-read)] + (loop [] + (let [c (.read stream)] + (when (neg? c) + (throw (EOFException. "JSON error (end-of-file inside string)"))) + (codepoint-case c + \" (str buffer) + \\ (do (.append buffer (read-escaped-char stream)) + (recur)) + (do (.append buffer (char c)) + (recur))))))) + +(defn- read-quoted-string [^PushbackReader stream] + ;; Expects to be called with the head of the stream AFTER the + ;; opening quotation mark. + (let [buffer ^chars (char-array 64) + read (.read stream buffer 0 64) + end-index (unchecked-dec-int read)] + (when (neg? read) + (throw (EOFException. "JSON error (end-of-file inside string)"))) + (loop [i (int 0)] + (let [c (int (aget buffer i))] + (codepoint-case c + \" (let [off (unchecked-inc-int i) + len (unchecked-subtract-int read off)] + (.unread stream buffer off len) + (String. buffer 0 i)) + \\ (let [off i + len (unchecked-subtract-int read off)] + (.unread stream buffer off len) + (slow-read-string stream (String. buffer 0 i))) + (if (= i end-index) + (do (.unread stream c) + (slow-read-string stream (String. buffer 0 i))) + (recur (unchecked-inc-int i)))))))) + +(defn- read-integer [^String string] + (if (< (count string) 18) ; definitely fits in a Long + (Long/valueOf string) + (or (try (Long/valueOf string) + (catch NumberFormatException e nil)) + (bigint string)))) + +(defn- read-decimal [^String string bigdec?] + (if bigdec? + (bigdec string) + (Double/valueOf string))) + +(defn- read-number [^PushbackReader stream bigdec?] + (let [buffer (StringBuilder.) + decimal? (loop [stage :minus] + (let [c (.read stream)] + (case stage + :minus + (codepoint-case c + \- + (do (.append buffer (char c)) + (recur :int-zero)) + \0 + (do (.append buffer (char c)) + (recur :frac-point)) + (\1 \2 \3 \4 \5 \6 \7 \8 \9) + (do (.append buffer (char c)) + (recur :int-digit)) + (throw (Exception. "JSON error (invalid number literal)"))) + ;; Number must either be a single 0 or 1-9 followed by 0-9 + :int-zero + (codepoint-case c + \0 + (do (.append buffer (char c)) + (recur :frac-point)) + (\1 \2 \3 \4 \5 \6 \7 \8 \9) + (do (.append buffer (char c)) + (recur :int-digit)) + (throw (Exception. "JSON error (invalid number literal)"))) + ;; at this point, there is at least one digit + :int-digit + (codepoint-case c + (\0 \1 \2 \3 \4 \5 \6 \7 \8 \9) + (do (.append buffer (char c)) + (recur :int-digit)) + \. + (do (.append buffer (char c)) + (recur :frac-first)) + (\e \E) + (do (.append buffer (char c)) + (recur :exp-symbol)) + ;; early exit + :whitespace + (do (.unread stream c) + false) + (\, \] \} -1) + (do (.unread stream c) + false) + (throw (Exception. "JSON error (invalid number literal)"))) + ;; previous character is a "0" + :frac-point + (codepoint-case c + \. + (do (.append buffer (char c)) + (recur :frac-first)) + (\e \E) + (do (.append buffer (char c)) + (recur :exp-symbol)) + ;; early exit + :whitespace + (do (.unread stream c) + false) + (\, \] \} -1) + (do (.unread stream c) + false) + ;; Disallow zero-padded numbers or invalid characters + (throw (Exception. "JSON error (invalid number literal)"))) + ;; previous character is a "." + :frac-first + (codepoint-case c + (\0 \1 \2 \3 \4 \5 \6 \7 \8 \9) + (do (.append buffer (char c)) + (recur :frac-digit)) + (throw (Exception. "JSON error (invalid number literal)"))) + ;; any number of following digits + :frac-digit + (codepoint-case c + (\0 \1 \2 \3 \4 \5 \6 \7 \8 \9) + (do (.append buffer (char c)) + (recur :frac-digit)) + (\e \E) + (do (.append buffer (char c)) + (recur :exp-symbol)) + ;; early exit + :whitespace + (do (.unread stream c) + true) + (\, \] \} -1) + (do (.unread stream c) + true) + (throw (Exception. "JSON error (invalid number literal)"))) + ;; previous character is a "e" or "E" + :exp-symbol + (codepoint-case c + (\- \+) + (do (.append buffer (char c)) + (recur :exp-first)) + (\0 \1 \2 \3 \4 \5 \6 \7 \8 \9) + (do (.append buffer (char c)) + (recur :exp-digit))) + ;; previous character is a "-" or "+" + ;; must have at least one digit + :exp-first + (codepoint-case c + (\0 \1 \2 \3 \4 \5 \6 \7 \8 \9) + (do (.append buffer (char c)) + (recur :exp-digit)) + (throw (Exception. "JSON error (invalid number literal)"))) + ;; any number of following digits + :exp-digit + (codepoint-case c + (\0 \1 \2 \3 \4 \5 \6 \7 \8 \9) + (do (.append buffer (char c)) + (recur :exp-digit)) + :whitespace + (do (.unread stream c) + true) + (\, \] \} -1) + (do (.unread stream c) + true) + (throw (Exception. "JSON error (invalid number literal)"))))))] + (if decimal? + (read-decimal (str buffer) bigdec?) + (read-integer (str buffer))))) + +(defn- next-token [^PushbackReader stream] + (loop [c (.read stream)] + (if (< 32 c) + (int c) + (codepoint-case (int c) + :whitespace (recur (.read stream)) + -1 -1)))) + +(defn invalid-array-exception [] + (Exception. "JSON error (invalid array)")) + +(defn- read-array* [^PushbackReader stream options] + ;; Handles all array values after the first. + (loop [result (transient [])] + (let [r (conj! result (-read stream true nil options))] + (codepoint-case (int (next-token stream)) + \] (persistent! r) + \, (recur r) + (throw (invalid-array-exception)))))) + +(defn- read-array [^PushbackReader stream options] + ;; Expects to be called with the head of the stream AFTER the + ;; opening bracket. + ;; Only handles array value. + (let [c (int (next-token stream))] + (codepoint-case c + \] [] + \, (throw (invalid-array-exception)) + (do (.unread stream c) + (read-array* stream options))))) + +(defn- read-key [^PushbackReader stream] + (let [c (int (next-token stream))] + (if (= c (codepoint \")) + (let [key (read-quoted-string stream)] + (if (= (codepoint \:) (int (next-token stream))) + key + (throw (Exception. "JSON error (missing `:` in object)")))) + (if (= c (codepoint \})) + nil + (throw (Exception. (str "JSON error (non-string key in object), found `" (char c) "`, expected `\"`"))))))) + +(defn- read-object [^PushbackReader stream options] + ;; Expects to be called with the head of the stream AFTER the + ;; opening bracket. + (let [key-fn (get options :key-fn) + value-fn (get options :value-fn)] + (loop [result (transient {})] + (if-let [key (read-key stream)] + (let [key (cond-> key key-fn key-fn) + value (-read stream true nil options) + r (if value-fn + (let [out-value (value-fn key value)] + (if-not (= value-fn out-value) + (assoc! result key out-value) + result)) + (assoc! result key value))] + (codepoint-case (int (next-token stream)) + \, (recur r) + \} (persistent! r) + (throw (Exception. "JSON error (missing entry in object)")))) + (let [r (persistent! result)] + (if (empty? r) + r + (throw (Exception. "JSON error empty entry in object is not allowed")))))))) + +(defn- -read + [^PushbackReader stream eof-error? eof-value options] + (let [c (int (next-token stream))] + (codepoint-case c + ;; Read numbers + (\- \0 \1 \2 \3 \4 \5 \6 \7 \8 \9) + (do (.unread stream c) + (read-number stream (:bigdec options))) + + ;; Read strings + \" (read-quoted-string stream) + + ;; Read null as nil + \n (if (and (= (codepoint \u) (.read stream)) + (= (codepoint \l) (.read stream)) + (= (codepoint \l) (.read stream))) + nil + (throw (Exception. "JSON error (expected null)"))) + + ;; Read true + \t (if (and (= (codepoint \r) (.read stream)) + (= (codepoint \u) (.read stream)) + (= (codepoint \e) (.read stream))) + true + (throw (Exception. "JSON error (expected true)"))) + + ;; Read false + \f (if (and (= (codepoint \a) (.read stream)) + (= (codepoint \l) (.read stream)) + (= (codepoint \s) (.read stream)) + (= (codepoint \e) (.read stream))) + false + (throw (Exception. "JSON error (expected false)"))) + + ;; Read JSON objects + \{ (read-object stream options) + + ;; Read JSON arrays + \[ (read-array stream options) + + (if (neg? c) ;; Handle end-of-stream + (if eof-error? + (throw (EOFException. "JSON error (end-of-file)")) + eof-value) + (throw (Exception. + (str "JSON error (unexpected character): " (char c)))))))) + +(def default-read-options {:bigdec false + :key-fn nil + :value-fn nil}) +(defn read + "Reads a single item of JSON data from a java.io.Reader. Options are + key-value pairs, valid options are: + + :eof-error? boolean + + If true (default) will throw exception if the stream is empty. + + :eof-value Object + + Object to return if the stream is empty and eof-error? is + false. Default is nil. + + :bigdec boolean + + If true use BigDecimal for decimal numbers instead of Double. + Default is false. + + :key-fn function + + Single-argument function called on JSON property names; return + value will replace the property names in the output. Default + is clojure.core/identity, use clojure.core/keyword to get + keyword properties. + + :value-fn function + + Function to transform values in maps (\"objects\" in JSON) in + the output. For each JSON property, value-fn is called with + two arguments: the property name (transformed by key-fn) and + the value. The return value of value-fn will replace the value + in the output. If value-fn returns itself, the property will + be omitted from the output. The default value-fn returns the + value unchanged. This option does not apply to non-map + collections." + [reader & {:as options}] + (let [{:keys [eof-error? eof-value] + :or {eof-error? true}} options] + (->> options + (merge default-read-options) + (-read (PushbackReader. reader 64) eof-error? eof-value)))) + +(defn read-str + "Reads one JSON value from input String. Options are the same as for + read." + [string & {:as options}] + (let [{:keys [eof-error? eof-value] + :or {eof-error? true}} options] + (->> options + (merge default-read-options) + (-read (PushbackReader. (StringReader. string) 64) eof-error? eof-value)))) + +;;; JSON WRITER + + +(defprotocol JSONWriter + (-write [object out options] + "Print object to Appendable out as JSON")) + +(defn- ->hex-string [^Appendable out cp] + (let [cpl (long cp)] + (.append out "\\u") + (cond + (< cpl 16) + (.append out "000") + (< cpl 256) + (.append out "00") + (< cpl 4096) + (.append out "0")) + (.append out (Integer/toHexString cp)))) + +(def ^{:tag "[S"} codepoint-decoder + (let [shorts (short-array 128)] + (dotimes [i 128] + (codepoint-case i + \" (aset shorts i (short 1)) + \\ (aset shorts i (short 1)) + \/ (aset shorts i (short 2)) + \backspace (aset shorts i (short 3)) + \formfeed (aset shorts i (short 4)) + \newline (aset shorts i (short 5)) + \return (aset shorts i (short 6)) + \tab (aset shorts i (short 7)) + (if (< i 32) + (aset shorts i (short 8)) + (aset shorts i (short 0))))) + shorts)) + +(defn- write-string [^CharSequence s ^Appendable out options] + (let [decoder codepoint-decoder] + (.append out \") + (dotimes [i (.length s)] + (let [cp (int (.charAt s i))] + (if (< cp 128) + (case (aget decoder cp) + 0 (.append out (char cp)) + 1 (do (.append out (char (codepoint \\))) (.append out (char cp))) + 2 (.append out (if (get options :escape-slash) "\\/" "/")) + 3 (.append out "\\b") + 4 (.append out "\\f") + 5 (.append out "\\n") + 6 (.append out "\\r") + 7 (.append out "\\t") + 8 (->hex-string out cp)) + (codepoint-case cp + :js-separators (if (get options :escape-js-separators) + (->hex-string out cp) + (.append out (char cp))) + (if (get options :escape-unicode) + (->hex-string out cp) ; Hexadecimal-escaped + (.append out (char cp))))))) + (.append out \"))) + +(defn- write-indent [^Appendable out options] + (let [indent-depth (:indent-depth options)] + (.append out \newline) + (loop [i indent-depth] + (when (pos? i) + (.append out " ") + (recur (dec i)))))) + +(defn- write-object [m ^Appendable out options] + (let [key-fn (get options :key-fn) + value-fn (get options :value-fn) + indent (get options :indent) + opts (cond-> options + indent (update :indent-depth inc))] + (.append out \{) + (when (and indent (seq m)) + (write-indent out opts)) + (loop [x m, have-printed-kv false] + (when (seq x) + (let [[k v] (first x) + out-key (key-fn k) + out-value (value-fn k v) + nxt (next x)] + (when-not (string? out-key) + (throw (Exception. "JSON object keys must be strings"))) + (if-not (= value-fn out-value) + (do + (when have-printed-kv + (.append out \,) + (when indent + (write-indent out opts))) + (write-string out-key out opts) + (.append out \:) + (when indent + (.append out \space)) + (-write out-value out opts) + (when (seq nxt) + (recur nxt true))) + (when (seq nxt) + (recur nxt have-printed-kv)))))) + (when (and indent (seq m)) + (write-indent out options))) + (.append out \})) + +(defn- write-array [s ^Appendable out options] + (let [indent (get options :indent) + opts (cond-> options + indent (update :indent-depth inc))] + (.append out \[) + (when (and indent (seq s)) + (write-indent out opts)) + (loop [x s] + (when (seq x) + (let [fst (first x) + nxt (next x)] + (-write fst out opts) + (when (seq nxt) + (.append out \,) + (when indent + (write-indent out opts)) + (recur nxt))))) + (when (and indent (seq s)) + (write-indent out options))) + (.append out \])) + +(defn- write-bignum [x ^Appendable out options] + (.append out (str x))) + +(defn- write-float [^Float x ^Appendable out options] + (cond (.isInfinite x) + (throw (Exception. "JSON error: cannot write infinite Float")) + (.isNaN x) + (throw (Exception. "JSON error: cannot write Float NaN")) + :else + (.append out (str x)))) + +(defn- write-double [^Double x ^Appendable out options] + (cond (.isInfinite x) + (throw (Exception. "JSON error: cannot write infinite Double")) + (.isNaN x) + (throw (Exception. "JSON error: cannot write Double NaN")) + :else + (.append out (str x)))) + +(defn- write-plain [x ^Appendable out options] + (.append out (str x))) + +(defn- write-uuid [^java.util.UUID x ^Appendable out options] + (.append out \") + (.append out (.toString x)) + (.append out \")) + +(defn- write-instant [^java.time.Instant x ^Appendable out options] + (let [formatter ^java.time.format.DateTimeFormatter (:date-formatter options)] + (.append out \") + (.append out (.format formatter x)) + (.append out \"))) + +(defn- write-date [^java.util.Date x ^Appendable out options] + (write-instant (.toInstant x) out options)) + +(defn- default-sql-date->instant-fn [^java.sql.Date d] + (.toInstant (.atStartOfDay (.toLocalDate d) (java.time.ZoneId/systemDefault)))) + +(defn- write-sql-date [^java.sql.Date x ^Appendable out options] + (let [->instant (:sql-date-converter options)] + (write-instant (->instant x) out options))) + +(defn- write-null [x ^Appendable out options] + (.append out "null")) + +(defn- write-named [x out options] + (write-string (name x) out options)) + +(defn- write-generic [x out options] + (if (.isArray (class x)) + (-write (seq x) out options) + (throw (Exception. (str "Don't know how to write JSON of " (class x)))))) + +(defn- write-ratio [x out options] + (-write (double x) out options)) + +;; nil, true, false +(extend nil JSONWriter {:-write write-null}) +(extend java.lang.Boolean JSONWriter {:-write write-plain}) + +;; Numbers +(extend java.lang.Byte JSONWriter {:-write write-plain}) +(extend java.lang.Short JSONWriter {:-write write-plain}) +(extend java.lang.Integer JSONWriter {:-write write-plain}) +(extend java.lang.Long JSONWriter {:-write write-plain}) +(extend java.lang.Float JSONWriter {:-write write-float}) +(extend java.lang.Double JSONWriter {:-write write-double}) +(extend clojure.lang.Ratio JSONWriter {:-write write-ratio}) +(extend java.math.BigInteger JSONWriter {:-write write-bignum}) +(extend java.math.BigDecimal JSONWriter {:-write write-bignum}) +(extend java.util.concurrent.atomic.AtomicInteger JSONWriter {:-write write-plain}) +(extend java.util.concurrent.atomic.AtomicLong JSONWriter {:-write write-plain}) +(extend java.util.UUID JSONWriter {:-write write-uuid}) +(extend java.time.Instant JSONWriter {:-write write-instant}) +(extend java.util.Date JSONWriter {:-write write-date}) +(extend java.sql.Date JSONWriter {:-write write-sql-date}) +(extend clojure.lang.BigInt JSONWriter {:-write write-bignum}) + +;; Symbols, Keywords, and Strings +(extend clojure.lang.Named JSONWriter {:-write write-named}) +(extend java.lang.CharSequence JSONWriter {:-write write-string}) + +;; Collections +(extend java.util.Map JSONWriter {:-write write-object}) +(extend java.util.Collection JSONWriter {:-write write-array}) + +;; Maybe a Java array, otherwise fail +(extend java.lang.Object JSONWriter {:-write write-generic}) + +(def default-write-options {:escape-unicode true + :escape-js-separators true + :escape-slash true + :sql-date-converter default-sql-date->instant-fn + :date-formatter java.time.format.DateTimeFormatter/ISO_INSTANT + :key-fn default-write-key-fn + :value-fn default-value-fn + :indent false + :indent-depth 0}) +(defn write + "Write JSON-formatted output to a java.io.Writer. Options are + key-value pairs, valid options are: + + :escape-unicode boolean + + If true (default) non-ASCII characters are escaped as \\uXXXX + + :escape-js-separators boolean + + If true (default) the Unicode characters U+2028 and U+2029 will + be escaped as \\u2028 and \\u2029 even if :escape-unicode is + false. (These two characters are valid in pure JSON but are not + valid in JavaScript strings.) + + :escape-slash boolean + + If true (default) the slash / is escaped as \\/ + + :sql-date-converter function + + Single-argument function used to convert a java.sql.Date to + a java.time.Instant. As java.sql.Date does not have a + time-component (which is required by java.time.Instant), it needs + to be computed. The default implementation, `default-sql-date->instant-fn` + uses + ``` + (.toInstant (.atStartOfDay (.toLocalDate sql-date) (java.time.ZoneId/systemDefault))) + ``` + + :date-formatter + + A java.time.DateTimeFormatter instance, defaults to DateTimeFormatter/ISO_INSTANT + + :key-fn function + + Single-argument function called on map keys; return value will + replace the property names in the output. Must return a + string. Default calls clojure.core/name on symbols and + keywords and clojure.core/str on everything else. + + :value-fn function + + Function to transform values in maps before writing. For each + key-value pair in an input map, called with two arguments: the + key (BEFORE transformation by key-fn) and the value. The + return value of value-fn will replace the value in the output. + If the return value is a number, boolean, string, or nil it + will be included literally in the output. If the return value + is a non-map collection, it will be processed recursively. If + the return value is a map, it will be processed recursively, + calling value-fn again on its key-value pairs. If value-fn + returns itself, the key-value pair will be omitted from the + output. This option does not apply to non-map collections." + [x ^Writer writer & {:as options}] + (-write x writer (merge default-write-options options))) + +(defn write-str + "Converts x to a JSON-formatted string. Options are the same as + write." + ^String [x & {:as options}] + (let [sw (StringWriter.)] + (-write x sw (merge default-write-options options)) + (.toString sw))) + +;;; JSON PRETTY-PRINTER + +;; Based on code by Tom Faulhaber + +(defn- pprint-array [s] + ((pprint/formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>") s)) + +(defn- pprint-object [m options] + (let [key-fn (:key-fn options)] + ((pprint/formatter-out "~<{~;~@{~<~w:~_~w~:>~^, ~_~}~;}~:>") + (for [[k v] m] [(key-fn k) v])))) + +(defn- pprint-generic [x options] + (if (.isArray (class x)) + (pprint-array (seq x)) + ;; pprint proxies Writer, so we can't just wrap it + (print (with-out-str (-write x (PrintWriter. *out*) options))))) + +(defn- pprint-dispatch [x options] + (cond (nil? x) (print "null") + (instance? java.util.Map x) (pprint-object x options) + (instance? java.util.Collection x) (pprint-array x) + (instance? clojure.lang.ISeq x) (pprint-array x) + :else (pprint-generic x options))) + +(defn pprint + "Pretty-prints JSON representation of x to *out*. Options are the + same as for write except :value-fn, which is not supported." + [x & {:as options}] + (let [opts (merge default-write-options options)] + (pprint/with-pprint-dispatch #(pprint-dispatch % opts) + (pprint/pprint x)))) + +;; DEPRECATED APIs from 0.1.x + +(defn read-json + "DEPRECATED; replaced by read-str. + + Reads one JSON value from input String or Reader. If keywordize? is + true (default), object keys will be converted to keywords. If + eof-error? is true (default), empty input will throw an + EOFException; if false EOF will return eof-value." + ([input] + (read-json input true true nil)) + ([input keywordize?] + (read-json input keywordize? true nil)) + ([input keywordize? eof-error? eof-value] + (let [key-fn (if keywordize? keyword identity)] + (condp instance? input + String + (read-str input + :key-fn key-fn + :eof-error? eof-error? + :eof-value eof-value) + java.io.Reader + (read input + :key-fn key-fn + :eof-error? eof-error? + :eof-value eof-value))))) + +(defn write-json + "DEPRECATED; replaced by 'write'. + + Print object to PrintWriter out as JSON" + [x out escape-unicode?] + (write x out :escape-unicode escape-unicode?)) + +(defn json-str + "DEPRECATED; replaced by 'write-str'. + + Converts x to a JSON-formatted string. + + Valid options are: + :escape-unicode false + to turn of \\uXXXX escapes of Unicode characters." + [x & options] + (apply write-str x options)) + +(defn print-json + "DEPRECATED; replaced by 'write' to *out*. + + Write JSON-formatted output to *out*. + + Valid options are: + :escape-unicode false + to turn off \\uXXXX escapes of Unicode characters." + [x & options] + (apply write x *out* options)) + +(defn pprint-json + "DEPRECATED; replaced by 'pprint'. + + Pretty-prints JSON representation of x to *out*. + + Valid options are: + :escape-unicode false + to turn off \\uXXXX escapes of Unicode characters." + [x & options] + (apply pprint x options)) \ No newline at end of file diff --git a/src/main/clojure/cljs/vendor/clojure/tools/reader.clj b/src/main/clojure/cljs/vendor/clojure/tools/reader.clj new file mode 100644 index 000000000..ab9db30da --- /dev/null +++ b/src/main/clojure/cljs/vendor/clojure/tools/reader.clj @@ -0,0 +1,1031 @@ +;; 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 "A clojure reader in clojure" + :author "Bronsa"} + cljs.vendor.clojure.tools.reader + (:refer-clojure :exclude [read read-line read-string char read+string + default-data-readers *default-data-reader-fn* + *read-eval* *data-readers* *suppress-read*]) + (:require [cljs.vendor.clojure.tools.reader.reader-types :refer + [read-char unread peek-char indexing-reader? source-logging-push-back-reader source-logging-reader? + get-line-number get-column-number get-file-name string-push-back-reader log-source]] + [cljs.vendor.clojure.tools.reader.impl.utils :refer :all] ;; [char ex-info? whitespace? numeric? desugar-meta] + [cljs.vendor.clojure.tools.reader.impl.errors :as err] + [cljs.vendor.clojure.tools.reader.impl.commons :refer :all] + [cljs.vendor.clojure.tools.reader.default-data-readers :as data-readers]) + (:import (clojure.lang PersistentHashSet IMeta + RT Symbol Reflector Var IObj + PersistentVector IRecord Namespace) + cljs.vendor.clojure.tools.reader.reader_types.SourceLoggingPushbackReader + java.lang.reflect.Constructor + java.util.regex.Pattern + (java.util List LinkedList))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; helpers +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(declare ^:private read* + macros dispatch-macros + ^:dynamic *read-eval* + ^:dynamic *data-readers* + ^:dynamic *default-data-reader-fn* + ^:dynamic *suppress-read* + default-data-readers) + +(defn ^:private ns-name* [x] + (if (instance? Namespace x) + (name (ns-name x)) + (name x))) + +(defn- macro-terminating? [ch] + (case ch + (\" \; \@ \^ \` \~ \( \) \[ \] \{ \} \\) true + false)) + +(defn- ^String read-token + "Read in a single logical token from the reader" + [rdr kind initch] + (if-not initch + (err/throw-eof-at-start rdr kind) + (loop [sb (StringBuilder.) ch initch] + (if (or (whitespace? ch) + (macro-terminating? ch) + (nil? ch)) + (do (when ch + (unread rdr ch)) + (str sb)) + (recur (.append sb ch) (read-char rdr)))))) + +(declare read-tagged) + +(defn- read-dispatch + [rdr _ opts pending-forms] + (if-let [ch (read-char rdr)] + (if-let [dm (dispatch-macros ch)] + (dm rdr ch opts pending-forms) + (read-tagged (doto rdr (unread ch)) ch opts pending-forms)) ;; ctor reader is implemented as a tagged literal + (err/throw-eof-at-dispatch rdr))) + +(defn- read-unmatched-delimiter + [rdr ch opts pending-forms] + (err/throw-unmatch-delimiter rdr ch)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; readers +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn read-regex + [rdr ch opts pending-forms] + (let [sb (StringBuilder.)] + (loop [ch (read-char rdr)] + (if (identical? \" ch) + (Pattern/compile (str sb)) + (if (nil? ch) + (err/throw-eof-reading rdr :regex sb) + (do + (.append sb ch ) + (when (identical? \\ ch) + (let [ch (read-char rdr)] + (if (nil? ch) + (err/throw-eof-reading rdr :regex sb)) + (.append sb ch))) + (recur (read-char rdr)))))))) + +(defn- read-unicode-char + ([^String token ^long offset ^long length ^long 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) + (char uc) + (let [d (Character/digit (int (nth token i)) (int base))] + (if (== d -1) + (err/throw-invalid-unicode-digit-in-token nil (nth token i) token) + (recur (inc i) (long (+ d (* uc base)))))))))) + + ([rdr initch base length exact?] + (let [base (long base) + length (long length)] + (loop [i 1 uc (long (Character/digit (int initch) (int 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) + (char uc)) + (let [d (Character/digit (int ch) (int base))] + (read-char rdr) + (if (== d -1) + (err/throw-invalid-unicode-digit rdr ch) + (recur (inc i) (long (+ d (* uc base)))))))) + (char uc))))))) + +(def ^:private ^:const upper-limit (int \uD7ff)) +(def ^:private ^:const lower-limit (int \uE000)) + +(defn- read-char* + "Read in a character literal" + [rdr backslash opts pending-forms] + (let [ch (read-char rdr)] + (if-not (nil? ch) + (let [token (if (or (macro-terminating? ch) + (whitespace? ch)) + (str ch) + (read-token rdr :character ch)) + 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)) + (err/throw-invalid-character-literal rdr (Integer/toString ic 16)) + c)) + + (.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 ^:private ending-line-col-info [rdr] + (when (indexing-reader? rdr) + [(get-line-number rdr) (get-column-number rdr)])) + +(defonce ^:private READ_EOF (Object.)) +(defonce ^:private READ_FINISHED (Object.)) + +(def ^:dynamic *read-delim* false) +(defn- ^PersistentVector read-delimited + "Reads and returns a collection ended with delim" + [kind delim rdr opts pending-forms] + (let [[start-line start-column] (starting-line-col-info rdr) + delim (char delim)] + (binding [*read-delim* true] + (loop [a (transient [])] + (let [form (read* rdr false READ_EOF delim opts pending-forms)] + (if (identical? form READ_FINISHED) + (persistent! a) + (if (identical? form READ_EOF) + (err/throw-eof-delimited rdr kind start-line start-column (count a)) + (recur (conj! a form))))))))) + +(defn- read-list + "Read in a list, including its location if the reader is an indexing reader" + [rdr _ opts pending-forms] + (let [[start-line start-column] (starting-line-col-info rdr) + the-list (read-delimited :list \) rdr opts pending-forms) + [end-line end-column] (ending-line-col-info rdr)] + (with-meta (if (empty? the-list) + '() + (clojure.lang.PersistentList/create the-list)) + (when start-line + (merge + (when-let [file (get-file-name rdr)] + {:file file}) + {:line start-line + :column start-column + :end-line end-line + :end-column end-column}))))) + +(defn- read-vector + "Read in a vector, including its location if the reader is an indexing reader" + [rdr _ opts pending-forms] + (let [[start-line start-column] (starting-line-col-info rdr) + the-vector (read-delimited :vector \] rdr opts pending-forms) + [end-line end-column] (ending-line-col-info rdr)] + (with-meta the-vector + (when start-line + (merge + (when-let [file (get-file-name rdr)] + {:file file}) + {:line start-line + :column start-column + :end-line end-line + :end-column end-column}))))) + +(defn- read-map + "Read in a map, including its location if the reader is an indexing reader" + [rdr _ opts pending-forms] + (let [[start-line start-column] (starting-line-col-info rdr) + the-map (read-delimited :map \} rdr opts pending-forms) + map-count (count the-map) + [end-line end-column] (ending-line-col-info rdr)] + (when (odd? map-count) + (err/throw-odd-map rdr start-line start-column the-map)) + (with-meta + (if (zero? map-count) + {} + (RT/map (to-array the-map))) + (when start-line + (merge + (when-let [file (get-file-name rdr)] + {:file file}) + {:line start-line + :column start-column + :end-line end-line + :end-column end-column}))))) + +(defn- read-number + [rdr initch] + (loop [sb (doto (StringBuilder.) (.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 (Character/digit (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* + [reader _ opts pending-forms] + (loop [sb (StringBuilder.) + ch (read-char reader)] + (case ch + nil (err/throw-eof-reading reader :string sb) + \\ (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] + (let [[line column] (starting-line-col-info rdr)] + (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)] + (with-meta (symbol (p 0) (p 1)) + (when line + (merge + (when-let [file (get-file-name rdr)] + {:file file}) + (let [[end-line end-column] (ending-line-col-info rdr)] + {:line line + :column column + :end-line end-line + :end-column end-column}))))) + (err/throw-invalid rdr :symbol token)))))) + +(def ^:dynamic *alias-map* + "Map from ns alias to ns, if non-nil, it will be used to resolve read-time + ns aliases instead of (ns-aliases *ns*). + + Defaults to nil" + nil) + +(defn- resolve-alias [sym] + ((or *alias-map* + (ns-aliases *ns*)) sym)) + +(defn- resolve-ns [sym] + (or (resolve-alias sym) + (find-ns sym))) + +(defn- read-keyword + [reader initch opts pending-forms] + (let [ch (read-char reader)] + (if-not (whitespace? ch) + (let [token (read-token reader :keyword ch) + s (parse-symbol token)] + (if s + (let [^String ns (s 0) + ^String name (s 1)] + (if (identical? \: (nth token 0)) + (if ns + (let [ns (resolve-alias (symbol (subs ns 1)))] + (if ns + (keyword (str ns) name) + (err/throw-invalid reader :keyword (str \: token)))) + (keyword (str *ns*) (subs name 1))) + (keyword ns name))) + (err/throw-invalid reader :keyword (str \: token)))) + (err/throw-single-colon reader)))) + +(defn- wrapping-reader + "Returns a function which wraps a reader in a call to sym" + [sym] + (fn [rdr _ opts pending-forms] + (list sym (read* rdr true nil opts pending-forms)))) + +(defn- read-meta + "Read metadata and return the following object with the metadata applied" + [rdr _ opts pending-forms] + (log-source rdr + (let [[line column] (starting-line-col-info rdr) + m (desugar-meta (read* rdr true nil opts pending-forms))] + (when-not (map? m) + (err/throw-bad-metadata rdr m)) + (let [o (read* rdr true nil opts pending-forms)] + (if (instance? IMeta o) + (let [m (if (and line (seq? o)) + (assoc m :line line :column column) + m)] + (if (instance? IObj o) + (with-meta o (merge (meta o) m)) + (reset-meta! o m))) + (err/throw-bad-metadata-target rdr o)))))) + +(defn- read-set + [rdr _ opts pending-forms] + (let [[start-line start-column] (starting-line-col-info rdr) + ;; subtract 1 from start-column so it includes the # in the leading #{ + start-column (if start-column (int (dec (int start-column)))) + the-set (PersistentHashSet/createWithCheck + (read-delimited :set \} rdr opts pending-forms)) + [end-line end-column] (ending-line-col-info rdr)] + (with-meta the-set + (when start-line + (merge + (when-let [file (get-file-name rdr)] + {:file file}) + {:line start-line + :column start-column + :end-line end-line + :end-column end-column}))))) + +(defn- read-discard + "Read and discard the first object from rdr" + [rdr _ opts pending-forms] + (doto rdr + (read* true nil opts pending-forms))) + +(defn- read-symbolic-value + [rdr _ opts pending-forms] + (let [sym (read* rdr true nil opts pending-forms)] + (case sym + Inf Double/POSITIVE_INFINITY + -Inf Double/NEGATIVE_INFINITY + NaN Double/NaN + (err/reader-error rdr (str "Invalid token: ##" sym))))) + +(def ^:private RESERVED_FEATURES #{:else :none}) + +(defn- has-feature? + [rdr feature opts] + (if (keyword? feature) + (or (= :default feature) (contains? (get opts :features) feature)) + (err/throw-feature-not-keyword rdr feature))) + +;; WIP, move to errors in the future +(defn- check-eof-error + [form rdr ^long first-line] + (when (identical? form READ_EOF) + (err/throw-eof-error rdr (and (< first-line 0) first-line)))) + +(defn- check-reserved-features + [rdr form] + (when (get RESERVED_FEATURES form) + (err/reader-error rdr "Feature name " form " is reserved"))) + +(defn- check-invalid-read-cond + [form rdr ^long first-line] + (when (identical? form READ_FINISHED) + (if (< first-line 0) + (err/reader-error rdr "read-cond requires an even number of forms") + (err/reader-error rdr "read-cond starting on line " first-line " requires an even number of forms")))) + +(defn- read-suppress + "Read next form and suppress. Return nil or READ_FINISHED." + [first-line rdr opts pending-forms] + (binding [*suppress-read* true] + (let [form (read* rdr false READ_EOF \) opts pending-forms)] + (check-eof-error form rdr first-line) + (when (identical? form READ_FINISHED) + READ_FINISHED)))) + +(def ^:private NO_MATCH (Object.)) + +(defn- match-feature + "Read next feature. If matched, read next form and return. + Otherwise, read and skip next form, returning READ_FINISHED or nil." + [first-line rdr opts pending-forms] + (let [feature (read* rdr false READ_EOF \) opts pending-forms)] + (check-eof-error feature rdr first-line) + (if (= feature READ_FINISHED) + READ_FINISHED + (do + (check-reserved-features rdr feature) + (if (has-feature? rdr feature opts) + ;; feature matched, read selected form + (doto (read* rdr false READ_EOF \) opts pending-forms) + (check-eof-error rdr first-line) + (check-invalid-read-cond rdr first-line)) + ;; feature not matched, ignore next form + (or (read-suppress first-line rdr opts pending-forms) + NO_MATCH)))))) + +(defn- read-cond-delimited + [rdr splicing opts pending-forms] + (let [first-line (if (indexing-reader? rdr) (get-line-number rdr) -1) + result (loop [matched NO_MATCH + finished nil] + (cond + ;; still looking for match, read feature+form + (identical? matched NO_MATCH) + (let [match (match-feature first-line rdr opts pending-forms)] + (if (identical? match READ_FINISHED) + READ_FINISHED + (recur match nil))) + + ;; found match, just read and ignore the rest + (not (identical? finished READ_FINISHED)) + (recur matched (read-suppress first-line rdr opts pending-forms)) + + :else + matched))] + (if (identical? result READ_FINISHED) + rdr + (if splicing + (if (instance? List result) + (do + (.addAll ^List pending-forms 0 ^List result) + rdr) + (err/reader-error rdr "Spliced form list in read-cond-splicing must implement java.util.List.")) + result)))) + +(defn- read-cond + [rdr _ opts pending-forms] + (when (not (and opts (#{:allow :preserve} (:read-cond opts)))) + (throw (RuntimeException. "Conditional read not allowed"))) + (if-let [ch (read-char rdr)] + (let [splicing (= ch \@) + ch (if splicing (read-char rdr) ch)] + (when splicing + (when-not *read-delim* + (err/reader-error rdr "cond-splice not in list"))) + (if-let [ch (if (whitespace? ch) (read-past whitespace? rdr) ch)] + (if (not= ch \() + (throw (RuntimeException. "read-cond body must be a list")) + (binding [*suppress-read* (or *suppress-read* (= :preserve (:read-cond opts)))] + (if *suppress-read* + (reader-conditional (read-list rdr ch opts pending-forms) splicing) + (read-cond-delimited rdr splicing opts pending-forms)))) + (err/throw-eof-in-character rdr))) + (err/throw-eof-in-character rdr))) + +(def ^:private ^:dynamic arg-env) + +(defn- garg + "Get a symbol for an anonymous ?argument?" + [^long n] + (symbol (str (if (== -1 n) "rest" (str "p" n)) + "__" (RT/nextID) "#"))) + +(defn- read-fn + [rdr _ opts pending-forms] + (if (thread-bound? #'arg-env) + (throw (IllegalStateException. "Nested #()s are not allowed"))) + (binding [arg-env (sorted-map)] + (let [form (read* (doto rdr (unread \()) true nil opts pending-forms) ;; this sets bindings + rargs (rseq arg-env) + args (if rargs + (let [higharg (long (key ( first rargs)))] + (let [args (loop [i 1 args (transient [])] + (if (> i higharg) + (persistent! args) + (recur (inc i) (conj! args (or (get arg-env i) + (garg i)))))) + args (if (arg-env -1) + (conj args '& (arg-env -1)) + args)] + args)) + [])] + (list 'fn* args form)))) + +(defn- register-arg + "Registers an argument to the arg-env" + [n] + (if (thread-bound? #'arg-env) + (if-let [ret (arg-env n)] + ret + (let [g (garg n)] + (set! arg-env (assoc arg-env n g)) + g)) + (throw (IllegalStateException. "Arg literal not in #()")))) ;; should never hit this + +(declare read-symbol) + +(defn- read-arg + [rdr pct opts pending-forms] + (if-not (thread-bound? #'arg-env) + (read-symbol rdr pct) + (let [ch (peek-char rdr)] + (cond + (or (whitespace? ch) + (macro-terminating? ch) + (nil? ch)) + (register-arg 1) + + (identical? ch \&) + (do (read-char rdr) + (register-arg -1)) + + :else + (let [n (read* rdr true nil opts pending-forms)] + (if-not (integer? n) + (throw (IllegalStateException. "Arg literal must be %, %& or %integer")) + (register-arg n))))))) + +(defn- read-eval + "Evaluate a reader literal" + [rdr _ opts pending-forms] + (when-not *read-eval* + (err/reader-error rdr "#= not allowed when *read-eval* is false")) + (eval (read* rdr true nil opts pending-forms))) + +(def ^:private ^:dynamic gensym-env nil) + +(defn- read-unquote + [rdr comma opts pending-forms] + (if-let [ch (peek-char rdr)] + (if (identical? \@ ch) + ((wrapping-reader 'clojure.core/unquote-splicing) (doto rdr read-char) \@ opts pending-forms) + ((wrapping-reader 'clojure.core/unquote) rdr \~ opts pending-forms)))) + +(declare syntax-quote*) +(defn- unquote-splicing? [form] + (and (seq? form) + (= (first form) 'clojure.core/unquote-splicing))) + +(defn- unquote? [form] + (and (seq? form) + (= (first form) 'clojure.core/unquote))) + +(defn- expand-list + "Expand a list by resolving its syntax quotes and unquotes" + [s] + (loop [s (seq s) r (transient [])] + (if s + (let [item (first s) + ret (conj! r + (cond + (unquote? item) (list 'clojure.core/list (second item)) + (unquote-splicing? item) (second item) + :else (list 'clojure.core/list (syntax-quote* item))))] + (recur (next s) ret)) + (seq (persistent! r))))) + +(defn- flatten-map + "Flatten a map into a seq of alternate keys and values" + [form] + (loop [s (seq form) key-vals (transient [])] + (if s + (let [e (first s)] + (recur (next s) (-> key-vals + (conj! (key e)) + (conj! (val e))))) + (seq (persistent! key-vals))))) + +(defn- register-gensym [sym] + (if-not gensym-env + (throw (IllegalStateException. "Gensym literal not in syntax-quote"))) + (or (get gensym-env sym) + (let [gs (symbol (str (subs (name sym) + 0 (dec (count (name sym)))) + "__" (RT/nextID) "__auto__"))] + (set! gensym-env (assoc gensym-env sym gs)) + gs))) + +(defn ^:dynamic resolve-symbol + "Resolve a symbol s into its fully qualified namespace version" + [s] + (if (pos? (.indexOf (name s) ".")) + (if (.endsWith (name s) ".") + (let [csym (symbol (subs (name s) 0 (dec (count (name s)))))] + (symbol (str (name (resolve-symbol csym)) "."))) + s) + (if-let [ns-str (namespace s)] + (let [ns (resolve-ns (symbol ns-str))] + (if (or (nil? ns) + (= (ns-name* ns) ns-str)) ;; not an alias + s + (symbol (ns-name* ns) (name s)))) + (if-let [o ((ns-map *ns*) s)] + (if (class? o) + (symbol (.getName ^Class o)) + (if (var? o) + (symbol (-> ^Var o .ns ns-name*) (-> ^Var o .sym name)))) + (symbol (ns-name* *ns*) (name s)))))) + +(defn- add-meta [form ret] + (if (and (instance? IObj form) + (seq (dissoc (meta form) :line :column :end-line :end-column :file :source))) + (list 'clojure.core/with-meta ret (syntax-quote* (meta form))) + ret)) + +(defn- syntax-quote-coll [type coll] + ;; We use sequence rather than seq here to fix https://clojure.atlassian.net/browse/CLJ-1444 + ;; But because of https://clojure.atlassian.net/browse/CLJ-1586 we still need to call seq on the form + (let [res (list 'clojure.core/sequence + (list 'clojure.core/seq + (cons 'clojure.core/concat + (expand-list coll))))] + (if type + (list 'clojure.core/apply type res) + res))) + +(defn map-func + "Decide which map type to use, array-map if less than 16 elements" + [coll] + (if (>= (count coll) 16) + 'clojure.core/hash-map + 'clojure.core/array-map)) + +(defn- syntax-quote* [form] + (->> + (cond + (special-symbol? form) (list 'quote form) + + (symbol? form) + (list 'quote + (if (namespace form) + (let [maybe-class ((ns-map *ns*) + (symbol (namespace form)))] + (if (class? maybe-class) + (symbol (.getName ^Class maybe-class) (name form)) + (resolve-symbol form))) + (let [sym (str form)] + (cond + (.endsWith sym "#") + (register-gensym form) + + (.startsWith sym ".") + form + + :else (resolve-symbol form))))) + + (unquote? form) (second form) + (unquote-splicing? form) (throw (IllegalStateException. "unquote-splice not in list")) + + (coll? form) + (cond + + (instance? IRecord form) form + (map? form) (syntax-quote-coll (map-func form) (flatten-map form)) + (vector? form) (list 'clojure.core/vec (syntax-quote-coll nil form)) + (set? form) (syntax-quote-coll 'clojure.core/hash-set form) + (or (seq? form) (list? form)) + (let [seq (seq form)] + (if seq + (syntax-quote-coll nil seq) + '(clojure.core/list))) + + :else (throw (UnsupportedOperationException. "Unknown Collection type"))) + + (or (keyword? form) + (number? form) + (char? form) + (string? form) + (nil? form) + (instance? Boolean form) + (instance? Pattern form)) + form + + :else (list 'quote form)) + (add-meta form))) + +(defn- read-syntax-quote + [rdr backquote opts pending-forms] + (binding [gensym-env {}] + (-> (read* rdr true nil opts pending-forms) + syntax-quote*))) + +(defn- read-namespaced-map + [rdr _ opts pending-forms] + (let [[start-line start-column] (starting-line-col-info rdr) + token (read-token rdr :namespaced-map (read-char rdr))] + (if-let [ns (cond + (= token ":") + (ns-name *ns*) + + (= \: (first token)) + (some-> token (subs 1) parse-symbol second' symbol resolve-ns ns-name) + + :else + (some-> token parse-symbol second'))] + + (let [ch (read-past whitespace? rdr)] + (if (identical? ch \{) + (let [items (read-delimited :namespaced-map \} rdr opts pending-forms) + [end-line end-column] (ending-line-col-info rdr)] + (when (odd? (count items)) + (err/throw-odd-map rdr nil nil items)) + (let [keys (take-nth 2 items) + vals (take-nth 2 (rest items))] + (with-meta + (RT/map (to-array (mapcat list (namespace-keys (str ns) keys) vals))) + (when start-line + (merge + (when-let [file (get-file-name rdr)] + {:file file}) + {:line start-line + :column start-column + :end-line end-line + :end-column end-column}))))) + (err/throw-ns-map-no-map rdr token))) + (err/throw-bad-ns rdr token)))) + +(defn- macros [ch] + (case ch + \" read-string* + \: read-keyword + \; read-comment + \' (wrapping-reader 'quote) + \@ (wrapping-reader 'clojure.core/deref) + \^ read-meta + \` read-syntax-quote ;;(wrapping-reader 'syntax-quote) + \~ read-unquote + \( read-list + \) read-unmatched-delimiter + \[ read-vector + \] read-unmatched-delimiter + \{ read-map + \} read-unmatched-delimiter + \\ read-char* + \% read-arg + \# read-dispatch + nil)) + +(defn- dispatch-macros [ch] + (case ch + \^ read-meta ;deprecated + \' (wrapping-reader 'var) + \( read-fn + \= read-eval + \{ read-set + \< (throwing-reader "Unreadable form") + \" read-regex + \! read-comment + \_ read-discard + \? read-cond + \: read-namespaced-map + \# read-symbolic-value + nil)) + +(defn- read-ctor [rdr class-name opts pending-forms] + (when-not *read-eval* + (err/reader-error rdr "Record construction syntax can only be used when *read-eval* == true")) + (let [class (Class/forName (name class-name) false (RT/baseLoader)) + ch (read-past whitespace? rdr)] ;; differs from clojure + (if-let [[end-ch form] (case ch + \[ [\] :short] + \{ [\} :extended] + nil)] + (let [entries (to-array (read-delimited :record-ctor end-ch rdr opts pending-forms)) + numargs (count entries) + all-ctors (.getConstructors class) + ctors-num (count all-ctors)] + (case form + :short + (loop [i 0] + (if (>= i ctors-num) + (err/reader-error rdr "Unexpected number of constructor arguments to " (str class) + ": got " numargs) + (if (== (count (.getParameterTypes ^Constructor (aget all-ctors i))) + numargs) + (Reflector/invokeConstructor class entries) + (recur (inc i))))) + :extended + (let [vals (RT/map entries)] + (loop [s (keys vals)] + (if s + (if-not (keyword? (first s)) + (err/reader-error rdr "Unreadable ctor form: key must be of type clojure.lang.Keyword") + (recur (next s))))) + (Reflector/invokeStaticMethod class "create" (object-array [vals]))))) + (err/reader-error rdr "Invalid reader constructor form")))) + +(defn- read-tagged [rdr initch opts pending-forms] + (let [tag (read* rdr true nil opts pending-forms)] + (if-not (symbol? tag) + (err/throw-bad-reader-tag rdr tag)) + (if *suppress-read* + (tagged-literal tag (read* rdr true nil opts pending-forms)) + (if-let [f (or (*data-readers* tag) + (default-data-readers tag))] + (f (read* rdr true nil opts pending-forms)) + (if (.contains (name tag) ".") + (read-ctor rdr tag opts pending-forms) + (if-let [f *default-data-reader-fn*] + (f tag (read* rdr true nil opts pending-forms)) + (err/throw-unknown-reader-tag rdr tag))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Public API +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def ^:dynamic *read-eval* + "Defaults to true. + + ***WARNING*** + This setting implies that the full power of the reader is in play, + including syntax that can cause code to execute. It should never be + used with untrusted sources. See also: cljs.vendor.clojure.tools.reader.edn/read. + + When set to logical false in the thread-local binding, + the eval reader (#=) and *record/type literal syntax* are disabled in read/load. + Example (will fail): (binding [*read-eval* false] (read-string \"#=(* 2 21)\")) + + When set to :unknown all reads will fail in contexts where *read-eval* + has not been explicitly bound to either true or false. This setting + can be a useful diagnostic tool to ensure that all of your reads + occur in considered contexts." + true) + +(def ^:dynamic *data-readers* + "Map from reader tag symbols to data reader Vars. + Reader tags without namespace qualifiers are reserved for Clojure. + Default reader tags are defined in cljs.vendor.clojure.tools.reader/default-data-readers + and may be overridden by binding this Var." + {}) + +(def ^:dynamic *default-data-reader-fn* + "When no data reader is found for a tag and *default-data-reader-fn* + is non-nil, it will be called with two arguments, the tag and the value. + If *default-data-reader-fn* is nil (the default value), an exception + will be thrown for the unknown tag." + nil) + +(def ^:dynamic *suppress-read* false) + +(def default-data-readers + "Default map of data reader functions provided by Clojure. + May be overridden by binding *data-readers*" + {'inst #'data-readers/read-instant-date + 'uuid #'data-readers/default-uuid-reader}) + +(defn ^:private read* + ([reader eof-error? sentinel opts pending-forms] + (read* reader eof-error? sentinel nil opts pending-forms)) + ([reader eof-error? sentinel return-on opts pending-forms] + (when (= :unknown *read-eval*) + (err/reader-error "Reading disallowed - *read-eval* bound to :unknown")) + (try + (loop [] + (let [ret (log-source reader + (if (seq pending-forms) + (.remove ^List pending-forms 0) + (let [ch (read-char reader)] + (cond + (whitespace? ch) reader + (nil? ch) (if eof-error? (err/throw-eof-error reader nil) sentinel) + (= ch return-on) READ_FINISHED + (number-literal? reader ch) (read-number reader ch) + :else (if-let [f (macros ch)] + (f reader ch opts pending-forms) + (read-symbol reader ch))))))] + (if (identical? ret reader) + (recur) + ret))) + (catch Exception e + (if (ex-info? e) + (let [d (ex-data e)] + (if (= :reader-exception (:type d)) + (throw e) + (throw (ex-info (.getMessage 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 (.getMessage 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 + "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 sentinel. If no stream is provided, *in* will be used. + + Opts is a persistent map with valid keys: + :read-cond - :allow to process reader conditionals, or + :preserve to keep all branches + :features - persistent set of feature keywords for reader conditionals + :eof - on eof, return value unless :eofthrow, then throw. + if not specified, will throw + + ***WARNING*** + Note that read can execute code (controlled by *read-eval*), + and as such should be used only with trusted sources. + + To read data structures only, use cljs.vendor.clojure.tools.reader.edn/read + + Note that the function signature of cljs.vendor.clojure.tools.reader/read and + cljs.vendor.clojure.tools.reader.edn/read is not the same for eof-handling" + {:arglists '([] [reader] [opts reader] [reader eof-error? eof-value])} + ([] (read *in* true nil)) + ([reader] (read reader true nil)) + ([{eof :eof :as opts :or {eof :eofthrow}} reader] + (when (source-logging-reader? reader) + (let [^StringBuilder buf (:buffer @(.source-log-frames ^SourceLoggingPushbackReader reader))] + (.setLength buf 0))) + (read* reader (= eof :eofthrow) eof nil opts (LinkedList.))) + ([reader eof-error? sentinel] + (when (source-logging-reader? reader) + (let [^StringBuilder buf (:buffer @(.source-log-frames ^SourceLoggingPushbackReader reader))] + (.setLength buf 0))) + (read* reader eof-error? sentinel nil {} (LinkedList.)))) + +(defn read-string + "Reads one object from the string s. + Returns nil when s is nil or empty. + + ***WARNING*** + Note that read-string can execute code (controlled by *read-eval*), + and as such should be used only with trusted sources. + + To read data structures only, use cljs.vendor.clojure.tools.reader.edn/read-string + + Note that the function signature of cljs.vendor.clojure.tools.reader/read-string and + cljs.vendor.clojure.tools.reader.edn/read-string is not the same for eof-handling" + ([s] + (read-string {} s)) + ([opts s] + (when (and s (not (identical? s ""))) + (read opts (string-push-back-reader s))))) + +(defmacro syntax-quote + "Macro equivalent to the syntax-quote reader macro (`)." + [form] + (binding [gensym-env {}] + (syntax-quote* form))) + +(defn read+string + "Like read, and taking the same args. reader must be a SourceLoggingPushbackReader. + Returns a vector containing the object read and the (whitespace-trimmed) string read." + ([] (read+string (source-logging-push-back-reader *in*))) + ([stream] (read+string stream true nil)) + ([^SourceLoggingPushbackReader stream eof-error? eof-value] + (let [o (log-source stream (read stream eof-error? eof-value)) + s (.trim (str (:buffer @(.source-log-frames stream))))] + [o s])) + ([opts ^SourceLoggingPushbackReader stream] + (let [o (log-source stream (read opts stream)) + s (.trim (str (:buffer @(.source-log-frames stream))))] + [o s]))) diff --git a/src/main/clojure/cljs/vendor/clojure/tools/reader/default_data_readers.clj b/src/main/clojure/cljs/vendor/clojure/tools/reader/default_data_readers.clj new file mode 100644 index 000000000..3a61f9775 --- /dev/null +++ b/src/main/clojure/cljs/vendor/clojure/tools/reader/default_data_readers.clj @@ -0,0 +1,303 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; 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. + +;;; copied from clojure.instant and clojure.uuid ;;; + +(ns ^:skip-wiki cljs.vendor.clojure.tools.reader.default-data-readers + (:import [java.util Calendar Date GregorianCalendar TimeZone] + [java.sql Timestamp])) + +;;; clojure.instant ;;; + +;;; ------------------------------------------------------------------------ +;;; convenience macros + +(defmacro ^:private fail + [msg] + `(throw (RuntimeException. ~msg))) + +(defmacro ^:private verify + ([test msg] `(when-not ~test (fail ~msg))) + ([test] `(verify ~test ~(str "failed: " (pr-str test))))) + +(defn- divisible? + [num div] + (zero? (mod num div))) + +(defn- indivisible? + [num div] + (not (divisible? num div))) + + +;;; ------------------------------------------------------------------------ +;;; parser implementation + +(defn- parse-int [^String s] + (Long/parseLong s)) + +(defn- zero-fill-right [^String s width] + (cond (= width (count s)) s + (< width (count s)) (.substring s 0 width) + :else (loop [b (StringBuilder. s)] + (if (< (.length b) width) + (recur (.append b \0)) + (.toString b))))) + +(def parse-timestamp + "Parse a string containing an RFC3339-like like timestamp. + +The function new-instant is called with the following arguments. + + min max default + --- ------------ ------- + years 0 9999 N/A (s must provide years) + months 1 12 1 + days 1 31 1 (actual max days depends + hours 0 23 0 on month and year) + minutes 0 59 0 + seconds 0 60 0 (though 60 is only valid + nanoseconds 0 999999999 0 when minutes is 59) + offset-sign -1 1 0 + offset-hours 0 23 0 + offset-minutes 0 59 0 + +These are all integers and will be non-nil. (The listed defaults +will be passed if the corresponding field is not present in s.) + +Grammar (of s): + + date-fullyear = 4DIGIT + date-month = 2DIGIT ; 01-12 + date-mday = 2DIGIT ; 01-28, 01-29, 01-30, 01-31 based on + ; month/year + time-hour = 2DIGIT ; 00-23 + time-minute = 2DIGIT ; 00-59 + time-second = 2DIGIT ; 00-58, 00-59, 00-60 based on leap second + ; rules + time-secfrac = '.' 1*DIGIT + time-numoffset = ('+' / '-') time-hour ':' time-minute + time-offset = 'Z' / time-numoffset + + time-part = time-hour [ ':' time-minute [ ':' time-second + [time-secfrac] [time-offset] ] ] + + timestamp = date-year [ '-' date-month [ '-' date-mday + [ 'T' time-part ] ] ] + +Unlike RFC3339: + + - we only parse the timestamp format + - timestamp can elide trailing components + - time-offset is optional (defaults to +00:00) + +Though time-offset is syntactically optional, a missing time-offset +will be treated as if the time-offset zero (+00:00) had been +specified. +" + (let [timestamp #"(\d\d\d\d)(?:-(\d\d)(?:-(\d\d)(?:[T](\d\d)(?::(\d\d)(?::(\d\d)(?:[.](\d+))?)?)?)?)?)?(?:[Z]|([-+])(\d\d):(\d\d))?"] + + (fn [new-instant ^CharSequence cs] + (if-let [[_ years months days hours minutes seconds fraction + offset-sign offset-hours offset-minutes] + (re-matches timestamp cs)] + (new-instant + (parse-int years) + (if-not months 1 (parse-int months)) + (if-not days 1 (parse-int days)) + (if-not hours 0 (parse-int hours)) + (if-not minutes 0 (parse-int minutes)) + (if-not seconds 0 (parse-int seconds)) + (if-not fraction 0 (parse-int (zero-fill-right fraction 9))) + (cond (= "-" offset-sign) -1 + (= "+" offset-sign) 1 + :else 0) + (if-not offset-hours 0 (parse-int offset-hours)) + (if-not offset-minutes 0 (parse-int offset-minutes))) + (fail (str "Unrecognized date/time syntax: " cs)))))) + + +;;; ------------------------------------------------------------------------ +;;; Verification of Extra-Grammatical Restrictions from RFC3339 + +(defn- leap-year? + [year] + (and (divisible? year 4) + (or (indivisible? year 100) + (divisible? year 400)))) + +(def ^:private days-in-month + (let [dim-norm [nil 31 28 31 30 31 30 31 31 30 31 30 31] + dim-leap [nil 31 29 31 30 31 30 31 31 30 31 30 31]] + (fn [month leap-year?] + ((if leap-year? dim-leap dim-norm) month)))) + +(defn validated + "Return a function which constructs and instant by calling constructor +after first validating that those arguments are in range and otherwise +plausible. The resulting function will throw an exception if called +with invalid arguments." + [new-instance] + (fn [years months days hours minutes seconds nanoseconds + offset-sign offset-hours offset-minutes] + (verify (<= 1 months 12)) + (verify (<= 1 days (days-in-month months (leap-year? years)))) + (verify (<= 0 hours 23)) + (verify (<= 0 minutes 59)) + (verify (<= 0 seconds (if (= minutes 59) 60 59))) + (verify (<= 0 nanoseconds 999999999)) + (verify (<= -1 offset-sign 1)) + (verify (<= 0 offset-hours 23)) + (verify (<= 0 offset-minutes 59)) + (new-instance years months days hours minutes seconds nanoseconds + offset-sign offset-hours offset-minutes))) + + +;;; ------------------------------------------------------------------------ +;;; print integration + +(def ^:private ^ThreadLocal thread-local-utc-date-format + ;; SimpleDateFormat is not thread-safe, so we use a ThreadLocal proxy for access. + ;; http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=4228335 + (proxy [ThreadLocal] [] + (initialValue [] + (doto (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS-00:00") + ;; RFC3339 says to use -00:00 when the timezone is unknown (+00:00 implies a known GMT) + (.setTimeZone (java.util.TimeZone/getTimeZone "GMT")))))) + +(defn- print-date + "Print a java.util.Date as RFC3339 timestamp, always in UTC." + [^java.util.Date d, ^java.io.Writer w] + (let [utc-format (.get thread-local-utc-date-format)] + (.write w "#inst \"") + (.write w ^String (.format ^java.text.SimpleDateFormat utc-format d)) + (.write w "\""))) + +(defmethod print-method java.util.Date + [^java.util.Date d, ^java.io.Writer w] + (print-date d w)) + +(defmethod print-dup java.util.Date + [^java.util.Date d, ^java.io.Writer w] + (print-date d w)) + +(defn- print-calendar + "Print a java.util.Calendar as RFC3339 timestamp, preserving timezone." + [^java.util.Calendar c, ^java.io.Writer w] + (let [calstr (format "%1$tFT%1$tT.%1$tL%1$tz" c) + offset-minutes (- (.length calstr) 2)] + ;; calstr is almost right, but is missing the colon in the offset + (.write w "#inst \"") + (.write w calstr 0 offset-minutes) + (.write w ":") + (.write w calstr offset-minutes 2) + (.write w "\""))) + +(defmethod print-method java.util.Calendar + [^java.util.Calendar c, ^java.io.Writer w] + (print-calendar c w)) + +(defmethod print-dup java.util.Calendar + [^java.util.Calendar c, ^java.io.Writer w] + (print-calendar c w)) + + +(def ^:private ^ThreadLocal thread-local-utc-timestamp-format + ;; SimpleDateFormat is not thread-safe, so we use a ThreadLocal proxy for access. + ;; http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=4228335 + (proxy [ThreadLocal] [] + (initialValue [] + (doto (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss") + (.setTimeZone (java.util.TimeZone/getTimeZone "GMT")))))) + +(defn- print-timestamp + "Print a java.sql.Timestamp as RFC3339 timestamp, always in UTC." + [^java.sql.Timestamp ts, ^java.io.Writer w] + (let [utc-format (.get thread-local-utc-timestamp-format)] + (.write w "#inst \"") + (.write w ^String (.format ^java.text.SimpleDateFormat utc-format ts)) + ;; add on nanos and offset + ;; RFC3339 says to use -00:00 when the timezone is unknown (+00:00 implies a known GMT) + (.write w (format ".%09d-00:00" (.getNanos ts))) + (.write w "\""))) + +(defmethod print-method java.sql.Timestamp + [^java.sql.Timestamp ts, ^java.io.Writer w] + (print-timestamp ts w)) + +(defmethod print-dup java.sql.Timestamp + [^java.sql.Timestamp ts, ^java.io.Writer w] + (print-timestamp ts w)) + + +;;; ------------------------------------------------------------------------ +;;; reader integration + +(defn- construct-calendar + "Construct a java.util.Calendar, preserving the timezone +offset, but truncating the subsecond fraction to milliseconds." + ^GregorianCalendar + [years months days hours minutes seconds nanoseconds + offset-sign offset-hours offset-minutes] + (doto (GregorianCalendar. years (dec months) days hours minutes seconds) + (.set Calendar/MILLISECOND (quot nanoseconds 1000000)) + (.setTimeZone (TimeZone/getTimeZone + (format "GMT%s%02d:%02d" + (if (neg? offset-sign) "-" "+") + offset-hours offset-minutes))))) + +(defn- construct-date + "Construct a java.util.Date, which expresses the original instant as +milliseconds since the epoch, UTC." + [years months days hours minutes seconds nanoseconds + offset-sign offset-hours offset-minutes] + (.getTime (construct-calendar years months days + hours minutes seconds nanoseconds + offset-sign offset-hours offset-minutes))) + +(defn- construct-timestamp + "Construct a java.sql.Timestamp, which has nanosecond precision." + [years months days hours minutes seconds nanoseconds + offset-sign offset-hours offset-minutes] + (doto (Timestamp. + (.getTimeInMillis + (construct-calendar years months days + hours minutes seconds 0 + offset-sign offset-hours offset-minutes))) + ;; nanos must be set separately, pass 0 above for the base calendar + (.setNanos nanoseconds))) + +(def read-instant-date + "To read an instant as a java.util.Date, bind *data-readers* to a map with +this var as the value for the 'inst key. The timezone offset will be used +to convert into UTC." + (partial parse-timestamp (validated construct-date))) + +(def read-instant-calendar + "To read an instant as a java.util.Calendar, bind *data-readers* to a map with +this var as the value for the 'inst key. Calendar preserves the timezone +offset." + (partial parse-timestamp (validated construct-calendar))) + +(def read-instant-timestamp + "To read an instant as a java.sql.Timestamp, bind *data-readers* to a +map with this var as the value for the 'inst key. Timestamp preserves +fractional seconds with nanosecond precision. The timezone offset will +be used to convert into UTC." + (partial parse-timestamp (validated construct-timestamp))) + +;;; clojure.uuid ;;; + +(defn default-uuid-reader [form] + {:pre [(string? form)]} + (java.util.UUID/fromString form)) + +(defmethod print-method java.util.UUID [uuid ^java.io.Writer w] + (.write w (str "#uuid \"" (str uuid) "\""))) + +(defmethod print-dup java.util.UUID [o w] + (print-method o w)) diff --git a/src/main/clojure/cljs/vendor/clojure/tools/reader/edn.clj b/src/main/clojure/cljs/vendor/clojure/tools/reader/edn.clj new file mode 100644 index 000000000..2de4ad94a --- /dev/null +++ b/src/main/clojure/cljs/vendor/clojure/tools/reader/edn.clj @@ -0,0 +1,440 @@ +;; 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.vendor.clojure.tools.reader.edn + (:refer-clojure :exclude [read read-string char default-data-readers]) + (:require [cljs.vendor.clojure.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.vendor.clojure.tools.reader.impl.utils :refer + [char ex-info? whitespace? numeric? desugar-meta namespace-keys second']] + [cljs.vendor.clojure.tools.reader.impl.commons :refer :all] + [cljs.vendor.clojure.tools.reader.impl.errors :as err] + [cljs.vendor.clojure.tools.reader :refer [default-data-readers]]) + (: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 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 (StringBuilder.) + ch initch] + (if (or (whitespace? ch) + (macro-terminating? ch) + (nil? ch)) + (do (unread rdr ch) + (str sb)) + (if (not-constituent? ch) + (err/throw-bad-char rdr kind ch) + (recur (doto sb (.append ch)) (read-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) + (read-tagged (doto rdr (unread ch)) ch opts)) + (err/throw-eof-at-dispatch rdr))) + +(defn- read-unmatched-delimiter + [rdr ch opts] + (err/throw-unmatch-delimiter rdr ch)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; readers +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(defn- read-unicode-char + ([^String token ^long offset ^long length ^long 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) + (char uc) + (let [d (Character/digit (int (nth token i)) (int base))] + (if (== d -1) + (err/throw-invalid-unicode-digit-in-token nil (nth token i) token) + (recur (inc i) (long (+ d (* uc base)))))))))) + + ([rdr initch base length exact?] + (let [length (long length) + base (long base)] + (loop [i 1 uc (Character/digit (int initch) (int 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) + (char uc)) + (let [d (Character/digit (int ch) (int base))] + (read-char rdr) + (if (== d -1) + (err/throw-invalid-unicode-digit rdr ch) + (recur (inc i) (long (+ d (* uc base)))))))) + (char uc))))))) + +(def ^:private ^:const upper-limit (int \uD7ff)) +(def ^:private ^:const lower-limit (int \uE000)) + +(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) (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)) + (err/throw-invalid-character-literal rdr (Integer/toString ic 16)) + c)) + + (.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- ^PersistentVector 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 (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 :list \) rdr opts)] + (if (empty? the-list) + '() + (clojure.lang.PersistentList/create 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) + coll (read-delimited :map \} rdr opts) + l (to-array coll)] + (when (== 1 (bit-and (alength l) 1)) + (err/throw-odd-map rdr start-line start-column coll)) + (RT/map l))) + +(defn- read-number + [rdr initch opts] + (loop [sb (doto (StringBuilder.) (.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 (Character/digit (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 (StringBuilder.) + 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 [^String ns (s 0) + ^String name (s 1)] + (if (identical? \: (nth token 0)) + (err/throw-invalid reader :keyword (str \: token)) ; No ::kw in edn. + (keyword ns name))) + (err/throw-invalid reader :keyword (str \: 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 (instance? IMeta o) + (with-meta o (merge (meta o) m)) + (err/throw-bad-metadata-target rdr o))))) + +(defn- read-set + [rdr _ opts] + (PersistentHashSet/createWithCheck (read-delimited :set \} rdr opts))) + +(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 (take-nth 2 items) + vals (take-nth 2 (rest items))] + (RT/map (to-array (mapcat list (namespace-keys (str ns) 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 + Inf Double/POSITIVE_INFINITY + -Inf Double/NEGATIVE_INFINITY + NaN Double/NaN + (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 or a java.io.PushbackReader. + 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 + + cljs.vendor.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." + ([] (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 + (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 Exception e + (if (ex-info? e) + (let [d (ex-data e)] + (if (= :reader-exception (:type d)) + (throw e) + (throw (ex-info (.getMessage 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 (.getMessage 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 cljs.vendor.clojure.tools.reader.edn/read" + ([s] (read-string {:eof nil} s)) + ([opts s] + (when (and s (not (identical? s ""))) + (read opts (string-push-back-reader s))))) diff --git a/src/main/clojure/cljs/vendor/clojure/tools/reader/impl/commons.clj b/src/main/clojure/cljs/vendor/clojure/tools/reader/impl/commons.clj new file mode 100644 index 000000000..8162909c2 --- /dev/null +++ b/src/main/clojure/cljs/vendor/clojure/tools/reader/impl/commons.clj @@ -0,0 +1,131 @@ +;; 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 cljs.vendor.clojure.tools.reader.impl.commons + (:refer-clojure :exclude [char]) + (:require [cljs.vendor.clojure.tools.reader.reader-types :refer [peek-char read-char]] + [cljs.vendor.clojure.tools.reader.impl.errors :refer [reader-error]] + [cljs.vendor.clojure.tools.reader.impl.utils :refer [numeric? newline? char]]) + (:import (clojure.lang BigInt Numbers) + (java.util.regex Pattern Matcher) + java.lang.reflect.Constructor)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; helpers +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn number-literal? + "Checks whether the reader is at the start of a number literal" + [reader initch] + (or (numeric? initch) + (and (or (identical? \+ initch) (identical? \- initch)) + (numeric? (peek-char reader))))) + +(defn read-past + "Read until first character that doesn't match pred, returning + char." + [pred rdr] + (loop [ch (read-char rdr)] + (if (pred ch) + (recur (read-char rdr)) + ch))) + +(defn skip-line + "Advances the reader to the end of a line. Returns the reader" + [reader] + (loop [] + (when-not (newline? (read-char reader)) + (recur))) + reader) + +(def ^Pattern 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)?") +(def ^Pattern ratio-pattern #"([-+]?[0-9]+)/([0-9]+)") +(def ^Pattern float-pattern #"([-+]?[0-9]+(\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?") + +(defn- match-int + [^Matcher m] + (if (.group m 2) + (if (.group m 8) 0N 0) + (let [negate? (= "-" (.group m 1)) + a (cond + (.group m 3) [(.group m 3) 10] + (.group m 4) [(.group m 4) 16] + (.group m 5) [(.group m 5) 8] + (.group m 7) [(.group m 7) (Integer/parseInt (.group m 6))] + :else [nil nil]) + ^String n (a 0)] + (when n + (let [bn (BigInteger. n (int (a 1))) + bn (if negate? (.negate bn) bn)] + (if (.group m 8) + (BigInt/fromBigInteger bn) + (if (< (.bitLength bn) 64) + (.longValue bn) + (BigInt/fromBigInteger bn)))))))) + +(defn- match-ratio + [^Matcher m] + (let [^String numerator (.group m 1) + ^String denominator (.group m 2) + numerator (if (.startsWith numerator "+") + (subs numerator 1) + numerator)] + (/ (-> numerator BigInteger. BigInt/fromBigInteger Numbers/reduceBigInt) + (-> denominator BigInteger. BigInt/fromBigInteger Numbers/reduceBigInt)))) + +(defn- match-float + [^String s ^Matcher m] + (if (.group m 4) + (BigDecimal. ^String (.group m 1)) + (Double/parseDouble s))) + +(defn match-number [^String s] + (let [int-matcher (.matcher int-pattern s)] + (if (.matches int-matcher) + (match-int int-matcher) + (let [float-matcher (.matcher float-pattern s)] + (if (.matches float-matcher) + (match-float s float-matcher) + (let [ratio-matcher (.matcher ratio-pattern s)] + (when (.matches ratio-matcher) + (match-ratio ratio-matcher)))))))) + +(defn parse-symbol + "Parses a string into a vector of the namespace and symbol" + [^String token] + (when-not (or (= "" token) + (.endsWith token ":") + (.startsWith token "::")) + (let [ns-idx (.indexOf token "/")] + (if-let [^String ns (and (pos? ns-idx) + (subs token 0 ns-idx))] + (let [ns-idx (inc ns-idx)] + (when-not (== ns-idx (count token)) + (let [sym (subs token ns-idx)] + (when (and (not (numeric? (nth sym 0))) + (not (= "" sym)) + (not (.endsWith ns ":")) + (or (= sym "/") + (== -1 (.indexOf sym "/")))) + [ns sym])))) + (when (or (= token "/") + (== -1 (.indexOf token "/"))) + [nil token]))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; readers +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn read-comment + [rdr & _] + (skip-line rdr)) + +(defn throwing-reader + [msg] + (fn [rdr & _] + (reader-error rdr msg))) diff --git a/src/main/clojure/cljs/vendor/clojure/tools/reader/impl/errors.clj b/src/main/clojure/cljs/vendor/clojure/tools/reader/impl/errors.clj new file mode 100644 index 000000000..862982882 --- /dev/null +++ b/src/main/clojure/cljs/vendor/clojure/tools/reader/impl/errors.clj @@ -0,0 +1,214 @@ +;; Copyright (c) Russ Olsen, 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 cljs.vendor.clojure.tools.reader.impl.errors + (:require [cljs.vendor.clojure.tools.reader.reader-types :as types] + [cljs.vendor.clojure.tools.reader.impl.inspect :as i])) + +(defn- location-details [rdr ex-type] + (let [details {:type :reader-exception + :ex-kind ex-type}] + (if (types/indexing-reader? rdr) + (assoc + details + :file (types/get-file-name rdr) + :line (types/get-line-number rdr) + :col (types/get-column-number rdr)) + details))) + +(defn ^:private throw-ex + [rdr ex-type & msg] + (let [details (location-details rdr ex-type) + file (:file details) + line (:line details) + col (:col details) + msg1 (if file (str file " ")) + msg2 (if line (str "[line " line ", col " col "]")) + msg3 (if (or msg1 msg2) " ") + full-msg (apply str msg1 msg2 msg3 msg)] + (throw (ex-info full-msg details)))) + +(defn reader-error + "Throws an ExceptionInfo with the given message. + If rdr is an IndexingReader, additional information about column and line number is provided" + [rdr & msgs] + (throw-ex rdr :reader-error (apply str msgs))) + +(defn eof-error + "Throws an ExceptionInfo with the given message. + If rdr is an IndexingReader, additional information about column and line number is provided" + [rdr & msgs] + (throw-ex rdr :eof (apply str msgs))) + +(defn illegal-arg-error + "Throws an ExceptionInfo with the given message. + If rdr is an IndexingReader, additional information about column and line number is provided" + [rdr & msgs] + (throw-ex rdr :illegal-argument (apply str msgs))) + +(defn throw-eof-delimited + ([rdr kind line column] (throw-eof-delimited rdr kind line column nil)) + ([rdr kind line column n] + (eof-error + rdr + "Unexpected EOF while reading " + (if n + (str "item " n " of ")) + (name kind) + (if line + (str ", starting at line " line " and column " column)) + "."))) + +(defn throw-odd-map [rdr line col elements] + (reader-error + rdr + "The map literal starting with " + (i/inspect (first elements)) + (if line (str " on line " line " column " col)) + " contains " + (count elements) + " form(s). Map literals must contain an even number of forms.")) + +(defn throw-invalid-number [rdr token] + (reader-error + rdr + "Invalid number: " + token + ".")) + +(defn throw-invalid-unicode-literal [rdr token] + (throw + (illegal-arg-error rdr + "Invalid unicode literal: \\" token "."))) + +(defn throw-invalid-unicode-escape [rdr ch] + (reader-error + rdr + "Invalid unicode escape: \\u" + ch + ".")) + +(defn throw-invalid [rdr kind token] + (reader-error rdr "Invalid " (name kind) ": " token ".")) + +(defn throw-eof-at-start [rdr kind] + (eof-error rdr "Unexpected EOF while reading start of " (name kind) ".")) + +(defn throw-bad-char [rdr kind ch] + (reader-error rdr "Invalid character: " ch " found while reading " (name kind) ".")) + +(defn throw-eof-at-dispatch [rdr] + (eof-error rdr "Unexpected EOF while reading dispatch character.")) + +(defn throw-unmatch-delimiter [rdr ch] + (reader-error rdr "Unmatched delimiter " ch ".")) + +(defn throw-eof-reading [rdr kind & start] + (let [init (case kind :regex "#\"" :string \")] + (eof-error rdr "Unexpected EOF reading " (name kind) " starting " (apply str init start) "."))) + +(defn throw-invalid-unicode-char[rdr token] + (throw + (illegal-arg-error rdr + "Invalid unicode character \\" token "."))) + +(defn throw-invalid-unicode-digit-in-token [rdr ch token] + (throw + (illegal-arg-error rdr + "Invalid digit " ch " in unicode character \\" token "."))) + +(defn throw-invalid-unicode-digit[rdr ch] + (throw + (illegal-arg-error rdr + "Invalid digit " ch " in unicode character."))) + +(defn throw-invalid-unicode-len[rdr actual expected] + (throw + (illegal-arg-error rdr + "Invalid unicode literal. Unicode literals should be " + expected + " characters long. " + "Value supplied is " + actual + " characters long."))) + +(defn throw-invalid-character-literal[rdr token] + (reader-error rdr "Invalid character literal \\u" token ".")) + +(defn throw-invalid-octal-len[rdr token] + (reader-error + rdr + "Invalid octal escape sequence in a character literal: " + token + ". Octal escape sequences must be 3 or fewer digits.")) + +(defn throw-bad-octal-number [rdr] + (reader-error rdr "Octal escape sequence must be in range [0, 377].")) + +(defn throw-unsupported-character[rdr token] + (reader-error + rdr + "Unsupported character: " + token + ".")) + +(defn throw-eof-in-character[rdr] + (eof-error rdr "Unexpected EOF while reading character.")) + +(defn throw-bad-escape-char [rdr ch] + (reader-error rdr "Unsupported escape character: \\" ch ".")) + +(defn throw-single-colon [rdr] + (reader-error rdr "A single colon is not a valid keyword.")) + +(defn throw-bad-metadata [rdr x] + (reader-error + rdr + "Metadata cannot be " + (i/inspect x) + ". Metadata must be a Symbol, Keyword, String or Map.")) + +(defn throw-bad-metadata-target [rdr target] + (reader-error + rdr + "Metadata can not be applied to " + (i/inspect target) + ". " + "Metadata can only be applied to IMetas.")) + +(defn throw-feature-not-keyword [rdr feature] + (reader-error + rdr + "Feature cannot be " + (i/inspect feature) + ". Features must be keywords.")) + +(defn throw-ns-map-no-map [rdr ns-name] + (reader-error rdr "Namespaced map with namespace " ns-name " does not specify a map.")) + +(defn throw-bad-ns [rdr ns-name] + (reader-error rdr "Invalid value used as namespace in namespaced map: " ns-name ".")) + +(defn throw-bad-reader-tag [rdr tag] + (reader-error + rdr + "Invalid reader tag: " + (i/inspect tag) + ". Reader tags must be symbols.")) + +(defn throw-unknown-reader-tag [rdr tag] + (reader-error + rdr + "No reader function for tag " + (i/inspect tag) + ".")) + +(defn throw-eof-error [rdr line] + (if line + (eof-error rdr "EOF while reading, starting at line " line ".") + (eof-error rdr "EOF while reading."))) diff --git a/src/main/clojure/cljs/vendor/clojure/tools/reader/impl/inspect.clj b/src/main/clojure/cljs/vendor/clojure/tools/reader/impl/inspect.clj new file mode 100644 index 000000000..cd7be5641 --- /dev/null +++ b/src/main/clojure/cljs/vendor/clojure/tools/reader/impl/inspect.clj @@ -0,0 +1,91 @@ +;; Copyright (c) Russ Olsen, 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 cljs.vendor.clojure.tools.reader.impl.inspect) + +(declare inspect*) + +(defn- inspect*-col [truncate col start end] + (let [n (count col) + l (if truncate 0 (min 10 n)) + elements (map (partial inspect* true) (take l col)) + content (apply str (interpose " " elements)) + suffix (if (< l n) "...")] + (str start content suffix end))) + +(defn- dispatch-inspect + [_ x] + (cond + (nil? x) :nil + (string? x) :string + (keyword? x) :strable + (number? x) :strable + (symbol? x) :strable + (vector? x) :vector + (list? x) :list + (map? x) :map + (set? x) :set + (= x true) :strable + (= x false) :strable + :default (class x))) + +(defmulti inspect* dispatch-inspect) + +(defmethod inspect* :string [truncate ^String x] + (let [n (if truncate 5 20) + suffix (if (> (.length x) n) "...\"" "\"")] + (str + \" + (.substring ^String x 0 (min n (.length x))) + suffix))) + +(defmethod inspect* :strable [truncate x] (str x)) + +(defmethod inspect* clojure.lang.PersistentVector$ChunkedSeq [truncate x] + "") + +(defmethod inspect* clojure.lang.PersistentArrayMap$Seq [truncate x] + "") + +(defmethod inspect* clojure.lang.PersistentHashMap$NodeSeq [truncate x] + "") + +(defmethod inspect* clojure.lang.Cons [truncate x] "") + +(defmethod inspect* clojure.lang.LazySeq [truncate x] "") + +(defmethod inspect* :nil [_ _] "nil") + +(defmethod inspect* :list [truncate col] + (inspect*-col truncate col \( \))) + +(defmethod inspect* :map [truncate m] + (let [len (count m) + n-shown (if truncate 0 len) + contents (apply concat (take n-shown m)) + suffix (if (> len n-shown) "...}" \})] + (inspect*-col truncate contents \{ suffix))) + +(defmethod inspect* :set [truncate col] + (inspect*-col truncate col "#{" \})) + +(defmethod inspect* :vector [truncate col] + (inspect*-col truncate col \[ \])) + +(defmethod inspect* :default [truncate x] + (let [classname (if (nil? x) "nil" (.getName (class x)))] + (str "<" classname ">"))) + +(defn inspect + "Return a string description of the value supplied. + May be the a string version of the value itself (e.g. \"true\") + or it may be a description (e.g. \"an instance of Foo\"). + If truncate is true then return a very terse version of + the inspection." + ([x] (inspect* false x)) + ([truncate x] (inspect* truncate x))) diff --git a/src/main/clojure/cljs/vendor/clojure/tools/reader/impl/utils.clj b/src/main/clojure/cljs/vendor/clojure/tools/reader/impl/utils.clj new file mode 100644 index 000000000..0b814e8e7 --- /dev/null +++ b/src/main/clojure/cljs/vendor/clojure/tools/reader/impl/utils.clj @@ -0,0 +1,127 @@ +;; 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 ^:skip-wiki cljs.vendor.clojure.tools.reader.impl.utils + (:refer-clojure :exclude [char reader-conditional tagged-literal])) + +(defn char [x] + (when x + (clojure.core/char x))) + +(def <=clojure-1-7-alpha5 + (let [{:keys [minor qualifier]} *clojure-version*] + (or (< minor 7) + (and (= minor 7) + (= "alpha" + (when qualifier + (subs qualifier 0 (dec (count qualifier))))) + (<= (read-string (subs qualifier (dec (count qualifier)))) + 5))))) + +(defmacro compile-when [cond & then] + (when (eval cond) + `(do ~@then))) + +(defn ex-info? [ex] + (instance? clojure.lang.ExceptionInfo ex)) + +(compile-when <=clojure-1-7-alpha5 + (defrecord TaggedLiteral [tag form]) + + (defn tagged-literal? + "Return true if the value is the data representation of a tagged literal" + [value] + (instance? cljs.vendor.clojure.tools.reader.impl.utils.TaggedLiteral value)) + + (defn tagged-literal + "Construct a data representation of a tagged literal from a + tag symbol and a form." + [tag form] + (cljs.vendor.clojure.tools.reader.impl.utils.TaggedLiteral. tag form)) + + (ns-unmap *ns* '->TaggedLiteral) + (ns-unmap *ns* 'map->TaggedLiteral) + + (defmethod print-method cljs.vendor.clojure.tools.reader.impl.utils.TaggedLiteral [o ^java.io.Writer w] + (.write w "#") + (print-method (:tag o) w) + (.write w " ") + (print-method (:form o) w)) + + (defrecord ReaderConditional [splicing? form]) + (ns-unmap *ns* '->ReaderConditional) + (ns-unmap *ns* 'map->ReaderConditional) + + (defn reader-conditional? + "Return true if the value is the data representation of a reader conditional" + [value] + (instance? cljs.vendor.clojure.tools.reader.impl.utils.ReaderConditional value)) + + (defn reader-conditional + "Construct a data representation of a reader conditional. + If true, splicing? indicates read-cond-splicing." + [form splicing?] + (cljs.vendor.clojure.tools.reader.impl.utils.ReaderConditional. splicing? form)) + + (defmethod print-method cljs.vendor.clojure.tools.reader.impl.utils.ReaderConditional [o ^java.io.Writer w] + (.write w "#?") + (when (:splicing? o) (.write w "@")) + (print-method (:form o) w))) + +(defn whitespace? + "Checks whether a given character is whitespace" + [ch] + (when ch + (or (Character/isWhitespace ^Character ch) + (identical? \, ch)))) + +(defn numeric? + "Checks whether a given character is numeric" + [^Character ch] + (when ch + (Character/isDigit ch))) + +(defn newline? + "Checks whether the character is a newline" + [c] + (or (identical? \newline c) + (nil? c))) + +(defn desugar-meta + "Resolves syntactical sugar in metadata" ;; could be combined with some other desugar? + [f] + (cond + (keyword? f) {f true} + (symbol? f) {:tag f} + (string? f) {:tag f} + :else f)) + +(defn make-var + "Returns an anonymous unbound Var" + [] + (with-local-vars [x nil] x)) + +(defn namespace-keys [ns keys] + (for [key keys] + (if (or (symbol? key) + (keyword? key)) + (let [[key-ns key-name] ((juxt namespace name) key) + ->key (if (symbol? key) symbol keyword)] + (cond + (nil? key-ns) + (->key ns key-name) + + (= "_" key-ns) + (->key key-name) + + :else + key)) + key))) + +(defn second' [[a b]] + (when-not a b)) diff --git a/src/main/clojure/cljs/vendor/clojure/tools/reader/reader_types.clj b/src/main/clojure/cljs/vendor/clojure/tools/reader/reader_types.clj new file mode 100644 index 000000000..8be8cd96c --- /dev/null +++ b/src/main/clojure/cljs/vendor/clojure/tools/reader/reader_types.clj @@ -0,0 +1,431 @@ +;; 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 "Protocols and default Reader types implementation" + :author "Bronsa"} + cljs.vendor.clojure.tools.reader.reader-types + (:refer-clojure :exclude [char read-line]) + (:require [cljs.vendor.clojure.tools.reader.impl.utils :refer [char whitespace? newline? make-var]]) + (:import clojure.lang.LineNumberingPushbackReader + (java.io InputStream BufferedReader Closeable))) + +(defmacro ^:private update! [what f] + (list 'set! what (list f what))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; reader protocols +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defprotocol Reader + (read-char [reader] + "Returns the next char from the Reader, nil if the end of stream has been reached") + (peek-char [reader] + "Returns the next char from the Reader without removing it from the reader stream")) + +(defprotocol IPushbackReader + (unread [reader ch] + "Pushes back a single character on to the stream")) + +(defprotocol IndexingReader + (get-line-number [reader] + "Returns the line number of the next character to be read from the stream") + (get-column-number [reader] + "Returns the column number of the next character to be read from the stream") + (get-file-name [reader] + "Returns the file name the reader is reading from, or nil")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; reader deftypes +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(deftype StringReader + [^String s ^long s-len ^:unsynchronized-mutable ^long s-pos] + Reader + (read-char [reader] + (when (> s-len s-pos) + (let [r (nth s s-pos)] + (update! s-pos inc) + r))) + (peek-char [reader] + (when (> s-len s-pos) + (nth s s-pos)))) + +(deftype InputStreamReader [^InputStream is ^:unsynchronized-mutable ^"[B" buf] + Reader + (read-char [reader] + (if buf + (let [c (aget buf 0)] + (set! buf nil) + (char c)) + (let [c (.read is)] + (when (>= c 0) + (char c))))) + (peek-char [reader] + (when-not buf + (set! buf (byte-array 1)) + (when (== -1 (.read is buf)) + (set! buf nil))) + (when buf + (char (aget buf 0)))) + Closeable + (close [this] + (.close is))) + +(deftype PushbackReader + [rdr ^"[Ljava.lang.Object;" buf ^long buf-len ^:unsynchronized-mutable ^long buf-pos] + Reader + (read-char [reader] + (char + (if (< buf-pos buf-len) + (let [r (aget buf buf-pos)] + (update! buf-pos inc) + r) + (read-char rdr)))) + (peek-char [reader] + (char + (if (< buf-pos buf-len) + (aget buf buf-pos) + (peek-char rdr)))) + IPushbackReader + (unread [reader ch] + (when ch + (if (zero? buf-pos) (throw (RuntimeException. "Pushback buffer is full"))) + (update! buf-pos dec) + (aset buf buf-pos ch))) + Closeable + (close [this] + (when (instance? Closeable rdr) + (.close ^Closeable rdr)))) + +(deftype IndexingPushbackReader + [rdr ^:unsynchronized-mutable ^long line ^:unsynchronized-mutable ^long column + ^:unsynchronized-mutable line-start? ^:unsynchronized-mutable prev + ^:unsynchronized-mutable ^long prev-column file-name + ^:unsynchronized-mutable normalize?] + Reader + (read-char [reader] + (when-let [ch (read-char rdr)] + (let [ch (if normalize? + (do (set! normalize? false) + (if (or (identical? \newline ch) + (identical? \formfeed ch)) + (read-char rdr) + ch)) + ch) + ch (if (identical? \return ch) + (do (set! normalize? true) + \newline) + ch)] + (set! prev line-start?) + (set! line-start? (newline? ch)) + (when line-start? + (set! prev-column column) + (set! column 0) + (update! line inc)) + (update! column inc) + ch))) + + (peek-char [reader] + (peek-char rdr)) + + IPushbackReader + (unread [reader ch] + (if line-start? + (do (update! line dec) + (set! column prev-column)) + (update! column dec)) + (set! line-start? prev) + ;; This may look a bit convoluted, but it helps in the following + ;; scenario: + ;; + The underlying reader is about to return \return from the + ;; next read-char, and then \newline after that. + ;; + read-char gets \return, sets normalize? to true, returns + ;; \newline instead. + ;; + Caller calls unread on the \newline it just got. If we + ;; unread the \newline to the underlying reader, now it is ready + ;; to return two \newline chars in a row, which will throw off + ;; the tracked line numbers. + (let [ch (if normalize? + (do (set! normalize? false) + (if (identical? \newline ch) + \return + ch)) + ch)] + (unread rdr ch))) + + IndexingReader + (get-line-number [reader] (int line)) + (get-column-number [reader] (int column)) + (get-file-name [reader] file-name) + + Closeable + (close [this] + (when (instance? Closeable rdr) + (.close ^Closeable rdr)))) + +;; Java interop + +(extend-type java.io.PushbackReader + Reader + (read-char [rdr] + (let [c (.read ^java.io.PushbackReader rdr)] + (when (>= c 0) + (char c)))) + + (peek-char [rdr] + (when-let [c (read-char rdr)] + (unread rdr c) + c)) + + IPushbackReader + (unread [rdr c] + (when c + (.unread ^java.io.PushbackReader rdr (int c))))) + +(extend LineNumberingPushbackReader + IndexingReader + {:get-line-number (fn [rdr] (.getLineNumber ^LineNumberingPushbackReader rdr)) + :get-column-number (fn [rdr] + (.getColumnNumber ^LineNumberingPushbackReader rdr)) + :get-file-name (constantly nil)}) + +(defprotocol ReaderCoercer + (to-rdr [rdr])) + +(declare string-reader push-back-reader) + +(extend-protocol ReaderCoercer + Object + (to-rdr [rdr] + (if (satisfies? Reader rdr) + rdr + (throw (IllegalArgumentException. (str "Argument of type: " (class rdr) " cannot be converted to Reader"))))) + cljs.vendor.clojure.tools.reader.reader_types.Reader + (to-rdr [rdr] rdr) + String + (to-rdr [str] (string-reader str)) + java.io.Reader + (to-rdr [rdr] (java.io.PushbackReader. rdr))) + +(defprotocol PushbackReaderCoercer + (to-pbr [rdr buf-len])) + +(extend-protocol PushbackReaderCoercer + Object + (to-pbr [rdr buf-len] + (if (satisfies? Reader rdr) + (push-back-reader rdr buf-len) + (throw (IllegalArgumentException. (str "Argument of type: " (class rdr) " cannot be converted to IPushbackReader"))))) + cljs.vendor.clojure.tools.reader.reader_types.Reader + (to-pbr [rdr buf-len] (push-back-reader rdr buf-len)) + cljs.vendor.clojure.tools.reader.reader_types.PushbackReader + (to-pbr [rdr buf-len] (push-back-reader rdr buf-len)) + String + (to-pbr [str buf-len] (push-back-reader str buf-len)) + java.io.Reader + (to-pbr [rdr buf-len] (java.io.PushbackReader. rdr buf-len))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Source Logging support +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defn merge-meta + "Returns an object of the same type and value as `obj`, with its + metadata merged over `m`." + [obj m] + (let [orig-meta (meta obj)] + (with-meta obj (merge m (dissoc orig-meta :source))))) + +(defn- peek-source-log + "Returns a string containing the contents of the top most source + logging frame." + [source-log-frames] + (let [current-frame @source-log-frames] + (.substring ^StringBuilder (:buffer current-frame) (:offset current-frame)))) + +(defn- log-source-char + "Logs `char` to all currently active source logging frames." + [source-log-frames char] + (when-let [^StringBuilder buffer (:buffer @source-log-frames)] + (.append buffer char))) + +(defn- drop-last-logged-char + "Removes the last logged character from all currently active source + logging frames. Called when pushing a character back." + [source-log-frames] + (when-let [^StringBuilder buffer (:buffer @source-log-frames)] + (.deleteCharAt buffer (dec (.length buffer))))) + +(deftype SourceLoggingPushbackReader + [rdr ^:unsynchronized-mutable ^long line ^:unsynchronized-mutable ^long column + ^:unsynchronized-mutable line-start? ^:unsynchronized-mutable prev + ^:unsynchronized-mutable ^long prev-column file-name source-log-frames + ^:unsynchronized-mutable normalize?] + Reader + (read-char [reader] + (when-let [ch (read-char rdr)] + (let [ch (if normalize? + (do (set! normalize? false) + (if (or (identical? \newline ch) + (identical? \formfeed ch)) + (read-char rdr) + ch)) + ch) + ch (if (identical? \return ch) + (do (set! normalize? true) + \newline) + ch)] + (set! prev line-start?) + (set! line-start? (newline? ch)) + (when line-start? + (set! prev-column column) + (set! column 0) + (update! line inc)) + (update! column inc) + (log-source-char source-log-frames ch) + ch))) + + (peek-char [reader] + (peek-char rdr)) + + IPushbackReader + (unread [reader ch] + (if line-start? + (do (update! line dec) + (set! column prev-column)) + (update! column dec)) + (set! line-start? prev) + (when ch + (drop-last-logged-char source-log-frames)) + (unread rdr ch)) + + IndexingReader + (get-line-number [reader] (int line)) + (get-column-number [reader] (int column)) + (get-file-name [reader] file-name) + + Closeable + (close [this] + (when (instance? Closeable rdr) + (.close ^Closeable rdr)))) + +(defn log-source* + [reader f] + (let [frame (.source-log-frames ^SourceLoggingPushbackReader reader) + ^StringBuilder buffer (:buffer @frame) + new-frame (assoc-in @frame [:offset] (.length buffer))] + (with-bindings {frame new-frame} + (let [ret (f)] + (if (instance? clojure.lang.IObj ret) + (merge-meta ret {:source (peek-source-log frame)}) + ret))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Public API +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; fast check for provided implementations +(defn indexing-reader? + "Returns true if the reader satisfies IndexingReader" + [rdr] + (or (instance? cljs.vendor.clojure.tools.reader.reader_types.IndexingReader rdr) + (instance? LineNumberingPushbackReader rdr) + (and (not (instance? cljs.vendor.clojure.tools.reader.reader_types.PushbackReader rdr)) + (not (instance? cljs.vendor.clojure.tools.reader.reader_types.StringReader rdr)) + (not (instance? cljs.vendor.clojure.tools.reader.reader_types.InputStreamReader rdr)) + (get (:impls IndexingReader) (class rdr))))) + +(defn string-reader + "Creates a StringReader from a given string" + ([^String s] + (StringReader. s (count s) 0))) + +(defn ^Closeable push-back-reader + "Creates a PushbackReader from a given reader or string" + ([rdr] (push-back-reader rdr 1)) + ([rdr buf-len] (PushbackReader. (to-rdr rdr) (object-array buf-len) buf-len buf-len))) + +(defn ^Closeable string-push-back-reader + "Creates a PushbackReader from a given string" + ([s] + (string-push-back-reader s 1)) + ([^String s buf-len] + (push-back-reader (string-reader s) buf-len))) + +(defn ^Closeable input-stream-reader + "Creates an InputStreamReader from an InputStream" + [is] + (InputStreamReader. is nil)) + +(defn ^Closeable input-stream-push-back-reader + "Creates a PushbackReader from a given InputStream" + ([is] + (input-stream-push-back-reader is 1)) + ([^InputStream is buf-len] + (push-back-reader (input-stream-reader is) buf-len))) + +(defn ^Closeable indexing-push-back-reader + "Creates an IndexingPushbackReader from a given string or PushbackReader" + ([s-or-rdr] + (indexing-push-back-reader s-or-rdr 1)) + ([s-or-rdr buf-len] + (indexing-push-back-reader s-or-rdr buf-len nil)) + ([s-or-rdr buf-len file-name] + (IndexingPushbackReader. + (to-pbr s-or-rdr buf-len) 1 1 true nil 0 file-name false))) + +(defn ^Closeable source-logging-push-back-reader + "Creates a SourceLoggingPushbackReader from a given string or PushbackReader" + ([s-or-rdr] + (source-logging-push-back-reader s-or-rdr 1)) + ([s-or-rdr buf-len] + (source-logging-push-back-reader s-or-rdr buf-len nil)) + ([s-or-rdr buf-len file-name] + (SourceLoggingPushbackReader. + (to-pbr s-or-rdr buf-len) + 1 + 1 + true + nil + 0 + file-name + (doto (make-var) + (alter-var-root (constantly {:buffer (StringBuilder.) + :offset 0}))) + false))) + +(defn read-line + "Reads a line from the reader or from *in* if no reader is specified" + ([] (read-line *in*)) + ([rdr] + (if (or (instance? LineNumberingPushbackReader rdr) + (instance? BufferedReader rdr)) + (binding [*in* rdr] + (clojure.core/read-line)) + (loop [c (read-char rdr) s (StringBuilder.)] + (if (newline? c) + (str s) + (recur (read-char rdr) (.append s c))))))) + +(defn source-logging-reader? + [rdr] + (instance? SourceLoggingPushbackReader rdr)) + +(defmacro log-source + "If reader is a SourceLoggingPushbackReader, execute body in a source + logging context. Otherwise, execute body, returning the result." + [reader & body] + `(if (and (source-logging-reader? ~reader) + (not (whitespace? (peek-char ~reader)))) + (log-source* ~reader (^:once fn* [] ~@body)) + (do ~@body))) + +(defn line-start? + "Returns true if rdr is an IndexingReader and the current char starts a new line" + [rdr] + (when (indexing-reader? rdr) + (== 1 (int (get-column-number rdr))))) diff --git a/src/main/clojure/cljs/vendor/cognitect/transit.clj b/src/main/clojure/cljs/vendor/cognitect/transit.clj new file mode 100644 index 000000000..43fa0da96 --- /dev/null +++ b/src/main/clojure/cljs/vendor/cognitect/transit.clj @@ -0,0 +1,479 @@ +;; Copyright 2014 Rich Hickey. All Rights Reserved. +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); +;; you may not use this file except in compliance with the License. +;; You may obtain a copy of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS-IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. + +(ns cljs.vendor.cognitect.transit + "An implementation of the transit-format for Clojure built + on top of the transit-java library." + (:refer-clojure :exclude [read]) + (:require [clojure.string :as str]) + (:import [com.cognitect.transit WriteHandler ReadHandler ArrayReadHandler MapReadHandler + ArrayReader TransitFactory TransitFactory$Format MapReader] + [com.cognitect.transit.SPI ReaderSPI] + [java.io InputStream OutputStream] + [java.util.function Function])) + +(defprotocol HandlerMapProvider + (handler-map [this])) + +(deftype HandlerMapContainer [m] + HandlerMapProvider + (handler-map [this] m)) + +;; writing + +(set! *warn-on-reflection* true) + +(defn- transit-format + "Converts a keyword to a TransitFactory$Format value." + [kw] + (TransitFactory$Format/valueOf + (str/join "_" (-> kw + name + str/upper-case + (str/split #"-"))))) + +(defn tagged-value + "Creates a TaggedValue object." + [tag rep] (TransitFactory/taggedValue tag rep)) + +(defn nsed-name + "Convert a keyword or symbol to a string in + namespace/name format." + [^clojure.lang.Named kw-or-sym] + (if-let [ns (.getNamespace kw-or-sym)] + (str ns "/" (.getName kw-or-sym)) + (.getName kw-or-sym))) + +(defn- fn-or-val + [f] + (if (fn? f) f (constantly f))) + +(defn write-handler + "Creates a transit WriteHandler whose tag, rep, + stringRep, and verboseWriteHandler methods + invoke the provided fns. + + If a non-fn is passed as an argument, implemented + handler method returns the value unaltered." + ([tag-fn rep-fn] + (write-handler tag-fn rep-fn nil nil)) + ([tag-fn rep-fn str-rep-fn] + (write-handler tag-fn rep-fn str-rep-fn nil)) + ([tag-fn rep-fn str-rep-fn verbose-handler-fn] + (let [tag-fn (fn-or-val tag-fn) + rep-fn (fn-or-val rep-fn) + str-rep-fn (fn-or-val str-rep-fn) + verbose-handler-fn (fn-or-val verbose-handler-fn)] + (reify WriteHandler + (tag [_ o] (tag-fn o)) + (rep [_ o] (rep-fn o)) + (stringRep [_ o] (when str-rep-fn (str-rep-fn o))) + (getVerboseHandler [_] (when verbose-handler-fn (verbose-handler-fn))))))) + +(deftype WithMeta [value meta]) + +(def default-write-handlers + "Returns a map of default WriteHandlers for + Clojure types. Java types are handled + by the default WriteHandlers provided by the + transit-java library." + { + java.util.List + (reify WriteHandler + (tag [_ l] (if (seq? l) "list" "array")) + (rep [_ l] (if (seq? l) (TransitFactory/taggedValue "array" l) l)) + (stringRep [_ _] nil) + (getVerboseHandler [_] nil)) + + clojure.lang.BigInt + (reify WriteHandler + (tag [_ _] "n") + (rep [_ bi] (str (biginteger bi))) + (stringRep [this bi] (.rep this bi)) + (getVerboseHandler [_] nil)) + + clojure.lang.Keyword + (reify WriteHandler + (tag [_ _] ":") + (rep [_ kw] (nsed-name kw)) + (stringRep [_ kw] (nsed-name kw)) + (getVerboseHandler [_] nil)) + + clojure.lang.Ratio + (reify WriteHandler + (tag [_ _] "ratio") + (rep [_ r] (TransitFactory/taggedValue "array" [(numerator r) (denominator r)])) + (stringRep [_ _] nil) + (getVerboseHandler [_] nil)) + + clojure.lang.Symbol + (reify WriteHandler + (tag [_ _] "$") + (rep [_ sym] (nsed-name sym)) + (stringRep [_ sym] (nsed-name sym)) + (getVerboseHandler [_] nil)) + + cljs.vendor.cognitect.transit.WithMeta + (reify WriteHandler + (tag [_ _] "with-meta") + (rep [_ o] + (TransitFactory/taggedValue "array" + [(.-value ^cljs.vendor.cognitect.transit.WithMeta o) + (.-meta ^cljs.vendor.cognitect.transit.WithMeta o)])) + (stringRep [_ _] nil) + (getVerboseHandler [_] nil))}) + +(deftype Writer [w]) + +(defn writer + "Creates a writer over the provided destination `out` using + the specified format, one of: :msgpack, :json or :json-verbose. + + An optional opts map may be passed. Supported options are: + + :handlers - a map of types to WriteHandler instances, they are merged + with the default-handlers and then with the default handlers + provided by transit-java. + + :default-handler - a default WriteHandler to use if NO handler is + found for a type. If no default is specified, an error will be + thrown for an unknown type. + + :transform - a function of one argument that will transform values before + they are written." + ([out type] (writer out type {})) + ([^OutputStream out type {:keys [handlers default-handler transform]}] + (if (#{:json :json-verbose :msgpack} type) + (let [handler-map (if (instance? HandlerMapContainer handlers) + (handler-map handlers) + (merge default-write-handlers handlers))] + (Writer. (TransitFactory/writer (transit-format type) out handler-map default-handler + (when transform + (reify Function + (apply [_ x] + (transform x))))))) + (throw (ex-info "Type must be :json, :json-verbose or :msgpack" {:type type}))))) + +(defn write + "Writes a value to a transit writer." + [^Writer writer o] + (.write ^com.cognitect.transit.Writer (.w writer) o)) + + +;; reading + +(defn read-handler + "Creates a transit ReadHandler whose fromRep + method invokes the provided fn." + [from-rep] + (reify ReadHandler + (fromRep [_ o] (from-rep o)))) + +(defn read-map-handler + "Creates a Transit MapReadHandler whose fromRep + and mapReader methods invoke the provided fns." + [from-rep map-reader] + (reify MapReadHandler + (fromRep [_ o] (from-rep o)) + (mapReader [_] (map-reader)))) + +(defn read-array-handler + "Creates a Transit ArrayReadHandler whose fromRep + and arrayReader methods invoke the provided fns." + [from-rep array-reader] + (reify ArrayReadHandler + (fromRep [_ o] (from-rep o)) + (arrayReader [_] (array-reader)))) + + +(def default-read-handlers + "Returns a map of default ReadHandlers for + Clojure types. Java types are handled + by the default ReadHandlers provided by the + transit-java library." + {":" + (reify ReadHandler + (fromRep [_ o] (keyword o))) + + "$" + (reify ReadHandler + (fromRep [_ o] (symbol o))) + + "ratio" + (reify ReadHandler + (fromRep [_ o] (/ (.get ^java.util.List o 0) + (.get ^java.util.List o 1)))) + + "n" + (reify ReadHandler + (fromRep [_ o] (clojure.lang.BigInt/fromBigInteger + (BigInteger. ^String o)))) + + "set" + (reify ArrayReadHandler + (fromRep [_ o] o) + (arrayReader [_] + (reify ArrayReader + (init [_] (transient #{})) + (init [_ ^int size] (transient #{})) + (add [_ s item] (conj! s item)) + (complete [_ s] (persistent! s))))) + + "list" + (reify ArrayReadHandler + (fromRep [_ o] o) + (arrayReader [_] + (reify ArrayReader + (init [_] (java.util.ArrayList.)) + (init [_ ^int size] (java.util.ArrayList. size)) + (add [_ l item] (.add ^java.util.List l item) l) + (complete [_ l] (or (seq l) '()))))) + + "cmap" + (reify ArrayReadHandler + (fromRep [_ o]) + (arrayReader [_] + (let [marker (Object.) + ^objects next-key (object-array [marker])] + (reify ArrayReader + (init [_] (transient {})) + (init [_ ^int size] (transient {})) + (add [_ m item] + (let [k (aget next-key 0)] + (if (identical? k marker) + (do + (aset next-key 0 item) + m) + (do + (aset next-key 0 marker) + (assoc! m k item))))) + (complete [_ m] (persistent! m)))))) + + "with-meta" + (reify ReadHandler + (fromRep [_ o] + (with-meta (get ^java.util.List o 0) (get ^java.util.List o 1))))}) + +(defn map-builder + "Creates a MapBuilder that makes Clojure- + compatible maps." + [] + (reify MapReader + (init [_] (transient {})) + (init [_ ^int size] (transient {})) + (add [_ m k v] (assoc! m k v)) + (complete [_ m] (persistent! m)))) + +(defn list-builder + "Creates an ArrayBuilder that makes Clojure- + compatible lists." + [] + (reify ArrayReader + (init [_] (transient [])) + (init [_ ^int size] (transient [])) + (add [_ v item] (conj! v item)) + (complete [_ v] (persistent! v)))) + +(deftype Reader [r]) + +(defn reader + "Creates a reader over the provided source `in` using + the specified format, one of: :msgpack, :json or :json-verbose. + + An optional opts map may be passed. Supported options are: + + :handlers - a map of tags to ReadHandler instances, they are merged + with the Clojure default-read-handlers and then with the default ReadHandlers + provided by transit-java. + + :default-handler - an instance of DefaultReadHandler, used to process + transit encoded values for which there is no other ReadHandler; if + :default-handler is not specified, non-readable values are returned + as TaggedValues." + ([in type] (reader in type {})) + ([^InputStream in type {:keys [handlers default-handler]}] + (if (#{:json :json-verbose :msgpack} type) + (let [handler-map (if (instance? HandlerMapContainer handlers) + (handler-map handlers) + (merge default-read-handlers handlers)) + reader (TransitFactory/reader (transit-format type) + in + handler-map + default-handler)] + (Reader. (.setBuilders ^ReaderSPI reader + (map-builder) + (list-builder)))) + (throw (ex-info "Type must be :json, :json-verbose or :msgpack" {:type type}))))) + +(defn read + "Reads a value from a reader. Throws a RuntimeException when + the reader's InputStream is empty." + [^Reader reader] + (.read ^com.cognitect.transit.Reader (.r reader))) + +(defn record-write-handler + "Creates a WriteHandler for a record type" + [^Class type] + (reify WriteHandler + (tag [_ _] (.getName type)) + (rep [_ rec] (tagged-value "map" rec)) + (stringRep [_ _] nil) + (getVerboseHandler [_] nil))) + +(defn record-write-handlers + "Creates a map of record types to WriteHandlers" + [& types] + (reduce (fn [h t] (assoc h t (record-write-handler t))) + {} + types)) + +(defn record-read-handler + "Creates a ReadHandler for a record type" + [^Class type] + (let [type-name (map #(str/replace % "_" "-") (str/split (.getName type) #"\.")) + map-ctor (-> (str (str/join "." (butlast type-name)) "/map->" (last type-name)) + symbol + resolve)] + (reify ReadHandler + (fromRep [_ m] (map-ctor m))))) + +(defn record-read-handlers + "Creates a map of record type tags to ReadHandlers" + [& types] + (reduce (fn [d ^Class t] (assoc d (.getName t) (record-read-handler t))) + {} + types)) + +(defn read-handler-map + "Returns a HandlerMapContainer containing a ReadHandlerMap + containing all the default handlers for Clojure and Java and any + custom handlers that you supply, letting you store the return value + and pass it to multiple invocations of reader. This can be more + efficient than repeatedly handing the same raw map of tags -> custom + handlers to reader." + [custom-handlers] + (HandlerMapContainer. + (TransitFactory/readHandlerMap (merge default-read-handlers custom-handlers)))) + +(defn write-handler-map + "Returns a HandlerMapContainer containing a WriteHandlerMap + containing all the default handlers for Clojure and Java and any + custom handlers that you supply, letting you store the return value + and pass it to multiple invocations of writer. This can be more + efficient than repeatedly handing the same raw map of types -> custom + handlers to writer." + [custom-handlers] + (HandlerMapContainer. + (TransitFactory/writeHandlerMap (merge default-write-handlers custom-handlers)))) + +(defn write-meta + "For :transform. Will write any metadata present on the value." + [x] + (if (instance? clojure.lang.IObj x) + (if-let [m (meta x)] + (WithMeta. (with-meta x nil) m) + x) + x)) + +(comment + (require 'cognitect.transit) + (in-ns 'cognitect.transit) + + (import [java.io File ByteArrayInputStream ByteArrayOutputStream OutputStreamWriter]) + + (def out (ByteArrayOutputStream. 2000)) + + (def w (writer out :json)) + (def w (writer out :json-verbose)) + (def w (writer out :msgpack)) + (def w (writer out :msgpack {:transform write-meta})) + (def w (writer out :json {:transform write-meta})) + + (write w "foo") + (write w 10) + (write w [1 2 3]) + (write w (with-meta [1 2 3] {:foo 'bar})) + (String. (.toByteArray out)) + + (write w {:a-key 1 :b-key 2}) + (write w {"a" "1" "b" "2"}) + (write w {:a-key [1 2]}) + (write w #{1 2}) + (write w [{:a-key 1} {:a-key 2}]) + (write w [#{1 2} #{1 2}]) + (write w (int-array (range 10))) + (write w {[:a :b] 2}) + (write w [123N]) + (write w 1/3) + (write w {false 10 [] 20}) + + (def in (ByteArrayInputStream. (.toByteArray out))) + + (def r (reader in :json)) + + (def r (reader in :msgpack)) + + (def x (read r)) + (meta x) + + (type (read r)) + + ;; extensibility + + (defrecord Point [x y]) + + (defrecord Circle [c r]) + + (def ext-write-handlers + {Point + (write-handler "point" (fn [p] [(.x p) (.y p)])) + Circle + (write-handler "circle" (fn [c] [(.c c) (.r c)]))}) + + (def ext-read-handlers + {"point" + (read-handler (fn [[x y]] (prn "making a point") (Point. x y))) + "circle" + (read-handler (fn [[c r]] (prn "making a circle") (Circle. c r)))}) + + (def ext-write-handlers + (record-write-handlers Point Circle)) + + (def ext-read-handlers + (record-read-handlers Point Circle)) + + (def out (ByteArrayOutputStream. 2000)) + (def w (writer out :json {:handlers ext-write-handlers})) + (write w (Point. 10 20)) + (write w (Circle. (Point. 10 20) 30)) + (write w [(Point. 10 20) (Point. 20 40) (Point. 0 0)]) + + (def in (ByteArrayInputStream. (.toByteArray out))) + (def r (reader in :json {:handlers ext-read-handlers})) + (read r) + + ;; write and read handler maps + + (def custom-write-handler-map (write-handler-map ext-write-handlers)) + (def custom-read-handler-map (read-handler-map ext-read-handlers)) + + (def out (ByteArrayOutputStream. 2000)) + (def w (writer out :json {:handlers custom-write-handler-map})) + + (write w (Point. 10 20)) + + (def in (ByteArrayInputStream. (.toByteArray out))) + (def r (reader in :json {:handlers custom-read-handler-map})) + (read r) + ) diff --git a/src/test/clojure/cljs/build_api_tests.clj b/src/test/clojure/cljs/build_api_tests.clj index dad29746e..390f7f41b 100644 --- a/src/test/clojure/cljs/build_api_tests.clj +++ b/src/test/clojure/cljs/build_api_tests.clj @@ -15,7 +15,7 @@ [cljs.env :as env] [cljs.test-util :as test] [cljs.util :as util] - [clojure.data.json :as json] + [cljs.vendor.clojure.data.json :as json] [clojure.edn :as edn] [clojure.java.io :as io] [clojure.java.shell :as sh] @@ -458,7 +458,7 @@ (build/build (build/inputs (io/file inputs "data_readers_test")) opts cenv) (is (contains? (-> @cenv ::ana/data-readers) 'test/custom-identity)) (is (true? (boolean (re-find #"Array\.of\(\"foo\"\)" - (slurp (io/file + (slurp (io/file out ;"data-readers-test-out" "data_readers_test" "core.js")))))))) diff --git a/src/test/clojure/cljs/closure_tests.clj b/src/test/clojure/cljs/closure_tests.clj index 4964a2c6b..d373efd9e 100644 --- a/src/test/clojure/cljs/closure_tests.clj +++ b/src/test/clojure/cljs/closure_tests.clj @@ -10,7 +10,7 @@ (:refer-clojure :exclude [compile]) (:use cljs.closure clojure.test) (:require [cljs.build.api :as build] - [clojure.data.json :as json] + [cljs.vendor.clojure.data.json :as json] [clojure.java.shell :as sh] [cljs.closure :as closure] [cljs.js-deps :as deps]