summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/clj/clojure/core.clj152
-rw-r--r--src/clj/clojure/main.clj1
-rw-r--r--src/clj/clojure/test.clj12
-rw-r--r--src/clj/clojure/test/junit.clj193
-rw-r--r--src/clj/clojure/zip.clj19
-rw-r--r--src/jvm/clojure/lang/Compiler.java63
-rw-r--r--src/jvm/clojure/lang/Numbers.java140
-rw-r--r--src/jvm/clojure/lang/PersistentTreeSet.java27
8 files changed, 546 insertions, 61 deletions
diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj
index 1cd7b167..aa22ba9c 100644
--- a/src/clj/clojure/core.clj
+++ b/src/clj/clojure/core.clj
@@ -115,6 +115,11 @@
(def
#^{:arglists '([x])
+ :doc "Return true if x is a Character"}
+ char? (fn char? [x] (instance? Character x)))
+
+(def
+ #^{:arglists '([x])
:doc "Return true if x is a String"}
string? (fn string? [x] (instance? String x)))
@@ -225,7 +230,16 @@
fdecl (if (map? (last fdecl))
(butlast fdecl)
fdecl)
- m (conj {:arglists (list 'quote (sigs fdecl))} m)]
+ m (conj {:arglists (list 'quote (sigs fdecl))} m)
+ m (let [inline (:inline m)
+ ifn (first inline)
+ iname (second inline)]
+ ;; same as: (if (and (= 'fn ifn) (not (symbol? iname))) ...)
+ (if (if (clojure.lang.Util/equiv 'fn ifn)
+ (if (instance? clojure.lang.Symbol iname) false true))
+ ;; inserts the same fn name to the inline fn if it does not have one
+ (assoc m :inline (cons ifn (cons name (next inline))))
+ m))]
(list 'def (with-meta name (conj (if (meta name) (meta name) {}) m))
(cons `fn (cons name fdecl))))))
;(cons `fn fdecl)))))
@@ -267,24 +281,30 @@
"Returns a new hash set with supplied keys."
([] #{})
([& keys]
- (. clojure.lang.PersistentHashSet (create keys))))
+ (clojure.lang.PersistentHashSet/create keys)))
(defn sorted-map
"keyval => key val
Returns a new sorted map with supplied mappings."
([& keyvals]
- (. clojure.lang.PersistentTreeMap (create keyvals))))
-
-(defn sorted-set
- "Returns a new sorted set with supplied keys."
- ([& keys]
- (. clojure.lang.PersistentTreeSet (create keys))))
+ (clojure.lang.PersistentTreeMap/create keyvals)))
(defn sorted-map-by
"keyval => key val
Returns a new sorted map with supplied mappings, using the supplied comparator."
([comparator & keyvals]
- (. clojure.lang.PersistentTreeMap (create comparator keyvals))))
+ (clojure.lang.PersistentTreeMap/create comparator keyvals)))
+
+(defn sorted-set
+ "Returns a new sorted set with supplied keys."
+ ([& keys]
+ (clojure.lang.PersistentTreeSet/create keys)))
+
+(defn sorted-set-by
+ "Returns a new sorted set with supplied keys, using the supplied comparator."
+ ([comparator & keys]
+ (clojure.lang.PersistentTreeSet/create comparator keys)))
+
;;;;;;;;;;;;;;;;;;;;
(def
@@ -1065,8 +1085,9 @@
second item in the first form, making a list of it if it is not a
list already. If there are more forms, inserts the first form as the
second item in second form, etc."
+ ([x] x)
([x form] (if (seq? form)
- `(~(first form) ~x ~@(next form))
+ (with-meta `(~(first form) ~x ~@(next form)) (meta form))
(list form x)))
([x form & more] `(-> (-> ~x ~form) ~@more)))
@@ -1076,7 +1097,7 @@
list already. If there are more forms, inserts the first form as the
last item in second form, etc."
([x form] (if (seq? form)
- `(~(first form) ~@(next form) ~x)
+ (with-meta `(~(first form) ~@(next form) ~x) (meta form))
(list form x)))
([x form & more] `(->> (->> ~x ~form) ~@more)))
@@ -1125,7 +1146,7 @@
(defmacro defmethod
"Creates and installs a new method of multimethod associated with dispatch-value. "
[multifn dispatch-val & fn-tail]
- `(. ~multifn addMethod ~dispatch-val (fn ~@fn-tail)))
+ `(. ~(with-meta multifn {:tag 'clojure.lang.MultiFn}) addMethod ~dispatch-val (fn ~@fn-tail)))
(defn remove-method
"Removes the method of multimethod associated with dispatch-value."
@@ -1244,6 +1265,42 @@
(finally
(pop-thread-bindings))))))
+(defn with-bindings*
+ "Takes a map of Var/value pairs. Installs for the given Vars the associated
+ values as thread-local bindings. Then calls f with the supplied arguments.
+ Pops the installed bindings after f returned. Returns whatever f returns."
+ [binding-map f & args]
+ (push-thread-bindings binding-map)
+ (try
+ (apply f args)
+ (finally
+ (pop-thread-bindings))))
+
+(defmacro with-bindings
+ "Takes a map of Var/value pairs. Installs for the given Vars the associated
+ values as thread-local bindings. The executes body. Pops the installed
+ bindings after body was evaluated. Returns the value of body."
+ [binding-map & body]
+ `(with-bindings* ~binding-map (fn [] ~@body)))
+
+(defn bound-fn*
+ "Returns a function, which will install the same bindings in effect as in
+ the thread at the time bound-fn* was called and then call f with any given
+ arguments. This may be used to define a helper function which runs on a
+ different thread, but needs the same bindings in place."
+ [f]
+ (let [bindings (get-thread-bindings)]
+ (fn [& args]
+ (apply with-bindings* bindings f args))))
+
+(defmacro bound-fn
+ "Returns a function defined by the given fntail, which will install the
+ same bindings in effect as in the thread at the time bound-fn was called.
+ This may be used to define a helper function which runs on a different
+ thread, but needs the same bindings in place."
+ [& fntail]
+ `(bound-fn* (fn ~@fntail)))
+
(defn find-var
"Returns the global var named by the namespace-qualified symbol, or
nil if no var with that name."
@@ -1671,7 +1728,7 @@
(defn some
"Returns the first logical true value of (pred x) for any x in coll,
else nil. One common idiom is to use a set as pred, for example
- this will return true if :fred is in the sequence, otherwise nil:
+ this will return :fred if :fred is in the sequence, otherwise nil:
(some #{:fred} coll)"
[pred coll]
(when (seq coll)
@@ -1913,10 +1970,9 @@
"Returns the lines of text from rdr as a lazy sequence of strings.
rdr must implement java.io.BufferedReader."
[#^java.io.BufferedReader rdr]
- (lazy-seq
- (let [line (. rdr (readLine))]
- (when line
- (cons line (line-seq rdr))))))
+ (let [line (. rdr (readLine))]
+ (when line
+ (lazy-seq (cons line (line-seq rdr))))))
(defn comparator
"Returns an implementation of java.util.Comparator based upon pred."
@@ -3161,11 +3217,10 @@
using java.util.regex.Matcher.find(), each such match processed with
re-groups."
[#^java.util.regex.Pattern re s]
- (let [m (re-matcher re s)]
- ((fn step []
- (lazy-seq
- (when (. m (find))
- (cons (re-groups m) (step))))))))
+ (let [m (re-matcher re s)]
+ ((fn step []
+ (when (. m (find))
+ (lazy-seq (cons (re-groups m) (step))))))))
(defn re-matches
"Returns the match, if any, of string to pattern, using
@@ -3456,7 +3511,7 @@
(let [[pre-args [args expr]] (split-with (comp not vector?) decl)]
`(do
(defn ~name ~@pre-args ~args ~(apply (eval (list `fn args expr)) args))
- (alter-meta! (var ~name) assoc :inline (fn ~args ~expr))
+ (alter-meta! (var ~name) assoc :inline (fn ~name ~args ~expr))
(var ~name))))
(defn empty
@@ -3497,6 +3552,34 @@
([size-or-seq] (. clojure.lang.Numbers float_array size-or-seq))
([size init-val-or-seq] (. clojure.lang.Numbers float_array size init-val-or-seq)))
+(defn boolean-array
+ "Creates an array of booleans"
+ {:inline (fn [& args] `(. clojure.lang.Numbers boolean_array ~@args))
+ :inline-arities #{1 2}}
+ ([size-or-seq] (. clojure.lang.Numbers boolean_array size-or-seq))
+ ([size init-val-or-seq] (. clojure.lang.Numbers boolean_array size init-val-or-seq)))
+
+(defn byte-array
+ "Creates an array of bytes"
+ {:inline (fn [& args] `(. clojure.lang.Numbers byte_array ~@args))
+ :inline-arities #{1 2}}
+ ([size-or-seq] (. clojure.lang.Numbers byte_array size-or-seq))
+ ([size init-val-or-seq] (. clojure.lang.Numbers byte_array size init-val-or-seq)))
+
+(defn char-array
+ "Creates an array of chars"
+ {:inline (fn [& args] `(. clojure.lang.Numbers char_array ~@args))
+ :inline-arities #{1 2}}
+ ([size-or-seq] (. clojure.lang.Numbers char_array size-or-seq))
+ ([size init-val-or-seq] (. clojure.lang.Numbers char_array size init-val-or-seq)))
+
+(defn short-array
+ "Creates an array of shorts"
+ {:inline (fn [& args] `(. clojure.lang.Numbers short_array ~@args))
+ :inline-arities #{1 2}}
+ ([size-or-seq] (. clojure.lang.Numbers short_array size-or-seq))
+ ([size init-val-or-seq] (. clojure.lang.Numbers short_array size init-val-or-seq)))
+
(defn double-array
"Creates an array of doubles"
{:inline (fn [& args] `(. clojure.lang.Numbers double_array ~@args))
@@ -3512,12 +3595,28 @@
([size init-val-or-seq] (. clojure.lang.Numbers int_array size init-val-or-seq)))
(defn long-array
- "Creates an array of ints"
+ "Creates an array of longs"
{:inline (fn [& args] `(. clojure.lang.Numbers long_array ~@args))
:inline-arities #{1 2}}
([size-or-seq] (. clojure.lang.Numbers long_array size-or-seq))
([size init-val-or-seq] (. clojure.lang.Numbers long_array size init-val-or-seq)))
+(definline booleans
+ "Casts to boolean[]"
+ [xs] `(. clojure.lang.Numbers booleans ~xs))
+
+(definline bytes
+ "Casts to bytes[]"
+ [xs] `(. clojure.lang.Numbers bytes ~xs))
+
+(definline chars
+ "Casts to chars[]"
+ [xs] `(. clojure.lang.Numbers chars ~xs))
+
+(definline shorts
+ "Casts to shorts[]"
+ [xs] `(. clojure.lang.Numbers shorts ~xs))
+
(definline floats
"Casts to float[]"
[xs] `(. clojure.lang.Numbers floats ~xs))
@@ -3754,9 +3853,8 @@
row-struct (apply create-struct keys)
row-values (fn [] (map (fn [#^Integer i] (. rs (getObject i))) idxs))
rows (fn thisfn []
- (lazy-seq
- (when (. rs (next))
- (cons (apply struct row-struct (row-values)) (thisfn)))))]
+ (when (. rs (next))
+ (lazy-seq (cons (apply struct row-struct (row-values)) (thisfn)))))]
(rows)))
(defn iterator-seq
diff --git a/src/clj/clojure/main.clj b/src/clj/clojure/main.clj
index 633c21e9..8c2e9449 100644
--- a/src/clj/clojure/main.clj
+++ b/src/clj/clojure/main.clj
@@ -9,6 +9,7 @@
;; Originally contributed by Stephen C. Gilardi
(ns clojure.main
+ (:refer-clojure :exclude [with-bindings])
(:import (clojure.lang Compiler Compiler$CompilerException
LineNumberingPushbackReader RT)))
diff --git a/src/clj/clojure/test.clj b/src/clj/clojure/test.clj
index 5e432899..bdebc44a 100644
--- a/src/clj/clojure/test.clj
+++ b/src/clj/clojure/test.clj
@@ -797,14 +797,14 @@ Chas Emerick, Allen Rohner, and Stuart Halloway",
When *load-tests* is false, deftest is ignored."
[name & body]
(when *load-tests*
- `(def ~(with-meta name {:test `(fn [] ~@body)})
+ `(def ~(vary-meta name assoc :test `(fn [] ~@body))
(fn [] (test-var (var ~name))))))
(defmacro deftest-
"Like deftest but creates a private var."
[name & body]
(when *load-tests*
- `(def ~(with-meta name {:test `(fn [] ~@body), :private true})
+ `(def ~(vary-meta name assoc :test `(fn [] ~@body) :private true)
(fn [] (test-var (var ~name))))))
@@ -826,9 +826,13 @@ Chas Emerick, Allen Rohner, and Stuart Halloway",
"Adds elements in coll to the current namespace metadata as the
value of key."
[key coll]
- (alter-meta! *ns* assoc key (concat (key (meta *ns*)) coll)))
+ (alter-meta! *ns* assoc key coll))
-(defmulti use-fixtures (fn [fixture-type & args] fixture-type))
+(defmulti use-fixtures
+ "Wrap test runs in a fixture function to perform setup and
+ teardown. Using a fixture-type of :each wraps every test
+ individually, while:once wraps the whole run in a single function."
+ (fn [fixture-type & args] fixture-type))
(defmethod use-fixtures :each [fixture-type & args]
(add-ns-meta ::each-fixtures args))
diff --git a/src/clj/clojure/test/junit.clj b/src/clj/clojure/test/junit.clj
new file mode 100644
index 00000000..c42887eb
--- /dev/null
+++ b/src/clj/clojure/test/junit.clj
@@ -0,0 +1,193 @@
+; 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.
+
+;; test/junit.clj: Extension to clojure.test for JUnit-compatible XML output
+
+;; by Jason Sankey
+;; June 2009
+
+;; DOCUMENTATION
+;;
+;; This is an extension to clojure.test that adds support for
+;; JUnit-compatible XML output.
+;;
+;; JUnit (http://junit.org/) is the most popular unit-testing library
+;; for Java. As such, tool support for JUnit output formats is
+;; common. By producing compatible output from tests, this tool
+;; support can be exploited.
+;;
+;; To use, wrap any calls to clojure.test/run-tests in the
+;; with-junit-output macro, like this:
+;;
+;; (use 'clojure.test)
+;; (use 'clojure.contrib.test.junit)
+;;
+;; (with-junit-output
+;; (run-tests 'my.cool.library))
+;;
+;; To write the output to a file, rebind clojure.test/*test-out* to
+;; your own PrintWriter (perhaps opened using
+;; clojure.contrib.duck-streams/writer).
+
+(ns clojure.test.junit
+ (:require [clojure.stacktrace :as stack]
+ [clojure.test :as t]))
+
+;; copied from clojure.contrib.lazy-xml
+(def #^{:private true}
+ escape-xml-map
+ (zipmap "'<>\"&" (map #(str \& % \;) '[apos lt gt quot amp])))
+(defn- escape-xml [text]
+ (apply str (map #(escape-xml-map % %) text)))
+
+(def *var-context*)
+(def *depth*)
+
+(defn indent
+ []
+ (dotimes [n (* *depth* 4)] (print " ")))
+
+(defn start-element
+ [tag pretty & [attrs]]
+ (if pretty (indent))
+ (print (str "<" tag))
+ (if (seq attrs)
+ (doseq [[key value] attrs]
+ (print (str " " (name key) "=\"" (escape-xml value) "\""))))
+ (print ">")
+ (if pretty (println))
+ (set! *depth* (inc *depth*)))
+
+(defn element-content
+ [content]
+ (print (escape-xml content)))
+
+(defn finish-element
+ [tag pretty]
+ (set! *depth* (dec *depth*))
+ (if pretty (indent))
+ (print (str "</" tag ">"))
+ (if pretty (println)))
+
+(defn test-name
+ [vars]
+ (apply str (interpose "."
+ (reverse (map #(:name (meta %)) vars)))))
+
+(defn package-class
+ [name]
+ (let [i (.lastIndexOf name ".")]
+ (if (< i 0)
+ [nil name]
+ [(.substring name 0 i) (.substring name (+ i 1))])))
+
+(defn start-case
+ [name classname]
+ (start-element 'testcase true {:name name :classname classname}))
+
+(defn finish-case
+ []
+ (finish-element 'testcase true))
+
+(defn suite-attrs
+ [package classname]
+ (let [attrs {:name classname}]
+ (if package
+ (assoc attrs :package package)
+ attrs)))
+
+(defn start-suite
+ [name]
+ (let [[package classname] (package-class name)]
+ (start-element 'testsuite true (suite-attrs package classname))))
+
+(defn finish-suite
+ []
+ (finish-element 'testsuite true))
+
+(defn message-el
+ [tag message expected-str actual-str]
+ (indent)
+ (start-element tag false (if message {:message message} {}))
+ (element-content
+ (let [[file line] (t/file-position 5)
+ detail (apply str (interpose
+ "\n"
+ [(str "expected: " expected-str)
+ (str " actual: " actual-str)
+ (str " at: " file ":" line)]))]
+ (if message (str message "\n" detail) detail)))
+ (finish-element tag false)
+ (println))
+
+(defn failure-el
+ [message expected actual]
+ (message-el 'failure message (pr-str expected) (pr-str actual)))
+
+(defn error-el
+ [message expected actual]
+ (message-el 'error
+ message
+ (pr-str expected)
+ (if (instance? Throwable actual)
+ (with-out-str (stack/print-cause-trace actual t/*stack-trace-depth*))
+ (prn actual))))
+
+;; This multimethod will override test-is/report
+(defmulti junit-report :type)
+
+(defmethod junit-report :begin-test-ns [m]
+ (t/with-test-out
+ (start-suite (name (ns-name (:ns m))))))
+
+(defmethod junit-report :end-test-ns [_]
+ (t/with-test-out
+ (finish-suite)))
+
+(defmethod junit-report :begin-test-var [m]
+ (t/with-test-out
+ (let [var (:var m)]
+ (binding [*var-context* (conj *var-context* var)]
+ (start-case (test-name *var-context*) (name (ns-name (:ns (meta var)))))))))
+
+(defmethod junit-report :end-test-var [m]
+ (t/with-test-out
+ (finish-case)))
+
+(defmethod junit-report :pass [m]
+ (t/with-test-out
+ (t/inc-report-counter :pass)))
+
+(defmethod junit-report :fail [m]
+ (t/with-test-out
+ (t/inc-report-counter :fail)
+ (failure-el (:message m)
+ (:expected m)
+ (:actual m))))
+
+(defmethod junit-report :error [m]
+ (t/with-test-out
+ (t/inc-report-counter :error)
+ (error-el (:message m)
+ (:expected m)
+ (:actual m))))
+
+(defmethod junit-report :default [_])
+
+(defmacro with-junit-output
+ "Execute body with modified test-is reporting functions that write
+ JUnit-compatible XML output."
+ [& body]
+ `(binding [t/report junit-report
+ *var-context* (list)
+ *depth* 1]
+ (println "<?xml version=\"1.0\" encoding=\"UTF-8\"?>")
+ (println "<testsuites>")
+ (let [result# ~@body]
+ (println "</testsuites>")
+ result#)))
diff --git a/src/clj/clojure/zip.clj b/src/clj/clojure/zip.clj
index 00cc3be5..7423513f 100644
--- a/src/clj/clojure/zip.clj
+++ b/src/clj/clojure/zip.clj
@@ -66,7 +66,9 @@
(defn children
"Returns a seq of the children of node at loc, which must be a branch"
[loc]
- ((:zip/children ^loc) (node loc)))
+ (if (branch? loc)
+ ((:zip/children ^loc) (node loc))
+ (throw (Exception. "called children on a leaf node"))))
(defn make-node
"Returns a new branch node, given an existing node and new
@@ -94,13 +96,14 @@
"Returns the loc of the leftmost child of the node at this loc, or
nil if no children"
[loc]
- (let [[node path] loc
- [c & cnext :as cs] (children loc)]
- (when cs
- (with-meta [c {:l []
- :pnodes (if path (conj (:pnodes path) node) [node])
- :ppath path
- :r cnext}] ^loc))))
+ (when (branch? loc)
+ (let [[node path] loc
+ [c & cnext :as cs] (children loc)]
+ (when cs
+ (with-meta [c {:l []
+ :pnodes (if path (conj (:pnodes path) node) [node])
+ :ppath path
+ :r cnext}] ^loc)))))
(defn up
"Returns the loc of the parent of the node at this loc, or nil if at
diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java
index 060ce4d6..c9fd7acf 100644
--- a/src/jvm/clojure/lang/Compiler.java
+++ b/src/jvm/clojure/lang/Compiler.java
@@ -384,7 +384,7 @@ static class DefExpr implements Expr{
else if(RT.count(form) < 2)
throw new Exception("Too few arguments to def");
else if(!(RT.second(form) instanceof Symbol))
- throw new Exception("Second argument to def must be a Symbol");
+ throw new Exception("First argument to def must be a Symbol");
Symbol sym = (Symbol) RT.second(form);
Var v = lookupVar(sym, true);
if(v == null)
@@ -775,10 +775,11 @@ static public abstract class HostExpr implements Expr, MaybePrimitiveExpr{
if(maybeField) //field
{
Symbol sym = (Symbol) RT.third(form);
- if(c != null)
- return new StaticFieldExpr(line, c, sym.name);
- else
- return new InstanceFieldExpr(line, instance, sym.name);
+ Symbol tag = tagOf(form);
+ if(c != null) {
+ return new StaticFieldExpr(line, c, sym.name, tag);
+ } else
+ return new InstanceFieldExpr(line, instance, sym.name, tag);
}
else
{
@@ -786,13 +787,14 @@ static public abstract class HostExpr implements Expr, MaybePrimitiveExpr{
if(!(RT.first(call) instanceof Symbol))
throw new IllegalArgumentException("Malformed member expression");
Symbol sym = (Symbol) RT.first(call);
+ Symbol tag = tagOf(form);
PersistentVector args = PersistentVector.EMPTY;
for(ISeq s = RT.next(call); s != null; s = s.next())
args = args.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, s.first()));
if(c != null)
- return new StaticMethodExpr(source, line, c, sym.name, args);
+ return new StaticMethodExpr(source, line, tag, c, sym.name, args);
else
- return new InstanceMethodExpr(source, line, instance, sym.name, args);
+ return new InstanceMethodExpr(source, line, tag, instance, sym.name, args);
}
}
}
@@ -887,16 +889,18 @@ static class InstanceFieldExpr extends FieldExpr implements AssignableExpr{
public final java.lang.reflect.Field field;
public final String fieldName;
public final int line;
+ public final Symbol tag;
final static Method invokeNoArgInstanceMember = Method.getMethod("Object invokeNoArgInstanceMember(Object,String)");
final static Method setInstanceFieldMethod = Method.getMethod("Object setInstanceField(Object,String,Object)");
- public InstanceFieldExpr(int line, Expr target, String fieldName) throws Exception{
+ public InstanceFieldExpr(int line, Expr target, String fieldName, Symbol tag) throws Exception{
this.target = target;
this.targetClass = target.hasJavaClass() ? target.getJavaClass() : null;
this.field = targetClass != null ? Reflector.getField(targetClass, fieldName, false) : null;
this.fieldName = fieldName;
this.line = line;
+ this.tag = tag;
if(field == null && RT.booleanCast(RT.WARN_ON_REFLECTION.deref()))
{
((PrintWriter) RT.ERR.deref())
@@ -951,11 +955,11 @@ static class InstanceFieldExpr extends FieldExpr implements AssignableExpr{
}
public boolean hasJavaClass() throws Exception{
- return field != null;
+ return field != null || tag != null;
}
public Class getJavaClass() throws Exception{
- return field.getType();
+ return tag != null ? HostExpr.tagToClass(tag) : field.getType();
}
public Object evalAssign(Expr val) throws Exception{
@@ -991,17 +995,19 @@ static class StaticFieldExpr extends FieldExpr implements AssignableExpr{
public final String fieldName;
public final Class c;
public final java.lang.reflect.Field field;
+ public final Symbol tag;
// final static Method getStaticFieldMethod = Method.getMethod("Object getStaticField(String,String)");
// final static Method setStaticFieldMethod = Method.getMethod("Object setStaticField(String,String,Object)");
final int line;
- public StaticFieldExpr(int line, Class c, String fieldName) throws Exception{
+ public StaticFieldExpr(int line, Class c, String fieldName, Symbol tag) throws Exception{
//this.className = className;
this.fieldName = fieldName;
this.line = line;
//c = Class.forName(className);
this.c = c;
field = c.getField(fieldName);
+ this.tag = tag;
}
public Object eval() throws Exception{
@@ -1039,7 +1045,7 @@ static class StaticFieldExpr extends FieldExpr implements AssignableExpr{
public Class getJavaClass() throws Exception{
//Class c = Class.forName(className);
//java.lang.reflect.Field field = c.getField(fieldName);
- return field.getType();
+ return tag != null ? HostExpr.tagToClass(tag) : field.getType();
}
public Object evalAssign(Expr val) throws Exception{
@@ -1122,19 +1128,21 @@ static class InstanceMethodExpr extends MethodExpr{
public final IPersistentVector args;
public final String source;
public final int line;
+ public final Symbol tag;
public final java.lang.reflect.Method method;
final static Method invokeInstanceMethodMethod =
Method.getMethod("Object invokeInstanceMethod(Object,String,Object[])");
- public InstanceMethodExpr(String source, int line, Expr target, String methodName, IPersistentVector args)
+ public InstanceMethodExpr(String source, int line, Symbol tag, Expr target, String methodName, IPersistentVector args)
throws Exception{
this.source = source;
this.line = line;
this.args = args;
this.methodName = methodName;
this.target = target;
+ this.tag = tag;
if(target.hasJavaClass() && target.getJavaClass() != null)
{
List methods = Reflector.getMethods(target.getJavaClass(), args.count(), methodName, false);
@@ -1268,11 +1276,11 @@ static class InstanceMethodExpr extends MethodExpr{
}
public boolean hasJavaClass(){
- return method != null;
+ return method != null || tag != null;
}
public Class getJavaClass() throws Exception{
- return method.getReturnType();
+ return tag != null ? HostExpr.tagToClass(tag) : method.getReturnType();
}
}
@@ -1285,18 +1293,20 @@ static class StaticMethodExpr extends MethodExpr{
public final String source;
public final int line;
public final java.lang.reflect.Method method;
+ public final Symbol tag;
final static Method forNameMethod = Method.getMethod("Class forName(String)");
final static Method invokeStaticMethodMethod =
Method.getMethod("Object invokeStaticMethod(Class,String,Object[])");
- public StaticMethodExpr(String source, int line, Class c, String methodName, IPersistentVector args)
+ public StaticMethodExpr(String source, int line, Symbol tag, Class c, String methodName, IPersistentVector args)
throws Exception{
this.c = c;
this.methodName = methodName;
this.args = args;
this.source = source;
this.line = line;
+ this.tag = tag;
List methods = Reflector.getMethods(c, args.count(), methodName, true);
if(methods.isEmpty())
@@ -1405,11 +1415,11 @@ static class StaticMethodExpr extends MethodExpr{
}
public boolean hasJavaClass(){
- return method != null;
+ return method != null || tag != null;
}
public Class getJavaClass() throws Exception{
- return method.getReturnType();
+ return tag != null ? HostExpr.tagToClass(tag) : method.getReturnType();
}
}
@@ -4932,6 +4942,15 @@ public static boolean namesStaticMember(Symbol sym){
return sym.ns != null && namespaceFor(sym) == null;
}
+public static Object preserveTag(ISeq src, Object dst) {
+ Symbol tag = tagOf(src);
+ if (tag != null && dst instanceof IObj) {
+ IPersistentMap meta = RT.meta(dst);
+ return ((IObj) dst).withMeta((IPersistentMap) RT.assoc(meta, RT.TAG_KEY, tag));
+ }
+ return dst;
+}
+
public static Object macroexpand1(Object x) throws Exception{
if(x instanceof ISeq)
{
@@ -4971,7 +4990,7 @@ public static Object macroexpand1(Object x) throws Exception{
{
target = ((IObj)RT.list(IDENTITY, target)).withMeta(RT.map(RT.TAG_KEY,CLASS));
}
- return RT.listStar(DOT, target, meth, form.next().next());
+ return preserveTag(form, RT.listStar(DOT, target, meth, form.next().next()));
}
else if(namesStaticMember(sym))
{
@@ -4980,7 +4999,7 @@ public static Object macroexpand1(Object x) throws Exception{
if(c != null)
{
Symbol meth = Symbol.intern(sym.name);
- return RT.listStar(DOT, target, meth, form.next());
+ return preserveTag(form, RT.listStar(DOT, target, meth, form.next()));
}
}
else
@@ -5029,7 +5048,7 @@ private static Expr analyzeSeq(C context, ISeq form, String name) throws Excepti
throw new IllegalArgumentException("Can't call nil");
IFn inline = isInline(op, RT.count(RT.next(form)));
if(inline != null)
- return analyze(context, inline.applyTo(RT.next(form)));
+ return analyze(context, preserveTag(form, inline.applyTo(RT.next(form))));
IParser p;
if(op.equals(FN))
return FnExpr.parse(context, form, name);
@@ -5191,7 +5210,7 @@ private static Expr analyzeSymbol(Symbol sym) throws Exception{
if(c != null)
{
if(Reflector.getField(c, sym.name, true) != null)
- return new StaticFieldExpr((Integer) LINE.deref(), c, sym.name);
+ return new StaticFieldExpr((Integer) LINE.deref(), c, sym.name, tag);
throw new Exception("Unable to find static field: " + sym.name + " in " + c);
}
}
diff --git a/src/jvm/clojure/lang/Numbers.java b/src/jvm/clojure/lang/Numbers.java
index 8d5fd855..04002085 100644
--- a/src/jvm/clojure/lang/Numbers.java
+++ b/src/jvm/clojure/lang/Numbers.java
@@ -1537,6 +1537,146 @@ static public long[] long_array(Object sizeOrSeq){
}
}
+static public short[] short_array(int size, Object init){
+ short[] ret = new short[size];
+ if(init instanceof Short)
+ {
+ short s = (Short) init;
+ for(int i = 0; i < ret.length; i++)
+ ret[i] = s;
+ }
+ else
+ {
+ ISeq s = RT.seq(init);
+ for(int i = 0; i < size && s != null; i++, s = s.next())
+ ret[i] = (Short) s.first();
+ }
+ return ret;
+}
+
+static public short[] short_array(Object sizeOrSeq){
+ if(sizeOrSeq instanceof Number)
+ return new short[((Number) sizeOrSeq).intValue()];
+ else
+ {
+ ISeq s = RT.seq(sizeOrSeq);
+ int size = RT.count(s);
+ short[] ret = new short[size];
+ for(int i = 0; i < size && s != null; i++, s = s.next())
+ ret[i] = (Short) s.first();
+ return ret;
+ }
+}
+
+static public char[] char_array(int size, Object init){
+ char[] ret = new char[size];
+ if(init instanceof Character)
+ {
+ char c = (Character) init;
+ for(int i = 0; i < ret.length; i++)
+ ret[i] = c;
+ }
+ else
+ {
+ ISeq s = RT.seq(init);
+ for(int i = 0; i < size && s != null; i++, s = s.next())
+ ret[i] = (Character) s.first();
+ }
+ return ret;
+}
+
+static public char[] char_array(Object sizeOrSeq){
+ if(sizeOrSeq instanceof Number)
+ return new char[((Number) sizeOrSeq).intValue()];
+ else
+ {
+ ISeq s = RT.seq(sizeOrSeq);
+ int size = RT.count(s);
+ char[] ret = new char[size];
+ for(int i = 0; i < size && s != null; i++, s = s.next())
+ ret[i] = (Character) s.first();
+ return ret;
+ }
+}
+
+static public byte[] byte_array(int size, Object init){
+ byte[] ret = new byte[size];
+ if(init instanceof Byte)
+ {
+ byte b = (Byte) init;
+ for(int i = 0; i < ret.length; i++)
+ ret[i] = b;
+ }
+ else
+ {
+ ISeq s = RT.seq(init);
+ for(int i = 0; i < size && s != null; i++, s = s.next())
+ ret[i] = (Byte) s.first();
+ }
+ return ret;
+}
+
+static public byte[] byte_array(Object sizeOrSeq){
+ if(sizeOrSeq instanceof Number)
+ return new byte[((Number) sizeOrSeq).intValue()];
+ else
+ {
+ ISeq s = RT.seq(sizeOrSeq);
+ int size = RT.count(s);
+ byte[] ret = new byte[size];
+ for(int i = 0; i < size && s != null; i++, s = s.next())
+ ret[i] = (Byte)s.first();
+ return ret;
+ }
+}
+
+static public boolean[] boolean_array(int size, Object init){
+ boolean[] ret = new boolean[size];
+ if(init instanceof Boolean)
+ {
+ boolean b = (Boolean) init;
+ for(int i = 0; i < ret.length; i++)
+ ret[i] = b;
+ }
+ else
+ {
+ ISeq s = RT.seq(init);
+ for(int i = 0; i < size && s != null; i++, s = s.next())
+ ret[i] = (Boolean)s.first();
+ }
+ return ret;
+}
+
+static public boolean[] boolean_array(Object sizeOrSeq){
+ if(sizeOrSeq instanceof Number)
+ return new boolean[((Number) sizeOrSeq).intValue()];
+ else
+ {
+ ISeq s = RT.seq(sizeOrSeq);
+ int size = RT.count(s);
+ boolean[] ret = new boolean[size];
+ for(int i = 0; i < size && s != null; i++, s = s.next())
+ ret[i] = (Boolean)s.first();
+ return ret;
+ }
+}
+
+static public boolean[] booleans(Object array){
+ return (boolean[]) array;
+}
+
+static public byte[] bytes(Object array){
+ return (byte[]) array;
+}
+
+static public char[] chars(Object array){
+ return (char[]) array;
+}
+
+static public short[] shorts(Object array){
+ return (short[]) array;
+}
+
static public float[] floats(Object array){
return (float[]) array;
}
diff --git a/src/jvm/clojure/lang/PersistentTreeSet.java b/src/jvm/clojure/lang/PersistentTreeSet.java
index f6f50125..e7e625de 100644
--- a/src/jvm/clojure/lang/PersistentTreeSet.java
+++ b/src/jvm/clojure/lang/PersistentTreeSet.java
@@ -27,6 +27,15 @@ public static PersistentTreeSet create(Object... init){
return ret;
}
+public static PersistentTreeSet create(Comparator comp, Object... init){
+ PersistentTreeSet ret = new PersistentTreeSet(null, new PersistentTreeMap(null, comp));
+ for(int i = 0; i < init.length; i++)
+ {
+ ret = (PersistentTreeSet) ret.cons(init[i]);
+ }
+ return ret;
+}
+
public static PersistentTreeSet create(List init){
PersistentTreeSet ret = EMPTY;
for(Object key : init)
@@ -36,6 +45,15 @@ public static PersistentTreeSet create(List init){
return ret;
}
+public static PersistentTreeSet create(Comparator comp, List init){
+ PersistentTreeSet ret = new PersistentTreeSet(null, new PersistentTreeMap(null, comp));
+ for(Object key : init)
+ {
+ ret = (PersistentTreeSet) ret.cons(key);
+ }
+ return ret;
+}
+
static public PersistentTreeSet create(ISeq items){
PersistentTreeSet ret = EMPTY;
for(; items != null; items = items.next())
@@ -45,6 +63,15 @@ static public PersistentTreeSet create(ISeq items){
return ret;
}
+static public PersistentTreeSet create(Comparator comp, ISeq items){
+ PersistentTreeSet ret = new PersistentTreeSet(null, new PersistentTreeMap(null, comp));
+ for(; items != null; items = items.next())
+ {
+ ret = (PersistentTreeSet) ret.cons(items.first());
+ }
+ return ret;
+}
+
PersistentTreeSet(IPersistentMap meta, IPersistentMap impl){
super(meta, impl);
}
generated by cgit v1.2.3-18-g5258 (git 2.32.0) at 2025-07-14 20:53:38 +0000