summaryrefslogtreecommitdiff
path: root/src/clj
diff options
context:
space:
mode:
Diffstat (limited to 'src/clj')
-rw-r--r--src/clj/clojure/core.clj20
-rw-r--r--src/clj/clojure/main.clj35
-rw-r--r--src/clj/clojure/reflect.clj123
-rw-r--r--src/clj/clojure/reflect/java.clj253
-rw-r--r--src/clj/clojure/repl.clj33
5 files changed, 429 insertions, 35 deletions
diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj
index b399f6cf..2f5504cc 100644
--- a/src/clj/clojure/core.clj
+++ b/src/clj/clojure/core.clj
@@ -3755,19 +3755,23 @@
(defn ns-resolve
"Returns the var or Class to which a symbol will be resolved in the
- namespace, else nil. Note that if the symbol is fully qualified,
- the var/Class to which it resolves need not be present in the
- namespace."
+ namespace (unless found in the environement), else nil. Note that
+ if the symbol is fully qualified, the var/Class to which it resolves
+ need not be present in the namespace."
{:added "1.0"
:static true}
- [ns sym]
- (clojure.lang.Compiler/maybeResolveIn (the-ns ns) sym))
+ ([ns sym]
+ (ns-resolve ns nil sym))
+ ([ns env sym]
+ (when-not (contains? env sym)
+ (clojure.lang.Compiler/maybeResolveIn (the-ns ns) sym))))
(defn resolve
- "same as (ns-resolve *ns* symbol)"
+ "same as (ns-resolve *ns* symbol) or (ns-resolve *ns* &env symbol)"
{:added "1.0"
:static true}
- [sym] (ns-resolve *ns* sym))
+ ([sym] (ns-resolve *ns* sym))
+ ([env sym] (ns-resolve *ns* env sym)))
(defn array-map
"Constructs an array-map."
@@ -5635,7 +5639,7 @@
(add-doc-and-meta *out*
"A java.io.Writer object representing standard output for print operations.
- Defaults to System/out"
+ Defaults to System/out, wrapped in an OutputStreamWriter"
{:added "1.0"})
(add-doc-and-meta *err*
diff --git a/src/clj/clojure/main.clj b/src/clj/clojure/main.clj
index d52123fe..7aa74ab8 100644
--- a/src/clj/clojure/main.clj
+++ b/src/clj/clojure/main.clj
@@ -104,11 +104,11 @@
[e]
(let [ex (repl-exception e)
el (aget (.getStackTrace ex) 0)]
- (.println *err*
- (str (-> ex class .getSimpleName)
- " " (.getMessage ex) " "
- (when-not (instance? clojure.lang.Compiler$CompilerException ex)
- (str " " (stack-element-str el)))))))
+ (binding [*out* *err*]
+ (println (str (-> ex class .getSimpleName)
+ " " (.getMessage ex) " "
+ (when-not (instance? clojure.lang.Compiler$CompilerException ex)
+ (str " " (stack-element-str el))))))))
(defn repl
"Generic, reusable, read-eval-print loop. By default, reads from *in*,
@@ -248,6 +248,14 @@
(doseq [[opt arg] inits]
((init-dispatch opt) arg)))
+(defn- main-opt
+ "Call the -main function from a namespace with string arguments from
+ the command line."
+ [[_ main-ns & args] inits]
+ (with-bindings
+ (initialize args inits)
+ (apply (ns-resolve (doto (symbol main-ns) require) '-main) args)))
+
(defn- repl-opt
"Start a repl with args and inits. Print greeting if no eval options were
present"
@@ -284,6 +292,8 @@
(or
({"-r" repl-opt
"--repl" repl-opt
+ "-m" main-opt
+ "--main" main-opt
nil null-opt
"-h" help-opt
"--help" help-opt
@@ -316,14 +326,15 @@ java -cp clojure.jar clojure.main -i init.clj script.clj args...")
With no options or args, runs an interactive Read-Eval-Print Loop
init options:
- -i, --init path Load a file or resource
- -e, --eval string Evaluate expressions in string; print non-nil values
+ -i, --init path Load a file or resource
+ -e, --eval string Evaluate expressions in string; print non-nil values
main options:
- -r, --repl Run a repl
- path Run a script from from a file or resource
- - Run a script from standard input
- -h, -?, --help Print this help message and exit
+ -m, --main ns-name Call the -main function from a namespace with args
+ -r, --repl Run a repl
+ path Run a script from from a file or resource
+ - Run a script from standard input
+ -h, -?, --help Print this help message and exit
operation:
@@ -332,7 +343,7 @@ java -cp clojure.jar clojure.main -i init.clj script.clj args...")
- Binds *command-line-args* to a seq of strings containing command line
args that appear after any main option
- Runs all init options in order
- - Runs a repl or script if requested
+ - Calls a -main function or runs a repl or script if requested
The init options may be repeated and mixed freely, but must appear before
any main option. The appearance of any eval option before running a repl
diff --git a/src/clj/clojure/reflect.clj b/src/clj/clojure/reflect.clj
new file mode 100644
index 00000000..cf639568
--- /dev/null
+++ b/src/clj/clojure/reflect.clj
@@ -0,0 +1,123 @@
+; 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 ^{:author "Stuart Halloway"
+ :added "1.3"
+ :doc "Reflection on Host Types
+Alpha - subject to change.
+
+Two main entry points:
+
+* type-reflect reflects on something that implements TypeReference.
+* reflect (for REPL use) reflects on the class of an instance, or
+ on a class if passed a class
+
+Key features:
+
+* Exposes the read side of reflection as pure data. Reflecting
+ on a type returns a map with keys :bases, :flags, and :members.
+
+* Canonicalizes class names as Clojure symbols. Types can extend
+ to the TypeReference protocol to indicate that they can be
+ unambiguously resolved as a type name. The canonical format
+ requires one non-Java-ish convention: array brackets are <>
+ instead of [] so they can be part of a Clojure symbol.
+
+* Pluggable Reflectors for different implementations. The default
+ JavaReflector is good when you have a class in hand, or use
+ the AsmReflector for \"hands off\" reflection without forcing
+ classes to load.
+
+Platform implementers must:
+
+* Create an implementation of Reflector.
+* Create one or more implementations of TypeReference.
+* def default-reflector to be an instance that satisfies Reflector."}
+ clojure.reflect
+ (:require [clojure.set :as set]))
+
+(defprotocol Reflector
+ "Protocol for reflection implementers."
+ (do-reflect [reflector typeref]))
+
+(defprotocol TypeReference
+ "A TypeReference can be unambiguously converted to a type name on
+ the host platform.
+
+ All typerefs are normalized into symbols. If you need to
+ normalize a typeref yourself, call typesym."
+ (typename [o] "Returns Java name as returned by ASM getClassName, e.g. byte[], java.lang.String[]"))
+
+(declare default-reflector)
+
+(defn type-reflect
+ "Alpha - subject to change.
+ Reflect on a typeref, returning a map with :bases, :flags, and
+ :members. In the discussion below, names are always Clojure symbols.
+
+ :bases a set of names of the type's bases
+ :flags a set of keywords naming the boolean attributes
+ of the type.
+ :members a set of the type's members. Each membrer is a map
+ and can be a constructor, method, or field.
+
+ Keys common to all members:
+ :name name of the type
+ :declaring-class name of the declarer
+ :flags keyword naming boolean attributes of the member
+
+ Keys specific to constructors:
+ :parameter-types vector of parameter type names
+ :exception-types vector of exception type names
+
+ Key specific to methods:
+ :parameter-types vector of parameter type names
+ :exception-types vector of exception type names
+ :return-type return type name
+
+ Keys specific to fields:
+ :type type name
+
+ Options:
+
+ :ancestors in addition to the keys described above, also
+ include an :ancestors key with the entire set of
+ ancestors, and add all ancestor members to
+ :members.
+ :reflector implementation to use. Defaults to JavaReflector,
+ AsmReflector is also an option."
+ {:added "1.3"}
+ [typeref & options]
+ (let [{:keys [ancestors reflector]}
+ (merge {:reflector default-reflector}
+ (apply hash-map options))
+ refl (partial do-reflect reflector)
+ result (refl typeref)]
+ ;; could make simpler loop of two args: names an
+ (if ancestors
+ (let [make-ancestor-map (fn [names]
+ (zipmap names (map refl names)))]
+ (loop [reflections (make-ancestor-map (:bases result))]
+ (let [ancestors-visited (set (keys reflections))
+ ancestors-to-visit (set/difference (set (mapcat :bases (vals reflections)))
+ ancestors-visited)]
+ (if (seq ancestors-to-visit)
+ (recur (merge reflections (make-ancestor-map ancestors-to-visit)))
+ (apply merge-with into result {:ancestors ancestors-visited}
+ (map #(select-keys % [:members]) (vals reflections)))))))
+ result)))
+
+(defn reflect
+ "Alpha - subject to change.
+ Reflect on the type of obj (or obj itself if obj is a class).
+ Return value and options are the same as for type-reflect. "
+ {:added "1.3"}
+ [obj & options]
+ (apply type-reflect (if (class? obj) obj (class obj)) options))
+
+(load "reflect/java")
diff --git a/src/clj/clojure/reflect/java.clj b/src/clj/clojure/reflect/java.clj
new file mode 100644
index 00000000..9a030899
--- /dev/null
+++ b/src/clj/clojure/reflect/java.clj
@@ -0,0 +1,253 @@
+; 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.
+
+;; Java-specific parts of clojure.reflect
+(in-ns 'clojure.reflect)
+
+(require '[clojure.set :as set]
+ '[clojure.string :as str])
+(import '[clojure.asm ClassReader ClassVisitor Type]
+ '[java.lang.reflect Modifier]
+ java.io.InputStream)
+
+(extend-protocol TypeReference
+ clojure.lang.Symbol
+ (typename [s] (str/replace (str s) "<>" "[]"))
+
+ Class
+ ;; neither .getName not .getSimpleName returns the right thing, so best to delegate to Type
+ (typename
+ [c]
+ (typename (Type/getType c)))
+
+ Type
+ (typename
+ [t]
+ (-> (.getClassName t))))
+
+(defn- typesym
+ "Given a typeref, create a legal Clojure symbol version of the
+ type's name."
+ [t]
+ (-> (typename t)
+ (str/replace "[]" "<>")
+ (symbol)))
+
+(defn- resource-name
+ "Given a typeref, return implied resource name. Used by Reflectors
+ such as ASM that need to find and read classbytes from files."
+ [typeref]
+ (-> (typename typeref)
+ (str/replace "." "/")
+ (str ".class")))
+
+(defn- access-flag
+ [[name flag & contexts]]
+ {:name name :flag flag :contexts (set (map keyword contexts))})
+
+(defn- field-descriptor->class-symbol
+ "Convert a Java field descriptor to a Clojure class symbol. Field
+ descriptors are described in section 4.3.2 of the JVM spec, 2nd ed.:
+ http://java.sun.com/docs/books/jvms/second_edition/html/ClassFile.doc.html#14152"
+ [^String d]
+ {:pre [(string? d)]}
+ (typesym (Type/getType d)))
+
+(defn- internal-name->class-symbol
+ "Convert a Java internal name to a Clojure class symbol. Internal
+ names uses slashes instead of dots, e.g. java/lang/String. See
+ Section 4.2 of the JVM spec, 2nd ed.:
+
+ http://java.sun.com/docs/books/jvms/second_edition/html/ClassFile.doc.html#14757"
+ [d]
+ {:pre [(string? d)]}
+ (typesym (Type/getObjectType d)))
+
+(def ^{:doc "The Java access bitflags, along with their friendly names and
+the kinds of objects to which they can apply."}
+ flag-descriptors
+ (vec
+ (map access-flag
+ [[:public 0x0001 :class :field :method]
+ [:private 0x002 :class :field :method]
+ [:protected 0x0004 :class :field :method]
+ [:static 0x0008 :field :method]
+ [:final 0x0010 :class :field :method]
+ ;; :super is ancient history and is unfindable (?) by
+ ;; reflection. skip it
+ #_[:super 0x0020 :class]
+ [:synchronized 0x0020 :method]
+ [:volatile 0x0040 :field]
+ [:bridge 0x0040 :method]
+ [:varargs 0x0080 :method]
+ [:transient 0x0080 :field]
+ [:native 0x0100 :method]
+ [:interface 0x0200 :class]
+ [:abstract 0x0400 :class :method]
+ [:strict 0x0800 :method]
+ [:synthetic 0x1000 :class :field :method]
+ [:annotation 0x2000 :class]
+ [:enum 0x4000 :class :field :inner]])))
+
+(defn- parse-flags
+ "Convert reflection bitflags into a set of keywords."
+ [flags context]
+ (reduce
+ (fn [result fd]
+ (if (and (get (:contexts fd) context)
+ (not (zero? (bit-and flags (:flag fd)))))
+ (conj result (:name fd))
+ result))
+ #{}
+ flag-descriptors))
+
+(defrecord Constructor
+ [name declaring-class parameter-types exception-types flags])
+
+(defn- constructor->map
+ [^java.lang.reflect.Constructor constructor]
+ (Constructor.
+ (symbol (.getName constructor))
+ (typesym (.getDeclaringClass constructor))
+ (vec (map typesym (.getParameterTypes constructor)))
+ (vec (map typesym (.getExceptionTypes constructor)))
+ (parse-flags (.getModifiers constructor) :method)))
+
+(defn- declared-constructors
+ "Return a set of the declared constructors of class as a Clojure map."
+ [^Class cls]
+ (set (map
+ constructor->map
+ (.getDeclaredConstructors cls))))
+
+(defrecord Method
+ [name return-type declaring-class parameter-types exception-types flags])
+
+(defn- method->map
+ [^java.lang.reflect.Method method]
+ (Method.
+ (symbol (.getName method))
+ (typesym (.getReturnType method))
+ (typesym (.getDeclaringClass method))
+ (vec (map typesym (.getParameterTypes method)))
+ (vec (map typesym (.getExceptionTypes method)))
+ (parse-flags (.getModifiers method) :method)))
+
+(defn- declared-methods
+ "Return a set of the declared constructors of class as a Clojure map."
+ [^Class cls]
+ (set (map
+ method->map
+ (.getDeclaredMethods cls))))
+
+(defrecord Field
+ [name type declaring-class flags])
+
+(defn- field->map
+ [^java.lang.reflect.Field field]
+ (Field.
+ (symbol (.getName field))
+ (typesym (.getType field))
+ (typesym (.getDeclaringClass field))
+ (parse-flags (.getModifiers field) :field)))
+
+(defn- declared-fields
+ "Return a set of the declared fields of class as a Clojure map."
+ [^Class cls]
+ (set (map
+ field->map
+ (.getDeclaredFields cls))))
+
+(deftype JavaReflector [classloader]
+ Reflector
+ (do-reflect [_ typeref]
+ (let [cls (Class/forName (typename typeref) false classloader)]
+ {:bases (not-empty (set (map typesym (bases cls))))
+ :flags (parse-flags (.getModifiers cls) :class)
+ :members (set/union (declared-fields cls)
+ (declared-methods cls)
+ (declared-constructors cls))})))
+
+(def ^:private default-reflector
+ (JavaReflector. (.getContextClassLoader (Thread/currentThread))))
+
+(defn- parse-method-descriptor
+ [^String md]
+ {:parameter-types (vec (map typesym (Type/getArgumentTypes md)))
+ :return-type (typesym (Type/getReturnType md))})
+
+(defprotocol ClassResolver
+ (^InputStream resolve-class [this name]
+ "Given a class name, return that typeref's class bytes as an InputStream."))
+
+(extend-protocol ClassResolver
+ clojure.lang.Fn
+ (resolve-class [this typeref] (this typeref))
+
+ ClassLoader
+ (resolve-class [this typeref]
+ (.getResourceAsStream this (resource-name typeref))))
+
+(deftype AsmReflector [class-resolver]
+ Reflector
+ (do-reflect [_ typeref]
+ (with-open [is (resolve-class class-resolver typeref)]
+ (let [class-symbol (typesym typeref)
+ r (ClassReader. is)
+ result (atom {:bases #{} :flags #{} :members #{}})]
+ (.accept
+ r
+ (reify
+ ClassVisitor
+ (visit [_ version access name signature superName interfaces]
+ (let [flags (parse-flags access :class)
+ ;; ignore java.lang.Object on interfaces to match reflection
+ superName (if (and (flags :interface)
+ (= superName "java/lang/Object"))
+ nil
+ superName)
+ bases (->> (cons superName interfaces)
+ (remove nil?)
+ (map internal-name->class-symbol)
+ (map symbol)
+ (set)
+ (not-empty))]
+ (swap! result merge {:bases bases
+ :flags flags})))
+ (visitSource [_ name debug])
+ (visitInnerClass [_ name outerName innerName access])
+ (visitField [_ access name desc signature value]
+ (swap! result update-in [:members] (fnil conj #{})
+ (Field. (symbol name)
+ (field-descriptor->class-symbol desc)
+ class-symbol
+ (parse-flags access :field)))
+ nil)
+ (visitMethod [_ access name desc signature exceptions]
+ (when-not (= name "<clinit>")
+ (let [constructor? (= name "<init>")]
+ (swap! result update-in [:members] (fnil conj #{})
+ (let [{:keys [parameter-types return-type]} (parse-method-descriptor desc)
+ flags (parse-flags access :method)]
+ (if constructor?
+ (Constructor. class-symbol
+ class-symbol
+ parameter-types
+ (vec (map internal-name->class-symbol exceptions))
+ flags)
+ (Method. (symbol name)
+ return-type
+ class-symbol
+ parameter-types
+ (vec (map internal-name->class-symbol exceptions))
+ flags))))))
+ nil)
+ (visitEnd [_])
+ ) 0)
+ @result))))
+
diff --git a/src/clj/clojure/repl.clj b/src/clj/clojure/repl.clj
index 2f50223d..77ef9dad 100644
--- a/src/clj/clojure/repl.clj
+++ b/src/clj/clojure/repl.clj
@@ -131,20 +131,23 @@ str-or-pattern."
most recent repl exception (*e), and a depth of 12."
{:added "1.3"}
([] (pst 12))
- ([depth]
- (when-let [e *e]
- (pst (root-cause e) depth)))
+ ([e-or-depth]
+ (if (instance? Throwable e-or-depth)
+ (pst e-or-depth 12)
+ (when-let [e *e]
+ (pst (root-cause e) e-or-depth))))
([^Throwable e depth]
- (.println *err* (str (-> e class .getSimpleName) " " (.getMessage e)))
- (let [st (.getStackTrace e)
- cause (.getCause e)]
- (doseq [el (take depth
- (remove #(#{"clojure.lang.RestFn" "clojure.lang.AFn"} (.getClassName %))
- st))]
- (.println *err* (str \tab (stack-element-str el))))
- (when cause
- (.println *err* "Caused by:")
- (pst cause (min depth
- (+ 2 (- (count (.getStackTrace cause))
- (count st)))))))))
+ (binding [*out* *err*]
+ (println (str (-> e class .getSimpleName) " " (.getMessage e)))
+ (let [st (.getStackTrace e)
+ cause (.getCause e)]
+ (doseq [el (take depth
+ (remove #(#{"clojure.lang.RestFn" "clojure.lang.AFn"} (.getClassName %))
+ st))]
+ (println (str \tab (stack-element-str el))))
+ (when cause
+ (println "Caused by:")
+ (pst cause (min depth
+ (+ 2 (- (count (.getStackTrace cause))
+ (count st))))))))))
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-09-08 17:00:47 +0000