178 changes: 151 additions & 27 deletions src/clj/clojure/core.clj
Original file line number Diff line number Diff line change
Expand Up @@ -571,12 +571,34 @@
:static true}
[x] (instance? clojure.lang.Keyword x))

(defmacro cond
"Takes a set of test/expr pairs. It evaluates each test one at a
time. If a test returns logical true, cond evaluates and returns
the value of the corresponding expr and doesn't evaluate any of the
other tests or exprs. (cond) returns nil."
{:added "1.0"}
[& clauses]
(when clauses
(list 'if (first clauses)
(if (next clauses)
(second clauses)
(throw (IllegalArgumentException.
"cond requires an even number of forms")))
(cons 'clojure.core/cond (next (next clauses))))))

(defn symbol
"Returns a Symbol with the given namespace and name."
"Returns a Symbol with the given namespace and name. Arity-1 works
on strings, keywords, and vars."
{:tag clojure.lang.Symbol
:added "1.0"
:static true}
([name] (if (symbol? name) name (clojure.lang.Symbol/intern name)))
([name]
(cond
(symbol? name) name
(instance? String name) (clojure.lang.Symbol/intern name)
(instance? clojure.lang.Var name) (.toSymbol ^clojure.lang.Var name)
(instance? clojure.lang.Keyword name) (.sym ^clojure.lang.Keyword name)
:else (throw (IllegalArgumentException. "no conversion to symbol"))))
([ns name] (clojure.lang.Symbol/intern ns name)))

(defn gensym
Expand All @@ -588,20 +610,6 @@
([] (gensym "G__"))
([prefix-string] (. clojure.lang.Symbol (intern (str prefix-string (str (. clojure.lang.RT (nextID))))))))

(defmacro cond
"Takes a set of test/expr pairs. It evaluates each test one at a
time. If a test returns logical true, cond evaluates and returns
the value of the corresponding expr and doesn't evaluate any of the
other tests or exprs. (cond) returns nil."
{:added "1.0"}
[& clauses]
(when clauses
(list 'if (first clauses)
(if (next clauses)
(second clauses)
(throw (IllegalArgumentException.
"cond requires an even number of forms")))
(cons 'clojure.core/cond (next (next clauses))))))

(defn keyword
"Returns a Keyword with the given namespace and name. Do not use :
Expand Down Expand Up @@ -2689,8 +2697,8 @@
{:added "1.0"
:static true}
[pred coll]
(when (seq coll)
(or (pred (first coll)) (recur pred (next coll)))))
(when-let [s (seq coll)]
(or (pred (first s)) (recur pred (next s)))))

(def
^{:tag Boolean
Expand Down Expand Up @@ -3105,7 +3113,7 @@
(if (seq coll)
(let [a (to-array coll)]
(. java.util.Arrays (sort a comp))
(seq a))
(with-meta (seq a) (meta coll)))
())))

(defn sort-by
Expand Down Expand Up @@ -3759,6 +3767,32 @@
([opts stream]
(. clojure.lang.LispReader (read stream opts))))

(defn read+string
"Like read, and taking the same args. stream must be a LineNumberingPushbackReader.
Returns a vector containing the object read and the (whitespace-trimmed) string read."
{:added "1.10"}
([] (read+string *in*))
([stream] (read+string stream true nil))
([stream eof-error? eof-value] (read+string stream eof-error? eof-value false))
([^clojure.lang.LineNumberingPushbackReader stream eof-error? eof-value recursive?]
(try
(.captureString stream)
(let [o (read stream eof-error? eof-value recursive?)
s (.trim (.getString stream))]
[o s])
(catch Throwable ex
(.getString stream)
(throw ex))))
([opts ^clojure.lang.LineNumberingPushbackReader stream]
(try
(.captureString stream)
(let [o (read opts stream)
s (.trim (.getString stream))]
[o s])
(catch Throwable ex
(.getString stream)
(throw ex)))))

(defn read-line
"Reads the next line from stream that is the current value of *in* ."
{:added "1.0"
Expand Down Expand Up @@ -4736,14 +4770,24 @@
(apply println xs)))

(import clojure.lang.ExceptionInfo clojure.lang.IExceptionInfo)

(defn ^:private elide-top-frames
[^Throwable ex class-name]
(let [tr (.getStackTrace ex)]
(doto ex
(.setStackTrace
(when tr
(into-array StackTraceElement
(drop-while #(= class-name (.getClassName ^StackTraceElement %1)) tr)))))))

(defn ex-info
"Create an instance of ExceptionInfo, a RuntimeException subclass
that carries a map of additional data."
{:added "1.4"}
([msg map]
(ExceptionInfo. msg map))
(elide-top-frames (ExceptionInfo. msg map) "clojure.core$ex_info"))
([msg map cause]
(ExceptionInfo. msg map cause)))
(elide-top-frames (ExceptionInfo. msg map cause) "clojure.core$ex_info")))

(defn ex-data
"Returns exception data (a map) if ex is an IExceptionInfo.
Expand All @@ -4753,6 +4797,22 @@
(when (instance? IExceptionInfo ex)
(.getData ^IExceptionInfo ex)))

(defn ex-message
"Returns the message attached to ex if ex is a Throwable.
Otherwise returns nil."
{:added "1.10"}
[ex]
(when (instance? Throwable ex)
(.getMessage ^Throwable ex)))

(defn ex-cause
"Returns the cause of ex if ex is a Throwable.
Otherwise returns nil."
{:added "1.10"}
[ex]
(when (instance? Throwable ex)
(.getCause ^Throwable ex)))

(defmacro assert
"Evaluates expr and throws an exception if it does not evaluate to
logical true."
Expand Down Expand Up @@ -6010,6 +6070,26 @@
[& args]
(apply load-libs :require args))

(defn- serialized-require
"Like 'require', but serializes loading.
Interim function preferred over 'require' for known asynchronous loads.
Future changes may make these equivalent."
{:added "1.10"}
[& args]
(locking clojure.lang.RT/REQUIRE_LOCK
(apply require args)))

(defn requiring-resolve
"Resolves namespace-qualified sym per 'resolve'. If initial resolve
fails, attempts to require sym's namespace and retries."
{:added "1.10"}
[sym]
(if (qualified-symbol? sym)
(or (resolve sym)
(do (-> sym namespace symbol serialized-require)
(resolve sym)))
(throw (IllegalArgumentException. (str "Not a qualified symbol: " sym)))))

(defn use
"Like 'require, but also refers to each lib's namespace using
clojure.core/refer. Use :use in the ns macro in preference to calling
Expand Down Expand Up @@ -6704,10 +6784,6 @@
java.util.Date
(inst-ms* [inst] (.getTime ^java.util.Date inst)))

;; conditionally extend to Instant on Java 8+
(when-class "java.time.Instant"
(load "core_instant18"))

(defn inst-ms
"Return the number of milliseconds since January 1, 1970, 00:00:00 GMT"
{:added "1.9"}
Expand All @@ -6720,6 +6796,10 @@
[x]
(satisfies? Inst x))

(extend-protocol clojure.core/Inst
java.time.Instant
(inst-ms* [inst] (.toEpochMilli ^java.time.Instant inst)))

(load "uuid")

(defn uuid?
Expand Down Expand Up @@ -7055,7 +7135,7 @@

(defn flatten
"Takes any nested combination of sequential things (lists, vectors,
etc.) and returns their contents as a single, flat sequence.
etc.) and returns their contents as a single, flat lazy sequence.
(flatten nil) returns an empty sequence."
{:added "1.2"
:static true}
Expand Down Expand Up @@ -7118,7 +7198,7 @@
(let [fst (first s)
fv (f fst)
run (cons fst (take-while #(= fv (f %)) (next s)))]
(cons run (partition-by f (seq (drop (count run) s)))))))))
(cons run (partition-by f (lazy-seq (drop (count run) s)))))))))

(defn frequencies
"Returns a map from distinct items in coll to the number of times
Expand Down Expand Up @@ -7766,3 +7846,47 @@
"Return true if x is a java.net.URI"
{:added "1.9"}
[x] (instance? java.net.URI x))

(defonce ^:private tapset (atom #{}))
(defonce ^:private ^java.util.concurrent.ArrayBlockingQueue tapq (java.util.concurrent.ArrayBlockingQueue. 1024))

(defonce ^:private tap-loop
(delay
(doto (Thread.
#(let [t (.take tapq)
x (if (identical? ::tap-nil t) nil t)
taps @tapset]
(doseq [tap taps]
(try
(tap x)
(catch Throwable ex)))
(recur))
"clojure.core/tap-loop")
(.setDaemon true)
(.start))))

(defn add-tap
"adds f, a fn of one argument, to the tap set. This function will be called with anything sent via tap>.
This function may (briefly) block (e.g. for streams), and will never impede calls to tap>,
but blocking indefinitely may cause tap values to be dropped.
Remember f in order to remove-tap"
{:added "1.10"}
[f]
(force tap-loop)
(swap! tapset conj f)
nil)

(defn remove-tap
"Remove f from the tap set."
{:added "1.10"}
[f]
(swap! tapset disj f)
nil)

(defn tap>
"sends x to any taps. Will not block. Returns true if there was room in the queue,
false if not (dropped)."
{:added "1.10"}
[x]
(force tap-loop)
(.offer tapq (if (nil? x) ::tap-nil x)))
22 changes: 22 additions & 0 deletions src/clj/clojure/core/protocols.clj
Original file line number Diff line number Diff line change
Expand Up @@ -178,3 +178,25 @@
entries. Called by clojure.core/reduce-kv, and has same
semantics (just different arg order)."
(kv-reduce [amap f init]))

(defprotocol Datafiable
:extend-via-metadata true

(datafy [o] "return a representation of o as data (default identity)"))

(extend-protocol Datafiable
nil
(datafy [_] nil)

Object
(datafy [x] x))

(defprotocol Navigable
:extend-via-metadata true

(nav [coll k v] "return (possibly transformed) v in the context of coll and k (a key/index or nil),
defaults to returning v."))

(extend-protocol Navigable
Object
(nav [_ _ x] x))
53 changes: 10 additions & 43 deletions src/clj/clojure/core/reducers.clj
Original file line number Diff line number Diff line change
Expand Up @@ -8,9 +8,7 @@

(ns ^{:doc
"A library for reduction and parallel folding. Alpha and subject
to change. Note that fold and its derivatives require Java 7+ or
Java 6 + jsr166y.jar for fork/join support. See Clojure's pom.xml for the
dependency info."
to change."
:author "Rich Hickey"}
clojure.core.reducers
(:refer-clojure :exclude [reduce map mapcat filter remove take take-while drop flatten cat])
Expand All @@ -21,51 +19,20 @@

;;;;;;;;;;;;;; some fj stuff ;;;;;;;;;;

(defmacro ^:private compile-if
"Evaluate `exp` and if it returns logical true and doesn't error, expand to
`then`. Else expand to `else`.
(def pool (delay (java.util.concurrent.ForkJoinPool.)))

(compile-if (Class/forName \"java.util.concurrent.ForkJoinTask\")
(do-cool-stuff-with-fork-join)
(fall-back-to-executor-services))"
[exp then else]
(if (try (eval exp)
(catch Throwable _ false))
`(do ~then)
`(do ~else)))
(defn fjtask [^Callable f]
(java.util.concurrent.ForkJoinTask/adapt f))

(compile-if
(Class/forName "java.util.concurrent.ForkJoinTask")
;; We're running a JDK 7+
(do
(def pool (delay (java.util.concurrent.ForkJoinPool.)))
(defn- fjinvoke [f]
(if (java.util.concurrent.ForkJoinTask/inForkJoinPool)
(f)
(.invoke ^java.util.concurrent.ForkJoinPool @pool ^java.util.concurrent.ForkJoinTask (fjtask f))))

(defn fjtask [^Callable f]
(java.util.concurrent.ForkJoinTask/adapt f))
(defn- fjfork [task] (.fork ^java.util.concurrent.ForkJoinTask task))

(defn- fjinvoke [f]
(if (java.util.concurrent.ForkJoinTask/inForkJoinPool)
(f)
(.invoke ^java.util.concurrent.ForkJoinPool @pool ^java.util.concurrent.ForkJoinTask (fjtask f))))
(defn- fjjoin [task] (.join ^java.util.concurrent.ForkJoinTask task))

(defn- fjfork [task] (.fork ^java.util.concurrent.ForkJoinTask task))

(defn- fjjoin [task] (.join ^java.util.concurrent.ForkJoinTask task)))
;; We're running a JDK <7
(do
(def pool (delay (jsr166y.ForkJoinPool.)))

(defn fjtask [^Callable f]
(jsr166y.ForkJoinTask/adapt f))

(defn- fjinvoke [f]
(if (jsr166y.ForkJoinTask/inForkJoinPool)
(f)
(.invoke ^jsr166y.ForkJoinPool @pool ^jsr166y.ForkJoinTask (fjtask f))))

(defn- fjfork [task] (.fork ^jsr166y.ForkJoinTask task))

(defn- fjjoin [task] (.join ^jsr166y.ForkJoinTask task))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn reduce
Expand Down
166 changes: 161 additions & 5 deletions src/clj/clojure/core/server.clj
Original file line number Diff line number Diff line change
Expand Up @@ -12,8 +12,11 @@
(:require [clojure.string :as str]
[clojure.edn :as edn]
[clojure.main :as m])
(:import [java.net InetAddress Socket ServerSocket SocketException]
[java.util.concurrent.locks ReentrantLock]))
(:import
[clojure.lang LineNumberingPushbackReader]
[java.net InetAddress Socket ServerSocket SocketException]
[java.io Reader Writer PrintWriter BufferedWriter BufferedReader InputStreamReader OutputStreamWriter]
[java.util.concurrent.locks ReentrantLock]))

(set! *warn-on-reflection* true)

Expand Down Expand Up @@ -106,8 +109,8 @@
(when (not (.isClosed socket))
(try
(let [conn (.accept socket)
in (clojure.lang.LineNumberingPushbackReader. (java.io.InputStreamReader. (.getInputStream conn)))
out (java.io.BufferedWriter. (java.io.OutputStreamWriter. (.getOutputStream conn)))
in (LineNumberingPushbackReader. (InputStreamReader. (.getInputStream conn)))
out (BufferedWriter. (OutputStreamWriter. (.getOutputStream conn)))
client-id (str client-counter)]
(thread
(str "Clojure Connection " name " " client-id) client-daemon
Expand Down Expand Up @@ -179,4 +182,157 @@
[]
(m/repl
:init repl-init
:read repl-read))
:read repl-read))

(defn- ex->data
[ex phase]
(assoc (Throwable->map ex) :phase phase))

(defn prepl
"a REPL with structured output (for programs)
reads forms to eval from in-reader (a LineNumberingPushbackReader)
Closing the input or passing the form :repl/quit will cause it to return
Calls out-fn with data, one of:
{:tag :ret
:val val ;;eval result
:ns ns-name-string
:ms long ;;eval time in milliseconds
:form string ;;iff successfully read
:clojure.error/phase (:execution et al per clojure.main/ex-triage) ;;iff error occurred
}
{:tag :out
:val string} ;chars from during-eval *out*
{:tag :err
:val string} ;chars from during-eval *err*
{:tag :tap
:val val} ;values from tap>
You might get more than one :out or :err per eval, but exactly one :ret
tap output can happen at any time (i.e. between evals)
If during eval an attempt is made to read *in* it will read from in-reader unless :stdin is supplied
Alpha, subject to change."
{:added "1.10"}
[in-reader out-fn & {:keys [stdin]}]
(let [EOF (Object.)
tapfn #(out-fn {:tag :tap :val %1})]
(m/with-bindings
(in-ns 'user)
(binding [*in* (or stdin in-reader)
*out* (PrintWriter-on #(out-fn {:tag :out :val %1}) nil)
*err* (PrintWriter-on #(out-fn {:tag :err :val %1}) nil)]
(try
(add-tap tapfn)
(loop []
(when (try
(let [[form s] (read+string in-reader false EOF)]
(try
(when-not (identical? form EOF)
(let [start (System/nanoTime)
ret (eval form)
ms (quot (- (System/nanoTime) start) 1000000)]
(when-not (= :repl/quit ret)
(set! *3 *2)
(set! *2 *1)
(set! *1 ret)
(out-fn {:tag :ret
:val (if (instance? Throwable ret)
(Throwable->map ret)
ret)
:ns (str (.name *ns*))
:ms ms
:form s})
true)))
(catch Throwable ex
(set! *e ex)
(out-fn {:tag :ret :val (ex->data ex (or (-> ex ex-data :clojure.error/phase) :execution))
:ns (str (.name *ns*)) :form s
:exception true})
true)))
(catch Throwable ex
(set! *e ex)
(out-fn {:tag :ret :val (ex->data ex :read-source)
:ns (str (.name *ns*))
:exception true})
true))
(recur)))
(finally
(remove-tap tapfn)))))))

(defn- resolve-fn [valf]
(if (symbol? valf)
(or (resolve valf)
(when-let [nsname (namespace valf)]
(require (symbol nsname))
(resolve valf))
(throw (Exception. (str "can't resolve: " valf))))
valf))

(defn io-prepl
"prepl bound to *in* and *out*, suitable for use with e.g. server/repl (socket-repl).
:ret and :tap vals will be processed by valf, a fn of one argument
or a symbol naming same (default pr-str)
Alpha, subject to change."
{:added "1.10"}
[& {:keys [valf] :or {valf pr-str}}]
(let [valf (resolve-fn valf)
out *out*
lock (Object.)]
(prepl *in*
(fn [m]
(binding [*out* out, *flush-on-newline* true, *print-readably* true]
(locking lock
(prn (if (#{:ret :tap} (:tag m))
(try
(assoc m :val (valf (:val m)))
(catch Throwable ex
(assoc m :val (ex->data ex :print-eval-result)
:exception true)))
m))))))))

(defn remote-prepl
"Implements a prepl on in-reader and out-fn by forwarding to a
remote [io-]prepl over a socket. Messages will be read by readf, a
fn of a LineNumberingPushbackReader and EOF value or a symbol naming
same (default #(read %1 false %2)),
:ret and :tap vals will be processed by valf, a fn of one argument
or a symbol naming same (default read-string). If that function
throws, :val will be unprocessed.
Alpha, subject to change."
{:added "1.10"}
[^String host port ^Reader
in-reader out-fn & {:keys [valf readf] :or {valf read-string, readf #(read %1 false %2)}}]
(let [valf (resolve-fn valf)
readf (resolve-fn readf)
^long port (if (string? port) (Integer/valueOf ^String port) port)
socket (Socket. host port)
rd (-> socket .getInputStream InputStreamReader. BufferedReader. LineNumberingPushbackReader.)
wr (-> socket .getOutputStream OutputStreamWriter.)
EOF (Object.)]
(thread "clojure.core.server/remote-prepl" true
(try (loop []
(let [{:keys [tag val] :as m} (readf rd EOF)]
(when-not (identical? m EOF)
(out-fn
(if (#{:ret :tap} tag)
(try
(assoc m :val (valf val))
(catch Throwable ex
(assoc m :val (ex->data ex :read-eval-result)
:exception true)))
m))
(recur))))
(finally
(.close wr))))
(let [buf (char-array 1024)]
(try (loop []
(let [n (.read in-reader buf)]
(when-not (= n -1)
(.write wr buf 0 n)
(.flush wr)
(recur))))
(finally
(.close rd))))))
52 changes: 37 additions & 15 deletions src/clj/clojure/core_deftype.clj
Original file line number Diff line number Diff line change
Expand Up @@ -508,7 +508,7 @@
(defn- expand-method-impl-cache [^clojure.lang.MethodImplCache cache c f]
(if (.map cache)
(let [cs (assoc (.map cache) c (clojure.lang.MethodImplCache$Entry. c f))]
(clojure.lang.MethodImplCache. (.protocol cache) (.methodk cache) cs))
(clojure.lang.MethodImplCache. (.sym cache) (.protocol cache) (.methodk cache) cs))
(let [cs (into1 {} (remove (fn [[c e]] (nil? e)) (map vec (partition 2 (.table cache)))))
cs (assoc cs c (clojure.lang.MethodImplCache$Entry. c f))]
(if-let [[shift mask] (maybe-min-hash (map hash (keys cs)))]
Expand All @@ -519,8 +519,8 @@
(aset t (inc i) e)
t))
table cs)]
(clojure.lang.MethodImplCache. (.protocol cache) (.methodk cache) shift mask table))
(clojure.lang.MethodImplCache. (.protocol cache) (.methodk cache) cs)))))
(clojure.lang.MethodImplCache. (.sym cache) (.protocol cache) (.methodk cache) shift mask table))
(clojure.lang.MethodImplCache. (.sym cache) (.protocol cache) (.methodk cache) cs)))))

(defn- super-chain [^Class c]
(when c
Expand Down Expand Up @@ -575,16 +575,16 @@
(defn -cache-protocol-fn [^clojure.lang.AFunction pf x ^Class c ^clojure.lang.IFn interf]
(let [cache (.__methodImplCache pf)
f (if (.isInstance c x)
interf
interf
(find-protocol-method (.protocol cache) (.methodk cache) x))]
(when-not f
(throw (IllegalArgumentException. (str "No implementation of method: " (.methodk cache)
" of protocol: " (:var (.protocol cache))
(throw (IllegalArgumentException. (str "No implementation of method: " (.methodk cache)
" of protocol: " (:var (.protocol cache))
" found for class: " (if (nil? x) "nil" (.getName (class x)))))))
(set! (.__methodImplCache pf) (expand-method-impl-cache cache (class x) f))
f))

(defn- emit-method-builder [on-interface method on-method arglists]
(defn- emit-method-builder [on-interface method on-method arglists extend-via-meta]
(let [methodk (keyword method)
gthis (with-meta (gensym) {:tag 'clojure.lang.AFunction})
ginterf (gensym)]
Expand All @@ -604,19 +604,30 @@
(fn [args]
(let [gargs (map #(gensym (str "gf__" % "__")) args)
target (first gargs)]
`([~@gargs]
(let [cache# (.__methodImplCache ~gthis)
f# (.fnFor cache# (clojure.lang.Util/classOf ~target))]
(if f#
(f# ~@gargs)
((-cache-protocol-fn ~gthis ~target ~on-interface ~ginterf) ~@gargs))))))
(if extend-via-meta
`([~@gargs]
(let [cache# (.__methodImplCache ~gthis)
f# (.fnFor cache# (clojure.lang.Util/classOf ~target))]
(if (identical? f# ~ginterf)
(f# ~@gargs)
(if-let [meta# (when-let [m# (meta ~target)] ((.sym cache#) m#))]
(meta# ~@gargs)
(if f#
(f# ~@gargs)
((-cache-protocol-fn ~gthis ~target ~on-interface ~ginterf) ~@gargs))))))
`([~@gargs]
(let [cache# (.__methodImplCache ~gthis)
f# (.fnFor cache# (clojure.lang.Util/classOf ~target))]
(if f#
(f# ~@gargs)
((-cache-protocol-fn ~gthis ~target ~on-interface ~ginterf) ~@gargs)))))))
arglists))]
(set! (.__methodImplCache f#) cache#)
f#))))

(defn -reset-methods [protocol]
(doseq [[^clojure.lang.Var v build] (:method-builders protocol)]
(let [cache (clojure.lang.MethodImplCache. protocol (keyword (.sym v)))]
(let [cache (clojure.lang.MethodImplCache. (symbol v) protocol (keyword (.sym v)))]
(.bindRoot v (build cache)))))

(defn- assert-same-protocol [protocol-var method-syms]
Expand Down Expand Up @@ -684,7 +695,8 @@
(mapcat
(fn [s]
[`(intern *ns* (with-meta '~(:name s) (merge '~s {:protocol (var ~name)})))
(emit-method-builder (:on-interface opts) (:name s) (:on s) (:arglists s))])
(emit-method-builder (:on-interface opts) (:name s) (:on s) (:arglists s)
(:extend-via-metadata opts))])
(vals sigs)))))
(-reset-methods ~name)
'~name)))
Expand All @@ -696,6 +708,9 @@
;optional doc string
\"A doc string for AProtocol abstraction\"
;options
:extend-via-metadata true
;method signatures
(bar [this a b] \"bar docs\")
(baz [this a] [this a b] [this a b c] \"baz docs\"))
Expand All @@ -710,6 +725,13 @@
effect, and defines no new types or classes. Implementations of
the protocol methods can be provided using extend.
When :extend-via-metadata is true, values can extend protocols by
adding metadata where keys are fully-qualified protocol function
symbols and values are function implementations. Protocol
implementations are checked first for direct definitions (defrecord,
deftype, reify), then metadata definitions, then external
extensions (extend, extend-type, extend-protocol)
defprotocol will automatically generate a corresponding interface,
with the same name as the protocol, i.e. given a protocol:
my.ns/Protocol, an interface: my.ns.Protocol. The interface will
Expand Down
17 changes: 0 additions & 17 deletions src/clj/clojure/core_instant18.clj

This file was deleted.

60 changes: 47 additions & 13 deletions src/clj/clojure/core_print.clj
Original file line number Diff line number Diff line change
Expand Up @@ -463,18 +463,27 @@
(print-method [(symbol (.getClassName o)) (symbol (.getMethodName o)) (.getFileName o) (.getLineNumber o)] w))

(defn StackTraceElement->vec
"Constructs a data representation for a StackTraceElement"
"Constructs a data representation for a StackTraceElement: [class method file line]"
{:added "1.9"}
[^StackTraceElement o]
[(symbol (.getClassName o)) (symbol (.getMethodName o)) (.getFileName o) (.getLineNumber o)])

(defn Throwable->map
"Constructs a data representation for a Throwable."
"Constructs a data representation for a Throwable with keys:
:cause - root cause message
:phase - error phase
:via - cause chain, with cause keys:
:type - exception class symbol
:message - exception message
:data - ex-data
:at - top stack element
:trace - root cause stack elements"
{:added "1.7"}
[^Throwable o]
(let [base (fn [^Throwable t]
(merge {:type (symbol (.getName (class t)))
:message (.getLocalizedMessage t)}
(merge {:type (symbol (.getName (class t)))}
(when-let [msg (.getLocalizedMessage t)]
{:message msg})
(when-let [ed (ex-data t)]
{:data ed})
(let [st (.getStackTrace t)]
Expand All @@ -484,15 +493,16 @@
(if t
(recur (conj via t) (.getCause t))
via))
^Throwable root (peek via)
m {:cause (.getLocalizedMessage root)
:via (vec (map base via))
:trace (vec (map StackTraceElement->vec
(.getStackTrace ^Throwable (or root o))))}
data (ex-data root)]
(if data
(assoc m :data data)
m)))
^Throwable root (peek via)]
(merge {:via (vec (map base via))
:trace (vec (map StackTraceElement->vec
(.getStackTrace ^Throwable (or root o))))}
(when-let [root-msg (.getLocalizedMessage root)]
{:cause root-msg})
(when-let [data (ex-data root)]
{:data data})
(when-let [phase (-> o ex-data :clojure.error/phase)]
{:phase phase}))))

(defn- print-throwable [^Throwable o ^Writer w]
(.write w "#error {\n :cause ")
Expand Down Expand Up @@ -545,3 +555,27 @@
(print-method (:form o) w))

(def ^{:private true} print-initialized true)

(defn ^java.io.PrintWriter PrintWriter-on
"implements java.io.PrintWriter given flush-fn, which will be called
when .flush() is called, with a string built up since the last call to .flush().
if not nil, close-fn will be called with no arguments when .close is called"
{:added "1.10"}
[flush-fn close-fn]
(let [sb (StringBuilder.)]
(-> (proxy [Writer] []
(flush []
(when (pos? (.length sb))
(flush-fn (.toString sb)))
(.setLength sb 0))
(close []
(.flush ^Writer this)
(when close-fn (close-fn))
nil)
(write [str-cbuf off len]
(when (pos? len)
(if (instance? String str-cbuf)
(.append sb ^String str-cbuf ^int off ^int len)
(.append sb ^chars str-cbuf ^int off ^int len)))))
java.io.BufferedWriter.
java.io.PrintWriter.)))
2 changes: 1 addition & 1 deletion src/clj/clojure/core_proxy.clj
Original file line number Diff line number Diff line change
Expand Up @@ -341,7 +341,7 @@
defaults to Object.
The interfaces names must be valid interface types. If a method fn
is not provided for a class method, the superclass methd will be
is not provided for a class method, the superclass method will be
called. If a method fn is not provided for an interface method, an
UnsupportedOperationException will be thrown should it be
called. Method fns are closures and can capture the environment in
Expand Down
62 changes: 62 additions & 0 deletions src/clj/clojure/datafy.clj
Original file line number Diff line number Diff line change
@@ -0,0 +1,62 @@
; 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.

(ns ^{:doc "Functions to turn objects into data. Alpha, subject to change"}
clojure.datafy
(:require [clojure.core.protocols :as p]))

(set! *warn-on-reflection* true)

(defn datafy
"Attempts to return x as data.
datafy will return the value of clojure.core.protocols/datafy. If
the value has been transformed and the result supports
metadata, :clojure.datafy/obj will be set on the metadata to the
original value of x, and :clojure.datafy/class to the name of the
class of x, as a symbol."
[x]
(let [v (p/datafy x)]
(if (identical? v x)
v
(if (instance? clojure.lang.IObj v)
(vary-meta v assoc ::obj x ::class (-> x class .getName symbol))
v))))

(defn nav
"Returns (possibly transformed) v in the context of coll and k (a
key/index or nil). Callers should attempt to provide the key/index
context k for Indexed/Associative/ILookup colls if possible, but not
to fabricate one e.g. for sequences (pass nil). nav returns the
value of clojure.core.protocols/nav."
[coll k v]
(p/nav coll k v))

(defn- sortmap [m]
(into (sorted-map) m))

(extend-protocol p/Datafiable
Throwable
(datafy [x]
(Throwable->map x))

clojure.lang.IRef
(datafy [r]
(with-meta [(deref r)] (meta r)))

clojure.lang.Namespace
(datafy [n]
(with-meta {:name (.getName n)
:publics (-> n ns-publics sortmap)
:imports (-> n ns-imports sortmap)
:interns (-> n ns-interns sortmap)}
(meta n)))

java.lang.Class
(datafy [c]
(let [{:keys [members] :as ret} ((requiring-resolve 'clojure.reflect/reflect) c)]
(assoc ret :name (-> c .getName symbol) :members (->> members (group-by :name) sortmap)))))
8 changes: 4 additions & 4 deletions src/clj/clojure/genclass.clj
Original file line number Diff line number Diff line change
Expand Up @@ -133,7 +133,7 @@
interfaces (map the-class implements)
supers (cons super interfaces)
ctor-sig-map (or constructors (zipmap (ctor-sigs super) (ctor-sigs super)))
cv (new ClassWriter (. ClassWriter COMPUTE_MAXS))
cv (clojure.lang.Compiler/classWriter)
cname (. name (replace "." "/"))
pkg-name name
impl-pkg-name (str impl-ns)
Expand Down Expand Up @@ -254,7 +254,7 @@
(. gen (endMethod))))
]
;start class definition
(. cv (visit (. Opcodes V1_5) (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_SUPER))
(. cv (visit (. Opcodes V1_8) (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_SUPER))
cname nil (iname super)
(when-let [ifc (seq interfaces)]
(into-array (map iname ifc)))))
Expand Down Expand Up @@ -661,8 +661,8 @@
(throw
(IllegalArgumentException. "Interface methods must not contain '-'")))
(let [iname (.replace (str name) "." "/")
cv (ClassWriter. ClassWriter/COMPUTE_MAXS)]
(. cv visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC
cv (clojure.lang.Compiler/classWriter)]
(. cv visit Opcodes/V1_8 (+ Opcodes/ACC_PUBLIC
Opcodes/ACC_ABSTRACT
Opcodes/ACC_INTERFACE)
iname nil "java/lang/Object"
Expand Down
2 changes: 1 addition & 1 deletion src/clj/clojure/gvec.clj
Original file line number Diff line number Diff line change
Expand Up @@ -397,7 +397,7 @@
(containsAll [this c] (every? #(.contains this %) c))
(isEmpty [_] (zero? cnt))
(toArray [this] (into-array Object this))
(toArray [this arr]
(^objects toArray [this ^objects arr]
(if (>= (count arr) cnt)
(do
(dotimes [i cnt]
Expand Down
27 changes: 15 additions & 12 deletions src/clj/clojure/instant.clj
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,10 @@
(recur (.append b \0))
(.toString b)))))

(def parse-timestamp
(def ^:private timestamp
#"(\d\d\d\d)(?:-(\d\d)(?:-(\d\d)(?:[T](\d\d)(?::(\d\d)(?::(\d\d)(?:[.](\d+))?)?)?)?)?)?(?:[Z]|([-+])(\d\d):(\d\d))?")

(defn parse-timestamp
"Parse a string containing an RFC3339-like like timestamp.
The function new-instant is called with the following arguments.
Expand Down Expand Up @@ -98,9 +101,7 @@ 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]
[new-instant ^CharSequence cs]
(if-let [[_ years months days hours minutes seconds fraction
offset-sign offset-hours offset-minutes]
(re-matches timestamp cs)]
Expand All @@ -117,7 +118,7 @@ specified.
: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))))))
(fail (str "Unrecognized date/time syntax: " cs))))


;;; ------------------------------------------------------------------------
Expand Down Expand Up @@ -270,22 +271,24 @@ milliseconds since the epoch, UTC."
;; nanos must be set separately, pass 0 above for the base calendar
(.setNanos nanoseconds)))

(def read-instant-date
(defn 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)))
[^CharSequence cs]
(parse-timestamp (validated construct-date) cs))

(def read-instant-calendar
(defn 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)))
[^CharSequence cs]
(parse-timestamp (validated construct-calendar) cs))

(def read-instant-timestamp
(defn 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)))

[^CharSequence cs]
(parse-timestamp (validated construct-timestamp) cs))
2 changes: 1 addition & 1 deletion src/clj/clojure/java/browse_ui.clj
Original file line number Diff line number Diff line change
Expand Up @@ -26,5 +26,5 @@
(doto (javax.swing.JFrame.)
(.setContentPane (javax.swing.JScrollPane. htmlpane))
(.setBounds 32 32 700 900)
(.show))))
(.setVisible true))))

5 changes: 3 additions & 2 deletions src/clj/clojure/java/javadoc.clj
Original file line number Diff line number Diff line change
Expand Up @@ -20,9 +20,10 @@

(def ^:dynamic *core-java-api*
(case (System/getProperty "java.specification.version")
"1.6" "http://docs.oracle.com/javase/6/docs/api/"
"1.7" "http://docs.oracle.com/javase/7/docs/api/"
"1.8" "http://docs.oracle.com/javase/8/docs/api/"
"9" "http://docs.oracle.com/javase/9/docs/api/"
"10" "http://docs.oracle.com/javase/10/docs/api/"
"11" "https://docs.oracle.com/en/java/javase/11/docs/api/java.base/"
"http://docs.oracle.com/javase/8/docs/api/"))

(def ^:dynamic *remote-javadocs*
Expand Down
216 changes: 195 additions & 21 deletions src/clj/clojure/main.clj
Original file line number Diff line number Diff line change
Expand Up @@ -12,21 +12,16 @@
:author "Stephen C. Gilardi and Rich Hickey"}
clojure.main
(:refer-clojure :exclude [with-bindings])
(:require [clojure.spec.alpha])
(:import (clojure.lang Compiler Compiler$CompilerException
LineNumberingPushbackReader RT))
(:require [clojure.spec.alpha :as spec])
(:import (java.io StringReader)
(clojure.lang Compiler Compiler$CompilerException
LineNumberingPushbackReader RT LispReader$ReaderException))
;;(:use [clojure.repl :only (demunge root-cause stack-element-str)])
)

(declare main)

;;;;;;;;;;;;;;;;;;; redundantly copied from clojure.repl to avoid dep ;;;;;;;;;;;;;;
#_(defn root-cause [x] x)
#_(defn stack-element-str
"Returns a (possibly unmunged) string representation of a StackTraceElement"
{:added "1.3"}
[^StackTraceElement el]
(.getClassName el))

(defn demunge
"Given a string representation of a fn class,
Expand All @@ -48,6 +43,20 @@
(recur cause)
cause))))

;;;;;;;;;;;;;;;;;;; end of redundantly copied from clojure.repl to avoid dep ;;;;;;;;;;;;;;

(def ^:private core-namespaces
#{"clojure.core" "clojure.core.reducers" "clojure.core.protocols" "clojure.data" "clojure.datafy"
"clojure.edn" "clojure.instant" "clojure.java.io" "clojure.main" "clojure.pprint" "clojure.reflect"
"clojure.repl" "clojure.set" "clojure.spec.alpha" "clojure.spec.gen.alpha" "clojure.spec.test.alpha"
"clojure.string" "clojure.template" "clojure.uuid" "clojure.walk" "clojure.xml" "clojure.zip"})

(defn- core-class?
[^String class-name]
(and (not (nil? class-name))
(or (.startsWith class-name "clojure.lang.")
(contains? core-namespaces (second (re-find #"^([^$]+)\$" class-name))))))

(defn stack-element-str
"Returns a (possibly unmunged) string representation of a StackTraceElement"
{:added "1.3"}
Expand Down Expand Up @@ -126,6 +135,20 @@
(or (Character/isWhitespace (char c)) (= c (int \,))) (recur (.read s))
:else (do (.unread s c) :body))))

(defn renumbering-read
"Reads from reader, which must be a LineNumberingPushbackReader, while capturing
the read string. If the read is successful, reset the line number and re-read.
The line number on re-read is the passed line-number unless :line or
:clojure.core/eval-file meta are explicitly set on the read value."
{:added "1.10"}
([opts ^LineNumberingPushbackReader reader line-number]
(let [pre-line (.getLineNumber reader)
[pre-read s] (read+string opts reader)
{:keys [clojure.core/eval-file line]} (meta pre-read)
re-reader (doto (LineNumberingPushbackReader. (StringReader. s))
(.setLineNumber (if (and line (or eval-file (not= pre-line line))) line line-number)))]
(read opts re-reader))))

(defn repl-read
"Default :read hook for repl. Reads from *in* which must either be an
instance of LineNumberingPushbackReader or duplicate its behavior of both
Expand All @@ -140,7 +163,7 @@
[request-prompt request-exit]
(or ({:line-start request-prompt :stream-end request-exit}
(skip-whitespace *in*))
(let [input (read {:read-cond :allow} *in*)]
(let [input (renumbering-read {:read-cond :allow} *in* 1)]
(skip-if-eol *in*)
input)))

Expand All @@ -149,17 +172,162 @@
[throwable]
(root-cause throwable))

(defn- file-name
"Helper to get just the file name part of a path or nil"
[^String full-path]
(when full-path
(try
(.getName (java.io.File. full-path))
(catch Throwable t))))

(defn- java-loc->source
"Convert Java class name and method symbol to source symbol, either a
Clojure function or Java class and method."
[clazz method]
(if (#{'invoke 'invokeStatic} method)
(let [degen #(.replaceAll ^String % "--.*$" "")
[ns-name fn-name & nested] (->> (str clazz) (.split #"\$") (map demunge) (map degen))]
(symbol ns-name (String/join "$" ^"[Ljava.lang.String;" (into-array String (cons fn-name nested)))))
(symbol (name clazz) (name method))))

(defn ex-triage
"Returns an analysis of the phase, error, cause, and location of an error that occurred
based on Throwable data, as returned by Throwable->map. All attributes other than phase
are optional:
:clojure.error/phase - keyword phase indicator, one of:
:read-source :compile-syntax-check :compilation :macro-syntax-check :macroexpansion
:execution :read-eval-result :print-eval-result
:clojure.error/source - file name (no path)
:clojure.error/line - integer line number
:clojure.error/column - integer column number
:clojure.error/symbol - symbol being expanded/compiled/invoked
:clojure.error/class - cause exception class symbol
:clojure.error/cause - cause exception message
:clojure.error/spec - explain-data for spec error"
{:added "1.10"}
[datafied-throwable]
(let [{:keys [via trace phase] :or {phase :execution}} datafied-throwable
{:keys [type message data]} (last via)
{:clojure.spec.alpha/keys [problems fn], :clojure.spec.test.alpha/keys [caller]} data
{:clojure.error/keys [source] :as top-data} (:data (first via))]
(assoc
(case phase
:read-source
(let [{:clojure.error/keys [line column]} data]
(cond-> (merge (-> via second :data) top-data)
source (assoc :clojure.error/source (file-name source))
(#{"NO_SOURCE_FILE" "NO_SOURCE_PATH"} source) (dissoc :clojure.error/source)
message (assoc :clojure.error/cause message)))

(:compile-syntax-check :compilation :macro-syntax-check :macroexpansion)
(cond-> top-data
source (assoc :clojure.error/source (file-name source))
(#{"NO_SOURCE_FILE" "NO_SOURCE_PATH"} source) (dissoc :clojure.error/source)
type (assoc :clojure.error/class type)
message (assoc :clojure.error/cause message)
problems (assoc :clojure.error/spec data))

(:read-eval-result :print-eval-result)
(let [[source method file line] (-> trace first)]
(cond-> top-data
line (assoc :clojure.error/line line)
file (assoc :clojure.error/source file)
(and source method) (assoc :clojure.error/symbol (java-loc->source source method))
type (assoc :clojure.error/class type)
message (assoc :clojure.error/cause message)))

:execution
(let [[source method file line] (->> trace (drop-while #(core-class? (name (first %)))) first)
file (first (remove #(or (nil? %) (#{"NO_SOURCE_FILE" "NO_SOURCE_PATH"} %)) [(:file caller) file]))
err-line (or (:line caller) line)]
(cond-> {:clojure.error/class type}
err-line (assoc :clojure.error/line err-line)
message (assoc :clojure.error/cause message)
(or fn (and source method)) (assoc :clojure.error/symbol (or fn (java-loc->source source method)))
file (assoc :clojure.error/source file)
problems (assoc :clojure.error/spec data))))
:clojure.error/phase phase)))

(defn ex-str
"Returns a string from exception data, as produced by ex-triage.
The first line summarizes the exception phase and location.
The subsequent lines describe the cause."
{:added "1.10"}
[{:clojure.error/keys [phase source line column symbol class cause spec]
:as triage-data}]
(let [loc (str (or source "REPL") ":" (or line 1) (if column (str ":" column) ""))
class-name (name (or class ""))
simple-class (if class (or (first (re-find #"([^.])++$" class-name)) class-name))
cause-type (if (contains? #{"Exception" "RuntimeException"} simple-class)
"" ;; omit, not useful
(str " (" simple-class ")"))]
(case phase
:read-source
(format "Syntax error reading source at (%s).%n%s%n" loc cause)

:macro-syntax-check
(format "Syntax error macroexpanding %sat (%s).%n%s"
(if symbol (str symbol " ") "")
loc
(if spec
(with-out-str
(spec/explain-out
(if (= spec/*explain-out* spec/explain-printer)
(update spec :clojure.spec.alpha/problems
(fn [probs] (map #(dissoc % :in) probs)))
spec)))
(format "%s%n" cause)))

:macroexpansion
(format "Unexpected error%s macroexpanding %sat (%s).%n%s%n"
cause-type
(if symbol (str symbol " ") "")
loc
cause)

:compile-syntax-check
(format "Syntax error%s compiling %sat (%s).%n%s%n"
cause-type
(if symbol (str symbol " ") "")
loc
cause)

:compilation
(format "Unexpected error%s compiling %sat (%s).%n%s%n"
cause-type
(if symbol (str symbol " ") "")
loc
cause)

:read-eval-result
(format "Error reading eval result%s at %s (%s).%n%s%n" cause-type symbol loc cause)

:print-eval-result
(format "Error printing return value%s at %s (%s).%n%s%n" cause-type symbol loc cause)

:execution
(if spec
(format "Execution error - invalid arguments to %s at (%s).%n%s"
symbol
loc
(with-out-str
(spec/explain-out
(if (= spec/*explain-out* spec/explain-printer)
(update spec :clojure.spec.alpha/problems
(fn [probs] (map #(dissoc % :in) probs)))
spec))))
(format "Execution error%s at %s(%s).%n%s%n"
cause-type
(if symbol (str symbol " ") "")
loc
cause)))))

(defn repl-caught
"Default :caught hook for repl"
[e]
(let [ex (repl-exception e)
tr (.getStackTrace ex)
el (when-not (zero? (count tr)) (aget tr 0))]
(binding [*out* *err*]
(println (str (-> ex class .getSimpleName)
" " (.getMessage ex) " "
(when-not (instance? clojure.lang.Compiler$CompilerException ex)
(str " " (if el (stack-element-str el) "[trace missing]"))))))))
(binding [*out* *err*]
(print (-> e Throwable->map ex-triage ex-str))
(flush)))

(def ^{:doc "A sequence of lib specs that are applied to `require`
by default when a new command-line REPL is started."} repl-requires
Expand Down Expand Up @@ -238,13 +406,19 @@ by default when a new command-line REPL is started."} repl-requires
(fn []
(try
(let [read-eval *read-eval*
input (with-read-known (read request-prompt request-exit))]
input (try
(with-read-known (read request-prompt request-exit))
(catch LispReader$ReaderException e
(throw (ex-info nil {:clojure.error/phase :read-source} e))))]
(or (#{request-prompt request-exit} input)
(let [value (binding [*read-eval* read-eval] (eval input))]
(print value)
(set! *3 *2)
(set! *2 *1)
(set! *1 value))))
(set! *1 value)
(try
(print value)
(catch Throwable e
(throw (ex-info nil {:clojure.error/phase :print-eval-result} e)))))))
(catch Throwable e
(caught e)
(set! *e e))))]
Expand Down
2 changes: 1 addition & 1 deletion src/clj/clojure/pprint/cl_format.clj
Original file line number Diff line number Diff line change
Expand Up @@ -1649,7 +1649,7 @@ not a pretty writer (which keeps track of columns), this function always outputs
(and (= (.length p) 1) (contains? #{\v \V} (nth p 0))) :parameter-from-args
(and (= (.length p) 1) (= \# (nth p 0))) :remaining-arg-count
(and (= (.length p) 2) (= \' (nth p 0))) (nth p 1)
true (new Integer p))
true (Integer/parseInt p))
offset])

(def ^{:private true}
Expand Down
22 changes: 17 additions & 5 deletions src/clj/clojure/reflect/java.clj
Original file line number Diff line number Diff line change
Expand Up @@ -9,12 +9,15 @@
;; Java-specific parts of clojure.reflect
(in-ns 'clojure.reflect)

(require '[clojure.set :as set]
(require '[clojure.datafy :refer (datafy)]
'[clojure.set :as set]
'[clojure.string :as str])
(import '[clojure.asm ClassReader ClassVisitor Type Opcodes]
'[java.lang.reflect Modifier]
java.io.InputStream)

(set! *warn-on-reflection* true)

(extend-protocol TypeReference
clojure.lang.Symbol
(typename [s] (str/replace (str s) "<>" "[]"))
Expand All @@ -34,9 +37,12 @@
"Given a typeref, create a legal Clojure symbol version of the
type's name."
[t]
(-> (typename t)
(str/replace "[]" "<>")
(symbol)))
(cond->
(-> (typename t)
(str/replace "[]" "<>")
(symbol))
(class? t) (with-meta {'clojure.core.protocols/datafy
(fn [_] (datafy t))})))

(defn- resource-name
"Given a typeref, return implied resource name. Used by Reflectors
Expand Down Expand Up @@ -163,10 +169,16 @@ the kinds of objects to which they can apply."}
field->map
(.getDeclaredFields cls))))

(defn- typeref->class
^Class [typeref classloader]
(if (class? typeref)
typeref
(clojure.lang.RT/classForName (typename typeref) false classloader)))

(deftype JavaReflector [classloader]
Reflector
(do-reflect [_ typeref]
(let [cls (clojure.lang.RT/classForName (typename typeref) false classloader)]
(let [cls (typeref->class typeref classloader)]
{:bases (not-empty (set (map typesym (bases cls))))
:flags (parse-flags (.getModifiers cls) :class)
:members (set/union (declared-fields cls)
Expand Down
3 changes: 3 additions & 0 deletions src/clj/clojure/repl.clj
Original file line number Diff line number Diff line change
Expand Up @@ -250,6 +250,9 @@ str-or-pattern."
(pst (root-cause e) e-or-depth))))
([^Throwable e depth]
(binding [*out* *err*]
(when (#{:read-source :macro-syntax-check :macroexpansion :compile-syntax-check :compilation}
(-> e ex-data :clojure.error/phase))
(println "Note: The following stack trace applies to the reader or compiler, your code was not executed."))
(println (str (-> e class .getSimpleName) " "
(.getMessage e)
(when-let [info (ex-data e)] (str " " (pr-str info)))))
Expand Down
8 changes: 6 additions & 2 deletions src/clj/clojure/stacktrace.clj
Original file line number Diff line number Diff line change
Expand Up @@ -36,10 +36,14 @@
(printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e)))

(defn print-throwable
"Prints the class and message of a Throwable."
"Prints the class and message of a Throwable. Prints the ex-data map
if present."
{:added "1.1"}
[tr]
(printf "%s: %s" (.getName (class tr)) (.getMessage tr)))
(printf "%s: %s" (.getName (class tr)) (.getMessage tr))
(when-let [info (ex-data tr)]
(newline)
(pr info)))

(defn print-stack-trace
"Prints a Clojure-oriented stack trace of tr, a Throwable.
Expand Down
3 changes: 2 additions & 1 deletion src/clj/clojure/test.clj
Original file line number Diff line number Diff line change
Expand Up @@ -360,7 +360,8 @@
:fail (merge (stacktrace-file-and-line (drop-while
#(let [cl-name (.getClassName ^StackTraceElement %)]
(or (str/starts-with? cl-name "java.lang.")
(str/starts-with? cl-name "clojure.test$")))
(str/starts-with? cl-name "clojure.test$")
(str/starts-with? cl-name "clojure.core$ex_info")))
(.getStackTrace (Thread/currentThread)))) m)
:error (merge (stacktrace-file-and-line (.getStackTrace ^Throwable (:actual m))) m)
m)))
Expand Down
3 changes: 2 additions & 1 deletion src/clj/clojure/walk.clj
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,8 @@ the sorting function."}
[inner outer form]
(cond
(list? form) (outer (apply list (map inner form)))
(instance? clojure.lang.IMapEntry form) (outer (vec (map inner form)))
(instance? clojure.lang.IMapEntry form)
(outer (clojure.lang.MapEntry/create (inner (key form)) (inner (val form))))
(seq? form) (outer (doall (map inner form)))
(instance? clojure.lang.IRecord form)
(outer (reduce (fn [r x] (conj r (inner x))) form form))
Expand Down
271 changes: 126 additions & 145 deletions src/jvm/clojure/asm/AnnotationVisitor.java
Original file line number Diff line number Diff line change
@@ -1,169 +1,150 @@
/***
* ASM: a very small and fast Java bytecode manipulation framework
* Copyright (c) 2000-2011 INRIA, France Telecom
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. Neither the name of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived from
* this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
* LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
* CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
* THE POSSIBILITY OF SUCH DAMAGE.
*/
// ASM: a very small and fast Java bytecode manipulation framework
// Copyright (c) 2000-2011 INRIA, France Telecom
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions
// are met:
// 1. Redistributions of source code must retain the above copyright
// notice, this list of conditions and the following disclaimer.
// 2. Redistributions in binary form must reproduce the above copyright
// notice, this list of conditions and the following disclaimer in the
// documentation and/or other materials provided with the distribution.
// 3. Neither the name of the copyright holders nor the names of its
// contributors may be used to endorse or promote products derived from
// this software without specific prior written permission.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
// THE POSSIBILITY OF SUCH DAMAGE.
package clojure.asm;

/**
* A visitor to visit a Java annotation. The methods of this class must be
* called in the following order: ( <tt>visit</tt> | <tt>visitEnum</tt> |
* <tt>visitAnnotation</tt> | <tt>visitArray</tt> )* <tt>visitEnd</tt>.
* A visitor to visit a Java annotation. The methods of this class must be called in the following
* order: ( <tt>visit</tt> | <tt>visitEnum</tt> | <tt>visitAnnotation</tt> | <tt>visitArray</tt> )*
* <tt>visitEnd</tt>.
*
* @author Eric Bruneton
* @author Eugene Kuleshov
*/
public abstract class AnnotationVisitor {

/**
* The ASM API version implemented by this visitor. The value of this field
* must be one of {@link Opcodes#ASM4}.
*/
protected final int api;
/**
* The ASM API version implemented by this visitor. The value of this field must be one of {@link
* Opcodes#ASM4}, {@link Opcodes#ASM5}, {@link Opcodes#ASM6} or {@link Opcodes#ASM7_EXPERIMENTAL}.
*/
protected final int api;

/**
* The annotation visitor to which this visitor must delegate method calls.
* May be null.
*/
protected AnnotationVisitor av;
/** The annotation visitor to which this visitor must delegate method calls. May be null. */
protected AnnotationVisitor av;

/**
* Constructs a new {@link AnnotationVisitor}.
*
* @param api
* the ASM API version implemented by this visitor. Must be one
* of {@link Opcodes#ASM4}.
*/
public AnnotationVisitor(final int api) {
this(api, null);
}
/**
* Constructs a new {@link AnnotationVisitor}.
*
* @param api the ASM API version implemented by this visitor. Must be one of {@link
* Opcodes#ASM4}, {@link Opcodes#ASM5}, {@link Opcodes#ASM6} or {@link
* Opcodes#ASM7_EXPERIMENTAL}.
*/
public AnnotationVisitor(final int api) {
this(api, null);
}

/**
* Constructs a new {@link AnnotationVisitor}.
*
* @param api
* the ASM API version implemented by this visitor. Must be one
* of {@link Opcodes#ASM4}.
* @param av
* the annotation visitor to which this visitor must delegate
* method calls. May be null.
*/
public AnnotationVisitor(final int api, final AnnotationVisitor av) {
if (api != Opcodes.ASM4) {
throw new IllegalArgumentException();
}
this.api = api;
this.av = av;
/**
* Constructs a new {@link AnnotationVisitor}.
*
* @param api the ASM API version implemented by this visitor. Must be one of {@link
* Opcodes#ASM4}, {@link Opcodes#ASM5}, {@link Opcodes#ASM6} or {@link
* Opcodes#ASM7_EXPERIMENTAL}.
* @param annotationVisitor the annotation visitor to which this visitor must delegate method
* calls. May be null.
*/
public AnnotationVisitor(final int api, final AnnotationVisitor annotationVisitor) {
if (api != Opcodes.ASM6
&& api != Opcodes.ASM5
&& api != Opcodes.ASM4
&& api != Opcodes.ASM7_EXPERIMENTAL) {
throw new IllegalArgumentException();
}
this.api = api;
this.av = annotationVisitor;
}

/**
* Visits a primitive value of the annotation.
*
* @param name
* the value name.
* @param value
* the actual value, whose type must be {@link Byte},
* {@link Boolean}, {@link Character}, {@link Short},
* {@link Integer} , {@link Long}, {@link Float}, {@link Double},
* {@link String} or {@link Type} or OBJECT or ARRAY sort. This
* value can also be an array of byte, boolean, short, char, int,
* long, float or double values (this is equivalent to using
* {@link #visitArray visitArray} and visiting each array element
* in turn, but is more convenient).
*/
public void visit(String name, Object value) {
if (av != null) {
av.visit(name, value);
}
/**
* Visits a primitive value of the annotation.
*
* @param name the value name.
* @param value the actual value, whose type must be {@link Byte}, {@link Boolean}, {@link
* Character}, {@link Short}, {@link Integer} , {@link Long}, {@link Float}, {@link Double},
* {@link String} or {@link Type} of {@link Type#OBJECT} or {@link Type#ARRAY} sort. This
* value can also be an array of byte, boolean, short, char, int, long, float or double values
* (this is equivalent to using {@link #visitArray} and visiting each array element in turn,
* but is more convenient).
*/
public void visit(final String name, final Object value) {
if (av != null) {
av.visit(name, value);
}
}

/**
* Visits an enumeration value of the annotation.
*
* @param name
* the value name.
* @param desc
* the class descriptor of the enumeration class.
* @param value
* the actual enumeration value.
*/
public void visitEnum(String name, String desc, String value) {
if (av != null) {
av.visitEnum(name, desc, value);
}
/**
* Visits an enumeration value of the annotation.
*
* @param name the value name.
* @param descriptor the class descriptor of the enumeration class.
* @param value the actual enumeration value.
*/
public void visitEnum(final String name, final String descriptor, final String value) {
if (av != null) {
av.visitEnum(name, descriptor, value);
}
}

/**
* Visits a nested annotation value of the annotation.
*
* @param name
* the value name.
* @param desc
* the class descriptor of the nested annotation class.
* @return a visitor to visit the actual nested annotation value, or
* <tt>null</tt> if this visitor is not interested in visiting this
* nested annotation. <i>The nested annotation value must be fully
* visited before calling other methods on this annotation
* visitor</i>.
*/
public AnnotationVisitor visitAnnotation(String name, String desc) {
if (av != null) {
return av.visitAnnotation(name, desc);
}
return null;
/**
* Visits a nested annotation value of the annotation.
*
* @param name the value name.
* @param descriptor the class descriptor of the nested annotation class.
* @return a visitor to visit the actual nested annotation value, or <tt>null</tt> if this visitor
* is not interested in visiting this nested annotation. <i>The nested annotation value must
* be fully visited before calling other methods on this annotation visitor</i>.
*/
public AnnotationVisitor visitAnnotation(final String name, final String descriptor) {
if (av != null) {
return av.visitAnnotation(name, descriptor);
}
return null;
}

/**
* Visits an array value of the annotation. Note that arrays of primitive
* types (such as byte, boolean, short, char, int, long, float or double)
* can be passed as value to {@link #visit visit}. This is what
* {@link ClassReader} does.
*
* @param name
* the value name.
* @return a visitor to visit the actual array value elements, or
* <tt>null</tt> if this visitor is not interested in visiting these
* values. The 'name' parameters passed to the methods of this
* visitor are ignored. <i>All the array values must be visited
* before calling other methods on this annotation visitor</i>.
*/
public AnnotationVisitor visitArray(String name) {
if (av != null) {
return av.visitArray(name);
}
return null;
/**
* Visits an array value of the annotation. Note that arrays of primitive types (such as byte,
* boolean, short, char, int, long, float or double) can be passed as value to {@link #visit
* visit}. This is what {@link ClassReader} does.
*
* @param name the value name.
* @return a visitor to visit the actual array value elements, or <tt>null</tt> if this visitor is
* not interested in visiting these values. The 'name' parameters passed to the methods of
* this visitor are ignored. <i>All the array values must be visited before calling other
* methods on this annotation visitor</i>.
*/
public AnnotationVisitor visitArray(final String name) {
if (av != null) {
return av.visitArray(name);
}
return null;
}

/**
* Visits the end of the annotation.
*/
public void visitEnd() {
if (av != null) {
av.visitEnd();
}
/** Visits the end of the annotation. */
public void visitEnd() {
if (av != null) {
av.visitEnd();
}
}
}
662 changes: 381 additions & 281 deletions src/jvm/clojure/asm/AnnotationWriter.java

Large diffs are not rendered by default.

526 changes: 297 additions & 229 deletions src/jvm/clojure/asm/Attribute.java

Large diffs are not rendered by default.

602 changes: 328 additions & 274 deletions src/jvm/clojure/asm/ByteVector.java

Large diffs are not rendered by default.

5,593 changes: 3,479 additions & 2,114 deletions src/jvm/clojure/asm/ClassReader.java

Large diffs are not rendered by default.

563 changes: 309 additions & 254 deletions src/jvm/clojure/asm/ClassVisitor.java

Large diffs are not rendered by default.

2,646 changes: 962 additions & 1,684 deletions src/jvm/clojure/asm/ClassWriter.java

Large diffs are not rendered by default.

147 changes: 147 additions & 0 deletions src/jvm/clojure/asm/ConstantDynamic.java
Original file line number Diff line number Diff line change
@@ -0,0 +1,147 @@
// ASM: a very small and fast Java bytecode manipulation framework
// Copyright (c) 2000-2011 INRIA, France Telecom
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions
// are met:
// 1. Redistributions of source code must retain the above copyright
// notice, this list of conditions and the following disclaimer.
// 2. Redistributions in binary form must reproduce the above copyright
// notice, this list of conditions and the following disclaimer in the
// documentation and/or other materials provided with the distribution.
// 3. Neither the name of the copyright holders nor the names of its
// contributors may be used to endorse or promote products derived from
// this software without specific prior written permission.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
// THE POSSIBILITY OF SUCH DAMAGE.
package clojure.asm;

import java.util.Arrays;

/**
* A constant whose value is computed at runtime, with a bootstrap method.
*
* @author Remi Forax
* @deprecated This API is experimental.
*/
@Deprecated
public final class ConstantDynamic {

/** The constant name (can be arbitrary). */
private final String name;

/** The constant type (must be a field descriptor). */
private final String descriptor;

/** The bootstrap method to use to compute the constant value at runtime. */
private final Handle bootstrapMethod;

/**
* The arguments to pass to the bootstrap method, in order to compute the constant value at
* runtime.
*/
private final Object[] bootstrapMethodArguments;

/**
* Constructs a new {@link ConstantDynamic}.
*
* @param name the constant name (can be arbitrary).
* @param descriptor the constant type (must be a field descriptor).
* @param bootstrapMethod the bootstrap method to use to compute the constant value at runtime.
* @param bootstrapMethodArguments the arguments to pass to the bootstrap method, in order to
* compute the constant value at runtime.
*/
public ConstantDynamic(
final String name,
final String descriptor,
final Handle bootstrapMethod,
final Object... bootstrapMethodArguments) {
this.name = name;
this.descriptor = descriptor;
this.bootstrapMethod = bootstrapMethod;
this.bootstrapMethodArguments = bootstrapMethodArguments;
}

/**
* Returns the name of this constant.
*
* @return the name of this constant.
*/
public String getName() {
return name;
}

/**
* Returns the type of this constant.
*
* @return the type of this constant, as a field descriptor.
*/
public String getDescriptor() {
return descriptor;
}

/**
* Returns the bootstrap method used to compute the value of this constant.
*
* @return the bootstrap method used to compute the value of this constant.
*/
public Handle getBootstrapMethod() {
return bootstrapMethod;
}

/**
* Returns the arguments to pass to the bootstrap method, in order to compute the value of this
* constant.
*
* @return the arguments to pass to the bootstrap method, in order to compute the value of this
* constant.
*/
public Object[] getBootstrapMethodArguments() {
return bootstrapMethodArguments;
}

@Override
public boolean equals(final Object object) {
if (object == this) {
return true;
}
if (!(object instanceof ConstantDynamic)) {
return false;
}
ConstantDynamic constantDynamic = (ConstantDynamic) object;
return name.equals(constantDynamic.name)
&& descriptor.equals(constantDynamic.descriptor)
&& bootstrapMethod.equals(constantDynamic.bootstrapMethod)
&& Arrays.equals(bootstrapMethodArguments, constantDynamic.bootstrapMethodArguments);
}

@Override
public int hashCode() {
return name.hashCode()
^ Integer.rotateLeft(descriptor.hashCode(), 8)
^ Integer.rotateLeft(bootstrapMethod.hashCode(), 16)
^ Integer.rotateLeft(Arrays.hashCode(bootstrapMethodArguments), 24);
}

@Override
public String toString() {
return name
+ " : "
+ descriptor
+ ' '
+ bootstrapMethod
+ ' '
+ Arrays.toString(bootstrapMethodArguments);
}
}
177 changes: 177 additions & 0 deletions src/jvm/clojure/asm/Constants.java
Original file line number Diff line number Diff line change
@@ -0,0 +1,177 @@
// ASM: a very small and fast Java bytecode manipulation framework
// Copyright (c) 2000-2011 INRIA, France Telecom
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions
// are met:
// 1. Redistributions of source code must retain the above copyright
// notice, this list of conditions and the following disclaimer.
// 2. Redistributions in binary form must reproduce the above copyright
// notice, this list of conditions and the following disclaimer in the
// documentation and/or other materials provided with the distribution.
// 3. Neither the name of the copyright holders nor the names of its
// contributors may be used to endorse or promote products derived from
// this software without specific prior written permission.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
// THE POSSIBILITY OF SUCH DAMAGE.
package clojure.asm;

/**
* Defines additional JVM opcodes, access flags and constants which are not part of the ASM public
* API.
*
* @see <a href="https://docs.oracle.com/javase/specs/jvms/se11/html/jvms-6.html">JVMS 6</a>
* @author Eric Bruneton
*/
final class Constants implements Opcodes {

private Constants() {}

// The ClassFile attribute names, in the order they are defined in
// https://docs.oracle.com/javase/specs/jvms/se11/html/jvms-4.html#jvms-4.7-300.

static final String CONSTANT_VALUE = "ConstantValue";
static final String CODE = "Code";
static final String STACK_MAP_TABLE = "StackMapTable";
static final String EXCEPTIONS = "Exceptions";
static final String INNER_CLASSES = "InnerClasses";
static final String ENCLOSING_METHOD = "EnclosingMethod";
static final String SYNTHETIC = "Synthetic";
static final String SIGNATURE = "Signature";
static final String SOURCE_FILE = "SourceFile";
static final String SOURCE_DEBUG_EXTENSION = "SourceDebugExtension";
static final String LINE_NUMBER_TABLE = "LineNumberTable";
static final String LOCAL_VARIABLE_TABLE = "LocalVariableTable";
static final String LOCAL_VARIABLE_TYPE_TABLE = "LocalVariableTypeTable";
static final String DEPRECATED = "Deprecated";
static final String RUNTIME_VISIBLE_ANNOTATIONS = "RuntimeVisibleAnnotations";
static final String RUNTIME_INVISIBLE_ANNOTATIONS = "RuntimeInvisibleAnnotations";
static final String RUNTIME_VISIBLE_PARAMETER_ANNOTATIONS = "RuntimeVisibleParameterAnnotations";
static final String RUNTIME_INVISIBLE_PARAMETER_ANNOTATIONS =
"RuntimeInvisibleParameterAnnotations";
static final String RUNTIME_VISIBLE_TYPE_ANNOTATIONS = "RuntimeVisibleTypeAnnotations";
static final String RUNTIME_INVISIBLE_TYPE_ANNOTATIONS = "RuntimeInvisibleTypeAnnotations";
static final String ANNOTATION_DEFAULT = "AnnotationDefault";
static final String BOOTSTRAP_METHODS = "BootstrapMethods";
static final String METHOD_PARAMETERS = "MethodParameters";
static final String MODULE = "Module";
static final String MODULE_PACKAGES = "ModulePackages";
static final String MODULE_MAIN_CLASS = "ModuleMainClass";
static final String NEST_HOST = "NestHost";
static final String NEST_MEMBERS = "NestMembers";

// ASM specific access flags.
// WARNING: the 16 least significant bits must NOT be used, to avoid conflicts with standard
// access flags, and also to make sure that these flags are automatically filtered out when
// written in class files (because access flags are stored using 16 bits only).

static final int ACC_CONSTRUCTOR = 0x40000; // method access flag.

// ASM specific stack map frame types, used in {@link ClassVisitor#visitFrame}.

/**
* A frame inserted between already existing frames. This internal stack map frame type (in
* addition to the ones declared in {@link Opcodes}) can only be used if the frame content can be
* computed from the previous existing frame and from the instructions between this existing frame
* and the inserted one, without any knowledge of the type hierarchy. This kind of frame is only
* used when an unconditional jump is inserted in a method while expanding an ASM specific
* instruction. Keep in sync with Opcodes.java.
*/
static final int F_INSERT = 256;

// The JVM opcode values which are not part of the ASM public API.
// See https://docs.oracle.com/javase/specs/jvms/se9/html/jvms-6.html.

static final int LDC_W = 19;
static final int LDC2_W = 20;
static final int ILOAD_0 = 26;
static final int ILOAD_1 = 27;
static final int ILOAD_2 = 28;
static final int ILOAD_3 = 29;
static final int LLOAD_0 = 30;
static final int LLOAD_1 = 31;
static final int LLOAD_2 = 32;
static final int LLOAD_3 = 33;
static final int FLOAD_0 = 34;
static final int FLOAD_1 = 35;
static final int FLOAD_2 = 36;
static final int FLOAD_3 = 37;
static final int DLOAD_0 = 38;
static final int DLOAD_1 = 39;
static final int DLOAD_2 = 40;
static final int DLOAD_3 = 41;
static final int ALOAD_0 = 42;
static final int ALOAD_1 = 43;
static final int ALOAD_2 = 44;
static final int ALOAD_3 = 45;
static final int ISTORE_0 = 59;
static final int ISTORE_1 = 60;
static final int ISTORE_2 = 61;
static final int ISTORE_3 = 62;
static final int LSTORE_0 = 63;
static final int LSTORE_1 = 64;
static final int LSTORE_2 = 65;
static final int LSTORE_3 = 66;
static final int FSTORE_0 = 67;
static final int FSTORE_1 = 68;
static final int FSTORE_2 = 69;
static final int FSTORE_3 = 70;
static final int DSTORE_0 = 71;
static final int DSTORE_1 = 72;
static final int DSTORE_2 = 73;
static final int DSTORE_3 = 74;
static final int ASTORE_0 = 75;
static final int ASTORE_1 = 76;
static final int ASTORE_2 = 77;
static final int ASTORE_3 = 78;
static final int WIDE = 196;
static final int GOTO_W = 200;
static final int JSR_W = 201;

// Constants to convert between normal and wide jump instructions.

// The delta between the GOTO_W and JSR_W opcodes and GOTO and JUMP.
static final int WIDE_JUMP_OPCODE_DELTA = GOTO_W - GOTO;

// Constants to convert JVM opcodes to the equivalent ASM specific opcodes, and vice versa.

// The delta between the ASM_IFEQ, ..., ASM_IF_ACMPNE, ASM_GOTO and ASM_JSR opcodes
// and IFEQ, ..., IF_ACMPNE, GOTO and JSR.
static final int ASM_OPCODE_DELTA = 49;

// The delta between the ASM_IFNULL and ASM_IFNONNULL opcodes and IFNULL and IFNONNULL.
static final int ASM_IFNULL_OPCODE_DELTA = 20;

// ASM specific opcodes, used for long forward jump instructions.

static final int ASM_IFEQ = IFEQ + ASM_OPCODE_DELTA;
static final int ASM_IFNE = IFNE + ASM_OPCODE_DELTA;
static final int ASM_IFLT = IFLT + ASM_OPCODE_DELTA;
static final int ASM_IFGE = IFGE + ASM_OPCODE_DELTA;
static final int ASM_IFGT = IFGT + ASM_OPCODE_DELTA;
static final int ASM_IFLE = IFLE + ASM_OPCODE_DELTA;
static final int ASM_IF_ICMPEQ = IF_ICMPEQ + ASM_OPCODE_DELTA;
static final int ASM_IF_ICMPNE = IF_ICMPNE + ASM_OPCODE_DELTA;
static final int ASM_IF_ICMPLT = IF_ICMPLT + ASM_OPCODE_DELTA;
static final int ASM_IF_ICMPGE = IF_ICMPGE + ASM_OPCODE_DELTA;
static final int ASM_IF_ICMPGT = IF_ICMPGT + ASM_OPCODE_DELTA;
static final int ASM_IF_ICMPLE = IF_ICMPLE + ASM_OPCODE_DELTA;
static final int ASM_IF_ACMPEQ = IF_ACMPEQ + ASM_OPCODE_DELTA;
static final int ASM_IF_ACMPNE = IF_ACMPNE + ASM_OPCODE_DELTA;
static final int ASM_GOTO = GOTO + ASM_OPCODE_DELTA;
static final int ASM_JSR = JSR + ASM_OPCODE_DELTA;
static final int ASM_IFNULL = IFNULL + ASM_IFNULL_OPCODE_DELTA;
static final int ASM_IFNONNULL = IFNONNULL + ASM_IFNULL_OPCODE_DELTA;
static final int ASM_GOTO_W = 220;
}
231 changes: 129 additions & 102 deletions src/jvm/clojure/asm/Context.java
Original file line number Diff line number Diff line change
@@ -1,32 +1,30 @@
/***
* ASM: a very small and fast Java bytecode manipulation framework
* Copyright (c) 2000-2011 INRIA, France Telecom
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. Neither the name of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived from
* this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
* LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
* CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
* THE POSSIBILITY OF SUCH DAMAGE.
*/
// ASM: a very small and fast Java bytecode manipulation framework
// Copyright (c) 2000-2011 INRIA, France Telecom
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions
// are met:
// 1. Redistributions of source code must retain the above copyright
// notice, this list of conditions and the following disclaimer.
// 2. Redistributions in binary form must reproduce the above copyright
// notice, this list of conditions and the following disclaimer in the
// documentation and/or other materials provided with the distribution.
// 3. Neither the name of the copyright holders nor the names of its
// contributors may be used to endorse or promote products derived from
// this software without specific prior written permission.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
// THE POSSIBILITY OF SUCH DAMAGE.

package clojure.asm;

Expand All @@ -35,76 +33,105 @@
*
* @author Eric Bruneton
*/
class Context {

/**
* Prototypes of the attributes that must be parsed for this class.
*/
Attribute[] attrs;

/**
* The {@link ClassReader} option flags for the parsing of this class.
*/
int flags;

/**
* The buffer used to read strings.
*/
char[] buffer;

/**
* The start index of each bootstrap method.
*/
int[] bootstrapMethods;

/**
* The access flags of the method currently being parsed.
*/
int access;

/**
* The name of the method currently being parsed.
*/
String name;

/**
* The descriptor of the method currently being parsed.
*/
String desc;

/**
* The offset of the latest stack map frame that has been parsed.
*/
int offset;

/**
* The encoding of the latest stack map frame that has been parsed.
*/
int mode;

/**
* The number of locals in the latest stack map frame that has been parsed.
*/
int localCount;

/**
* The number locals in the latest stack map frame that has been parsed,
* minus the number of locals in the previous frame.
*/
int localDiff;

/**
* The local values of the latest stack map frame that has been parsed.
*/
Object[] local;

/**
* The stack size of the latest stack map frame that has been parsed.
*/
int stackCount;

/**
* The stack values of the latest stack map frame that has been parsed.
*/
Object[] stack;
}
final class Context {

/** The prototypes of the attributes that must be parsed in this class. */
Attribute[] attributePrototypes;

/**
* The options used to parse this class. One or more of {@link ClassReader#SKIP_CODE}, {@link
* ClassReader#SKIP_DEBUG}, {@link ClassReader#SKIP_FRAMES}, {@link ClassReader#EXPAND_FRAMES} or
* {@link ClassReader#EXPAND_ASM_INSNS}.
*/
int parsingOptions;

/** The buffer used to read strings in the constant pool. */
char[] charBuffer;

// Information about the current method, i.e. the one read in the current (or latest) call
// to {@link ClassReader#readMethod()}.

/** The access flags of the current method. */
int currentMethodAccessFlags;

/** The name of the current method. */
String currentMethodName;

/** The descriptor of the current method. */
String currentMethodDescriptor;

/**
* The labels of the current method, indexed by bytecode offset (only bytecode offsets for which a
* label is needed have a non null associated Label).
*/
Label[] currentMethodLabels;

// Information about the current type annotation target, i.e. the one read in the current
// (or latest) call to {@link ClassReader#readAnnotationTarget()}.

/**
* The target_type and target_info of the current type annotation target, encoded as described in
* {@link TypeReference}.
*/
int currentTypeAnnotationTarget;

/** The target_path of the current type annotation target. */
TypePath currentTypeAnnotationTargetPath;

/** The start of each local variable range in the current local variable annotation. */
Label[] currentLocalVariableAnnotationRangeStarts;

/** The end of each local variable range in the current local variable annotation. */
Label[] currentLocalVariableAnnotationRangeEnds;

/**
* The local variable index of each local variable range in the current local variable annotation.
*/
int[] currentLocalVariableAnnotationRangeIndices;

// Information about the current stack map frame, i.e. the one read in the current (or latest)
// call to {@link ClassReader#readFrame()}.

/** The bytecode offset of the current stack map frame. */
int currentFrameOffset;

/**
* The type of the current stack map frame. One of {@link Opcodes#F_FULL}, {@link
* Opcodes#F_APPEND}, {@link Opcodes#F_CHOP}, {@link Opcodes#F_SAME} or {@link Opcodes#F_SAME1}.
*/
int currentFrameType;

/**
* The number of local variable types in the current stack map frame. Each type is represented
* with a single array element (even long and double).
*/
int currentFrameLocalCount;

/**
* The delta number of local variable types in the current stack map frame (each type is
* represented with a single array element - even long and double). This is the number of local
* variable types in this frame, minus the number of local variable types in the previous frame.
*/
int currentFrameLocalCountDelta;

/**
* The types of the local variables in the current stack map frame. Each type is represented with
* a single array element (even long and double), using the format described in {@link
* MethodVisitor#visitFrame}. Depending on {@link #currentFrameType}, this contains the types of
* all the local variables, or only those of the additional ones (compared to the previous frame).
*/
Object[] currentFrameLocalTypes;

/**
* The number stack element types in the current stack map frame. Each type is represented with a
* single array element (even long and double).
*/
int currentFrameStackCount;

/**
* The types of the stack elements in the current stack map frame. Each type is represented with a
* single array element (even long and double), using the format described in {@link
* MethodVisitor#visitFrame}.
*/
Object[] currentFrameStackTypes;
}
56 changes: 56 additions & 0 deletions src/jvm/clojure/asm/CurrentFrame.java
Original file line number Diff line number Diff line change
@@ -0,0 +1,56 @@
// ASM: a very small and fast Java bytecode manipulation framework
// Copyright (c) 2000-2011 INRIA, France Telecom
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions
// are met:
// 1. Redistributions of source code must retain the above copyright
// notice, this list of conditions and the following disclaimer.
// 2. Redistributions in binary form must reproduce the above copyright
// notice, this list of conditions and the following disclaimer in the
// documentation and/or other materials provided with the distribution.
// 3. Neither the name of the copyright holders nor the names of its
// contributors may be used to endorse or promote products derived from
// this software without specific prior written permission.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
// THE POSSIBILITY OF SUCH DAMAGE.

package clojure.asm;

/**
* Information about the input stack map frame at the "current" instruction of a method. This is
* implemented as a Frame subclass for a "basic block" containing only one instruction.
*
* @author Eric Bruneton
*/
final class CurrentFrame extends Frame {

CurrentFrame(final Label owner) {
super(owner);
}

/**
* Sets this CurrentFrame to the input stack map frame of the next "current" instruction, i.e. the
* instruction just after the given one. It is assumed that the value of this object when this
* method is called is the stack map frame status just before the given instruction is executed.
*/
@Override
void execute(
final int opcode, final int arg, final Symbol symbolArg, final SymbolTable symbolTable) {
super.execute(opcode, arg, symbolArg, symbolTable);
Frame successor = new Frame(null);
merge(symbolTable, successor, 0);
copyFrom(successor);
}
}
142 changes: 79 additions & 63 deletions src/jvm/clojure/asm/Edge.java
Original file line number Diff line number Diff line change
@@ -1,75 +1,91 @@
/***
* ASM: a very small and fast Java bytecode manipulation framework
* Copyright (c) 2000-2011 INRIA, France Telecom
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. Neither the name of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived from
* this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
* LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
* CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
* THE POSSIBILITY OF SUCH DAMAGE.
*/
// ASM: a very small and fast Java bytecode manipulation framework
// Copyright (c) 2000-2011 INRIA, France Telecom
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions
// are met:
// 1. Redistributions of source code must retain the above copyright
// notice, this list of conditions and the following disclaimer.
// 2. Redistributions in binary form must reproduce the above copyright
// notice, this list of conditions and the following disclaimer in the
// documentation and/or other materials provided with the distribution.
// 3. Neither the name of the copyright holders nor the names of its
// contributors may be used to endorse or promote products derived from
// this software without specific prior written permission.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
// THE POSSIBILITY OF SUCH DAMAGE.
package clojure.asm;

/**
* An edge in the control flow graph of a method body. See {@link Label Label}.
* An edge in the control flow graph of a method. Each node of this graph is a basic block,
* represented with the Label corresponding to its first instruction. Each edge goes from one node
* to another, i.e. from one basic block to another (called the predecessor and successor blocks,
* respectively). An edge corresponds either to a jump or ret instruction or to an exception
* handler.
*
* @see Label
* @author Eric Bruneton
*/
class Edge {
final class Edge {

/**
* A control flow graph edge corresponding to a jump or ret instruction. Only used with {@link
* ClassWriter#COMPUTE_FRAMES}.
*/
static final int JUMP = 0;

/**
* Denotes a normal control flow graph edge.
*/
static final int NORMAL = 0;
/**
* A control flow graph edge corresponding to an exception handler. Only used with {@link
* ClassWriter#COMPUTE_MAXS}.
*/
static final int EXCEPTION = 0x7FFFFFFF;

/**
* Denotes a control flow graph edge corresponding to an exception handler.
* More precisely any {@link Edge} whose {@link #info} is strictly positive
* corresponds to an exception handler. The actual value of {@link #info} is
* the index, in the {@link ClassWriter} type table, of the exception that
* is catched.
*/
static final int EXCEPTION = 0x7FFFFFFF;
/**
* Information about this control flow graph edge.
*
* <ul>
* <li>If {@link ClassWriter#COMPUTE_MAXS} is used, this field contains either a stack size
* delta (for an edge corresponding to a jump instruction), or the value EXCEPTION (for an
* edge corresponding to an exception handler). The stack size delta is the stack size just
* after the jump instruction, minus the stack size at the beginning of the predecessor
* basic block, i.e. the one containing the jump instruction.
* <li>If {@link ClassWriter#COMPUTE_FRAMES} is used, this field contains either the value JUMP
* (for an edge corresponding to a jump instruction), or the index, in the {@link
* ClassWriter} type table, of the exception type that is handled (for an edge corresponding
* to an exception handler).
* </ul>
*/
final int info;

/**
* Information about this control flow graph edge. If
* {@link ClassWriter#COMPUTE_MAXS} is used this field is the (relative)
* stack size in the basic block from which this edge originates. This size
* is equal to the stack size at the "jump" instruction to which this edge
* corresponds, relatively to the stack size at the beginning of the
* originating basic block. If {@link ClassWriter#COMPUTE_FRAMES} is used,
* this field is the kind of this control flow graph edge (i.e. NORMAL or
* EXCEPTION).
*/
int info;
/** The successor block of this control flow graph edge. */
final Label successor;

/**
* The successor block of the basic block from which this edge originates.
*/
Label successor;
/**
* The next edge in the list of outgoing edges of a basic block. See {@link Label#outgoingEdges}.
*/
Edge nextEdge;

/**
* The next edge in the list of successors of the originating basic block.
* See {@link Label#successors successors}.
*/
Edge next;
/**
* Constructs a new Edge.
*
* @param info see {@link #info}.
* @param successor see {@link #successor}.
* @param nextEdge see {@link #nextEdge}.
*/
Edge(final int info, final Label successor, final Edge nextEdge) {
this.info = info;
this.successor = successor;
this.nextEdge = nextEdge;
}
}
Loading