diff options
author | Rich Hickey <richhickey@gmail.com> | 2008-11-12 20:59:16 +0000 |
---|---|---|
committer | Rich Hickey <richhickey@gmail.com> | 2008-11-12 20:59:16 +0000 |
commit | a25af8d4b183e0bd3220e155e41efc4baa991922 (patch) | |
tree | acdc0626c3db3b79d1ab1557993e232db7e094b7 | |
parent | 240969a3af34ff0661238d03c006cc5a74dc1698 (diff) |
AOT compiler support
breaking change to load - no longer takes extension
load will load from classfile if newer than source
to compile, source dir and compile dir must be in classpath
(compile 'my.cool.ns)
will compile my/cool/ns.clj and anything it loads directly or indirectly
-rw-r--r-- | src/clj/clojure/core-print.clj | 318 | ||||
-rw-r--r-- | src/clj/clojure/core-proxy.clj | 309 | ||||
-rw-r--r-- | src/clj/clojure/core.clj | 626 | ||||
-rw-r--r-- | src/jvm/clojure/lang/Compiler.java | 3 | ||||
-rw-r--r-- | src/jvm/clojure/lang/RT.java | 60 |
5 files changed, 680 insertions, 636 deletions
diff --git a/src/clj/clojure/core-print.clj b/src/clj/clojure/core-print.clj new file mode 100644 index 00000000..b325d81e --- /dev/null +++ b/src/clj/clojure/core-print.clj @@ -0,0 +1,318 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Common Public License 1.0 (http://opensource.org/licenses/cpl.php) +; which can be found in the file CPL.TXT 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. + +(in-ns 'clojure.core) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; printing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(import '(java.io Writer)) + +(def + #^{:doc "*print-length* controls how many items of each collection the + printer will print. If it is bound to logical false, there is no + limit. Otherwise, it must be bound to an integer indicating the maximum + number of items of each collection to print. If a collection contains + more items, the printer will print items up to the limit followed by + '...' to represent the remaining items. The root binding is nil + indicating no limit."} + *print-length* nil) + +(def + #^{:doc "*print-level* controls how many levels deep the printer will + print nested objects. If it is bound to logical false, there is no + limit. Otherwise, it must be bound to an integer indicating the maximum + level to print. Each argument to print is at level 0; if an argument is a + collection, its items are at level 1; and so on. If an object is a + collection and is at a level greater than or equal to the value bound to + *print-level*, the printer prints '#' to represent it. The root binding + is nil indicating no limit."} +*print-level* nil) + +(defn- print-sequential [#^String begin, print-one, #^String sep, #^String end, sequence, #^Writer w] + (binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))] + (if (and *print-level* (neg? *print-level*)) + (.write w "#") + (do + (.write w begin) + (when-let [xs (seq sequence)] + (if (and (not *print-dup*) *print-length*) + (loop [[x & xs] xs + print-length *print-length*] + (if (zero? print-length) + (.write w "...") + (do + (print-one x w) + (when xs + (.write w sep) + (recur xs (dec print-length)))))) + (loop [[x & xs] xs] + (print-one x w) + (when xs + (.write w sep) + (recur xs))))) + (.write w end))))) + +(defn- print-meta [o, #^Writer w] + (when-let [m (meta o)] + (when (and (pos? (count m)) + (or *print-dup* + (and *print-meta* *print-readably*))) + (.write w "#^") + (if (and (= (count m) 1) (:tag m)) + (pr-on (:tag m) w) + (pr-on m w)) + (.write w " ")))) + +(defmethod print-method nil [o, #^Writer w] + (.write w "nil")) + +(defmethod print-dup nil [o w] (print-method o w)) + +(defn print-ctor [o print-args #^Writer w] + (.write w "#=(") + (.write w (.getName #^Class (class o))) + (.write w ". ") + (print-args o w) + (.write w ")")) + +(defmethod print-method :default [o, #^Writer w] + (.write w "#<") + (.write w (.getSimpleName (class o))) + (.write w " ") + (.write w (str o)) + (.write w ">")) + +(defmethod print-method clojure.lang.Keyword [o, #^Writer w] + (.write w (str o))) + +(defmethod print-dup clojure.lang.Keyword [o w] (print-method o w)) + +(defmethod print-method Number [o, #^Writer w] + (.write w (str o))) + +(defmethod print-dup Number [o, #^Writer w] + (print-ctor o + (fn [o w] + (print-dup (str o) w)) + w)) + +(defmethod print-dup clojure.lang.AFn [o, #^Writer w] + (print-ctor o (fn [o w]) w)) + +(prefer-method print-dup clojure.lang.IPersistentCollection clojure.lang.AFn) +(prefer-method print-dup java.util.Map clojure.lang.AFn) +(prefer-method print-dup java.util.Collection clojure.lang.AFn) + +(defmethod print-method Boolean [o, #^Writer w] + (.write w (str o))) + +(defmethod print-dup Boolean [o w] (print-method o w)) + +(defn print-simple [o, #^Writer w] + (print-meta o w) + (.write w (str o))) + +(defmethod print-method clojure.lang.Symbol [o, #^Writer w] + (print-simple o w)) + +(defmethod print-dup clojure.lang.Symbol [o w] (print-method o w)) + +(defmethod print-method clojure.lang.Var [o, #^Writer w] + (print-simple o w)) + +(defmethod print-dup clojure.lang.Var [#^clojure.lang.Var o, #^Writer w] + (.write w (str "#=(var " (.name (.ns o)) "/" (.sym o) ")"))) + +(defmethod print-method clojure.lang.ISeq [o, #^Writer w] + (print-meta o w) + (print-sequential "(" pr-on " " ")" o w)) + +(defmethod print-dup clojure.lang.ISeq [o w] (print-method o w)) + +(defmethod print-method clojure.lang.IPersistentList [o, #^Writer w] + (print-meta o w) + (print-sequential "(" print-method " " ")" o w)) + +(prefer-method print-method clojure.lang.IPersistentList clojure.lang.ISeq) + +(defmethod print-method java.util.Collection [o, #^Writer w] + (print-ctor o #(print-sequential "[" print-method " " "]" %1 %2) w)) + +(prefer-method print-method clojure.lang.IPersistentCollection java.util.Collection) + +(defmethod print-dup java.util.Collection [o, #^Writer w] + (print-ctor o #(print-sequential "[" print-dup " " "]" %1 %2) w)) + +(defmethod print-dup clojure.lang.IPersistentCollection [o, #^Writer w] + (print-meta o w) + (.write w "#=(") + (.write w (.getName #^Class (class o))) + (.write w "/create ") + (print-sequential "[" print-dup " " "]" o w) + (.write w ")")) + +(prefer-method print-dup clojure.lang.IPersistentCollection java.util.Collection) + +(def #^{:tag String + :doc "Returns escape string for char or nil if none"} + char-escape-string + {\newline "\\n" + \tab "\\t" + \return "\\r" + \" "\\\"" + \\ "\\\\" + \formfeed "\\f" + \backspace "\\b"}) + +(defmethod print-method String [#^String s, #^Writer w] + (if (or *print-dup* *print-readably*) + (do (.append w \") + (dotimes [n (count s)] + (let [c (.charAt s n) + e (char-escape-string c)] + (if e (.write w e) (.append w c)))) + (.append w \")) + (.write w s)) + nil) + +(defmethod print-dup String [s w] (print-method s w)) + +(defmethod print-method clojure.lang.IPersistentVector [v, #^Writer w] + (print-meta v w) + (print-sequential "[" pr-on " " "]" v w)) + +(defn- print-map [m print-one w] + (print-sequential + "{" + (fn [e #^Writer w] + (do (print-one (key e) w) (.append w \space) (print-one (val e) w))) + ", " + "}" + (seq m) w)) + +(defmethod print-method clojure.lang.IPersistentMap [m, #^Writer w] + (print-meta m w) + (print-map m pr-on w)) + +(defmethod print-method java.util.Map [m, #^Writer w] + (print-ctor m #(print-map (seq %1) print-method %2) w)) + +(prefer-method print-method clojure.lang.IPersistentMap java.util.Map) + +(defmethod print-dup java.util.Map [m, #^Writer w] + (print-ctor m #(print-map (seq %1) print-dup %2) w)) + +(defmethod print-dup clojure.lang.IPersistentMap [m, #^Writer w] + (print-meta m w) + (.write w "#=(") + (.write w (.getName (class m))) + (.write w "/create ") + (print-map m print-dup w) + (.write w ")")) + +(prefer-method print-dup clojure.lang.IPersistentCollection java.util.Map) + +(defmethod print-method clojure.lang.IPersistentSet [s, #^Writer w] + (print-meta s w) + (print-sequential "#{" pr-on " " "}" (seq s) w)) + +(defmethod print-method java.util.Set [s, #^Writer w] + (print-ctor s + #(print-sequential "#{" print-method " " "}" (seq %1) %2) + w)) + +;(prefer-method print-method clojure.lang.IPersistentSet java.util.Set) + +(def #^{:tag String + :doc "Returns name string for char or nil if none"} + char-name-string + {\newline "newline" + \tab "tab" + \space "space" + \backspace "backspace" + \formfeed "formfeed" + \return "return"}) + +(defmethod print-method java.lang.Character [#^Character c, #^Writer w] + (if (or *print-dup* *print-readably*) + (do (.append w \\) + (let [n (char-name-string c)] + (if n (.write w n) (.append w c)))) + (.append w c)) + nil) + +(defmethod print-dup java.lang.Character [c w] (print-method c w)) +(defmethod print-dup java.lang.Integer [o w] (print-method o w)) +(defmethod print-dup java.lang.Double [o w] (print-method o w)) +(defmethod print-dup clojure.lang.Ratio [o w] (print-method o w)) +(defmethod print-dup java.math.BigDecimal [o w] (print-method o w)) +(defmethod print-dup clojure.lang.PersistentHashMap [o w] (print-method o w)) +(defmethod print-dup clojure.lang.PersistentHashSet [o w] (print-method o w)) +(defmethod print-dup clojure.lang.PersistentVector [o w] (print-method o w)) + +(def primitives-classnames + {Float/TYPE "Float/TYPE" + Integer/TYPE "Integer/TYPE" + Long/TYPE "Long/TYPE" + Boolean/TYPE "Boolean/TYPE" + Character/TYPE "Character/TYPE" + Double/TYPE "Double/TYPE" + Byte/TYPE "Byte/TYPE" + Short/TYPE "Short/TYPE"}) + +(defmethod print-method Class [#^Class c, #^Writer w] + (.write w (.getName c))) + +(defmethod print-dup Class [#^Class c, #^Writer w] + (cond + (.isPrimitive c) (do + (.write w "#=(identity ") + (.write w #^String (primitives-classnames c)) + (.write w ")")) + (.isArray c) (do + (.write w "#=(java.lang.Class/forName \"") + (.write w (.getName c)) + (.write w "\")")) + :else (do + (.write w "#=") + (.write w (.getName c))))) + +(defmethod print-method java.math.BigDecimal [b, #^Writer w] + (.write w (str b)) + (.write w "M")) + +(defmethod print-method java.util.regex.Pattern [p #^Writer w] + (.write w "#\"") + (loop [[#^Character c & r :as s] (seq (.pattern #^java.util.regex.Pattern p)) + qmode false] + (when s + (cond + (= c \\) (let [[#^Character c2 & r2] r] + (.append w \\) + (.append w c2) + (if qmode + (recur r2 (not= c2 \E)) + (recur r2 (= c2 \Q)))) + (= c \") (do + (if qmode + (.write w "\\E\\\"\\Q") + (.write w "\\\"")) + (recur r qmode)) + :else (do + (.append w c) + (recur r qmode))))) + (.append w \")) + +(defmethod print-dup java.util.regex.Pattern [p #^Writer w] (print-method p w)) + +(defmethod print-dup clojure.lang.Namespace [#^clojure.lang.Namespace n #^Writer w] + (.write w "#=(find-ns ") + (print-dup (.name n) w) + (.write w ")")) + +(def #^{:private true} print-initialized true)
\ No newline at end of file diff --git a/src/clj/clojure/core-proxy.clj b/src/clj/clojure/core-proxy.clj new file mode 100644 index 00000000..576fd4dd --- /dev/null +++ b/src/clj/clojure/core-proxy.clj @@ -0,0 +1,309 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Common Public License 1.0 (http://opensource.org/licenses/cpl.php) +; which can be found in the file CPL.TXT 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. + +(in-ns 'clojure.core) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; proxy ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(import + '(clojure.asm ClassWriter ClassVisitor Opcodes Type) + '(java.lang.reflect Modifier Constructor) + '(clojure.asm.commons Method GeneratorAdapter) + '(clojure.lang IProxy Reflector DynamicClassLoader IPersistentMap PersistentHashMap RT)) + +(def *proxy-classes* (ref {})) + +(defn method-sig [#^java.lang.reflect.Method meth] + [(. meth (getName)) (seq (. meth (getParameterTypes))) (. meth getReturnType)]) + +(defn get-proxy-class + "Takes an optional single class followed by zero or more + interfaces. If not supplied class defaults to Object. Creates an + returns an instance of a proxy class derived from the supplied + classes. The resulting value is cached and used for any subsequent + requests for the same class set. Returns a Class object." + [& bases] + (let [bases (if (. (first bases) (isInterface)) + (cons Object bases) + bases) + [super & interfaces] bases] + (or (get @*proxy-classes* bases) + (let [cv (new ClassWriter (. ClassWriter COMPUTE_MAXS)) + cname (str "clojure/lang/" (gensym "Proxy__")) + ctype (. Type (getObjectType cname)) + iname (fn [c] (.. Type (getType c) (getInternalName))) + fmap "__clojureFnMap" + totype (fn [c] (. Type (getType c))) + to-types (fn [cs] (if (pos? (count cs)) + (into-array (map totype cs)) + (make-array Type 0))) + super-type (totype super) + map-type (totype PersistentHashMap) + ifn-type (totype clojure.lang.IFn) + obj-type (totype Object) + sym-type (totype clojure.lang.Symbol) + rt-type (totype clojure.lang.RT) + ex-type (totype java.lang.UnsupportedOperationException) + gen-method + (fn [#^java.lang.reflect.Method meth else-gen] + (let [pclasses (. meth (getParameterTypes)) + ptypes (to-types pclasses) + rtype (totype (. meth (getReturnType))) + m (new Method (. meth (getName)) rtype ptypes) + gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv) + else-label (. gen (newLabel)) + end-label (. gen (newLabel)) + decl-type (. Type (getType (. meth (getDeclaringClass))))] + (. gen (visitCode)) + (. gen (loadThis)) + (. gen (getField ctype fmap map-type)) + ;get symbol corresponding to name + (. gen (push (. meth (getName)))) + (. gen (invokeStatic sym-type (. Method (getMethod "clojure.lang.Symbol create(String)")))) + ;lookup fn in map + (. gen (invokeStatic rt-type (. Method (getMethod "Object get(Object, Object)")))) + (. gen (dup)) + (. gen (ifNull else-label)) + ;if found + (. gen (loadThis)) + ;box args + (dotimes [i (count ptypes)] + (. gen (loadArg i)) + (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i)))) + ;call fn + (. gen (invokeInterface ifn-type (new Method "invoke" obj-type + (into-array (cons obj-type + (replicate (count ptypes) obj-type)))))) + ;unbox return + (. gen (unbox rtype)) + (when (= (. rtype (getSort)) (. Type VOID)) + (. gen (pop))) + (. gen (goTo end-label)) + + ;else call supplied alternative generator + (. gen (mark else-label)) + (. gen (pop)) + + (else-gen gen m) + + (. gen (mark end-label)) + (. gen (returnValue)) + (. gen (endMethod))))] + + ;start class definition + (. cv (visit (. Opcodes V1_5) (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_SUPER)) + cname nil (iname super) + (into-array (map iname (cons IProxy interfaces))))) + ;add field for fn mappings + (. cv (visitField (+ (. Opcodes ACC_PRIVATE) (. Opcodes ACC_VOLATILE)) + fmap (. map-type (getDescriptor)) nil nil)) + ;add ctors matching/calling super's + (doseq [#^Constructor ctor (. super (getDeclaredConstructors))] + (when-not (. Modifier (isPrivate (. ctor (getModifiers)))) + (let [ptypes (to-types (. ctor (getParameterTypes))) + m (new Method "<init>" (. Type VOID_TYPE) ptypes) + gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] + (. gen (visitCode)) + ;call super ctor + (. gen (loadThis)) + (. gen (dup)) + (. gen (loadArgs)) + (. gen (invokeConstructor super-type m)) + ;init fmap + (. gen (getStatic map-type "EMPTY" map-type)) + (. gen (putField ctype fmap map-type)) + + (. gen (returnValue)) + (. gen (endMethod))))) + ;add IProxy methods + (let [m (. Method (getMethod "void __updateClojureFnMappings(clojure.lang.IPersistentMap)")) + gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] + (. gen (visitCode)) + (. gen (loadThis)) + (. gen (dup)) + (. gen (getField ctype fmap map-type)) + (. gen (loadArgs)) + (. gen (invokeInterface (totype clojure.lang.IPersistentCollection) + (. Method (getMethod "clojure.lang.IPersistentCollection cons(Object)")))) + (. gen (checkCast map-type)) + (. gen (putField ctype fmap map-type)) + + (. gen (returnValue)) + (. gen (endMethod))) + (let [m (. Method (getMethod "clojure.lang.IPersistentMap __getClojureFnMappings()")) + gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] + (. gen (visitCode)) + (. gen (loadThis)) + (. gen (getField ctype fmap map-type)) + (. gen (returnValue)) + (. gen (endMethod))) + + ;calc set of supers' non-private instance methods + (let [mm (loop [mm {} considered #{} c super] + (if c + (let [[mm considered] + (loop [mm mm + considered considered + meths (concat + (seq (. c (getDeclaredMethods))) + (seq (. c (getMethods))))] + (if meths + (let [#^java.lang.reflect.Method meth (first meths) + mods (. meth (getModifiers)) + mk (method-sig meth)] + (if (or (considered mk) + (. Modifier (isPrivate mods)) + (. Modifier (isStatic mods)) + (. Modifier (isFinal mods)) + (= "finalize" (.getName meth))) + (recur mm (conj considered mk) (rest meths)) + (recur (assoc mm mk meth) (conj considered mk) (rest meths)))) + [mm considered]))] + (recur mm considered (. c (getSuperclass)))) + mm))] + ;add methods matching supers', if no mapping -> call super + (doseq [#^java.lang.reflect.Method meth (vals mm)] + (gen-method meth + (fn [gen m] + (. gen (loadThis)) + ;push args + (. gen (loadArgs)) + ;call super + (. gen (visitMethodInsn (. Opcodes INVOKESPECIAL) + (. super-type (getInternalName)) + (. m (getName)) + (. m (getDescriptor))))))) + + ;add methods matching interfaces', if no mapping -> throw + (doseq [#^Class iface interfaces] + (doseq [#^java.lang.reflect.Method meth (. iface (getMethods))] + (when-not (contains? mm (method-sig meth)) + (gen-method meth + (fn [gen m] + (. gen (throwException ex-type (. m (getName)))))))))) + + ;finish class def + (. cv (visitEnd)) + ;generate, cache and return class object + (let [loader (. RT ROOT_CLASSLOADER) + c (. loader (defineClass (. cname (replace "/" ".")) + (. cv (toByteArray))))] + (sync nil (commute *proxy-classes* assoc bases c)) + c))))) + +(defn construct-proxy + "Takes a proxy class and any arguments for its superclass ctor and + creates and returns an instance of the proxy." + [c & ctor-args] + (. Reflector (invokeConstructor c (to-array ctor-args)))) + +(defn update-proxy + "Takes a proxy instance and a map of symbols (whose names must + correspond to methods of the proxy superclass/superinterfaces) to + fns (which must take arguments matching the corresponding method, + plus an additional (explicit) first arg corresponding to this, and + updates (via assoc) the proxy's fn map. nil can be passed instead of + a fn, in which case the corresponding method will revert to the + default behavior. Note that this function can be used to update the + behavior of an existing instance without changing its identity." + [#^IProxy proxy mappings] + (. proxy (__updateClojureFnMappings mappings))) + +(defn proxy-mappings + "Takes a proxy instance and returns the proxy's fn map." + [#^IProxy proxy] + (. proxy (__getClojureFnMappings))) + +(defmacro proxy + "class-and-interfaces - a vector of class names + + args - a (possibly empty) vector of arguments to the superclass + constructor. + + f => (name [params*] body) or + (name ([params*] body) ([params+] body) ...) + + Expands to code which creates a instance of a proxy class that + implements the named class/interface(s) by calling the supplied + fns. A single class, if provided, must be first. If not provided it + 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 + 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 + which proxy is called. Each method fn takes an additional implicit + first arg, which is bound to 'this. Note that while method fns can + be provided to override protected methods, they have no other access + to protected members, nor to super, as these capabilities cannot be + proxied." + [class-and-interfaces args & fs] + `(let [pc# (get-proxy-class ~@class-and-interfaces) + p# (construct-proxy pc# ~@args)] + (update-proxy p# + ~(loop [fmap {} fs fs] + (if fs + (let [[sym & meths] (first fs) + meths (if (vector? (first meths)) + (list meths) + meths) + meths (map (fn [[params & body]] + (cons (apply vector 'this params) body)) + meths)] + (recur (assoc fmap (list `quote (symbol (name sym))) (cons `fn meths)) (rest fs))) + fmap))) + p#)) + +(defn proxy-call-with-super [call this meth] + (let [m (proxy-mappings this)] + (update-proxy this (assoc m meth nil)) + (let [ret (call)] + (update-proxy this m) + ret))) + +(defmacro proxy-super + "Use to call a superclass method in the body of a proxy method. + Note, expansion captures 'this" + [meth & args] + `(proxy-call-with-super (fn [] (. ~'this ~meth ~@args)) ~'this '~(symbol (name meth)))) + +(defn bean + "Takes a Java object and returns a read-only implementation of the + map abstraction based upon its JavaBean properties." + [#^Object x] + (let [c (. x (getClass)) + pmap (reduce (fn [m #^java.beans.PropertyDescriptor pd] + (let [name (. pd (getName)) + method (. pd (getReadMethod))] + (if (and method (zero? (alength (. method (getParameterTypes))))) + (assoc m (keyword name) (fn [] (. method (invoke x nil)))) + m))) + {} + (seq (.. java.beans.Introspector + (getBeanInfo c) + (getPropertyDescriptors)))) + v (fn [k] ((pmap k))) + snapshot (fn [] + (reduce (fn [m e] + (assoc m (key e) ((val e)))) + {} (seq pmap)))] + (proxy [clojure.lang.APersistentMap] + [] + (containsKey [k] (contains? pmap k)) + (entryAt [k] (when (contains? pmap k) (new clojure.lang.MapEntry k (v k)))) + (valAt ([k] (v k)) + ([k default] (if (contains? pmap k) (v k) default))) + (cons [m] (conj (snapshot) m)) + (count [] (count pmap)) + (assoc [k v] (assoc (snapshot) k v)) + (without [k] (dissoc (snapshot) k)) + (seq [] ((fn thisfn [pseq] + (when pseq + (lazy-cons (new clojure.lang.MapEntry (first pseq) (v (first pseq))) + (thisfn (rest pseq))))) (keys pmap))))))
\ No newline at end of file diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 1c46d70c..caf8ddb1 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -3163,7 +3163,7 @@ (cons x coll) (concat x coll))) -(defn- root-directory +(defn- root-resource "Returns the root directory path for a lib" [lib] (str \/ @@ -3171,13 +3171,11 @@ (replace \- \_) (replace \. \/)))) -(defn- root-resource +(defn- root-directory "Returns the root resource path for a lib" [lib] - (let [d (root-directory lib) - i (inc (.lastIndexOf d (int \/))) - leaf (.substring d i)] - (str d \/ leaf ".clj"))) + (let [d (root-resource lib)] + (subs d 0 (.lastIndexOf d "/")))) (def load) @@ -3340,7 +3338,11 @@ "cannot load '%s' again while it is loading" path) (binding [*pending-paths* (conj *pending-paths* path)] - (.loadResourceScript clojure.lang.RT (.substring path 1)))))) + (clojure.lang.RT/load (.substring path 1)))))) + +(defn compile [lib] + (binding [*compile-files* true] + (load-one lib true true))) ;;;;;;;;;;;;; nested associative ops ;;;;;;;;;;; @@ -3482,615 +3484,15 @@ "defs the supplied var names with no bindings, useful for making forward declarations." [& names] `(do ~@(map #(list 'def %) names))) -(defn compile [libsym] - (clojure.lang.RT/compileLib (str libsym))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; printing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(import '(java.io Writer)) -(def - #^{:doc "*print-length* controls how many items of each collection the - printer will print. If it is bound to logical false, there is no - limit. Otherwise, it must be bound to an integer indicating the maximum - number of items of each collection to print. If a collection contains - more items, the printer will print items up to the limit followed by - '...' to represent the remaining items. The root binding is nil - indicating no limit."} - *print-length* nil) -(def - #^{:doc "*print-level* controls how many levels deep the printer will - print nested objects. If it is bound to logical false, there is no - limit. Otherwise, it must be bound to an integer indicating the maximum - level to print. Each argument to print is at level 0; if an argument is a - collection, its items are at level 1; and so on. If an object is a - collection and is at a level greater than or equal to the value bound to - *print-level*, the printer prints '#' to represent it. The root binding - is nil indicating no limit."} -*print-level* nil) - -(defn- print-sequential [#^String begin, print-one, #^String sep, #^String end, sequence, #^Writer w] - (binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))] - (if (and *print-level* (neg? *print-level*)) - (.write w "#") - (do - (.write w begin) - (when-let [xs (seq sequence)] - (if (and (not *print-dup*) *print-length*) - (loop [[x & xs] xs - print-length *print-length*] - (if (zero? print-length) - (.write w "...") - (do - (print-one x w) - (when xs - (.write w sep) - (recur xs (dec print-length)))))) - (loop [[x & xs] xs] - (print-one x w) - (when xs - (.write w sep) - (recur xs))))) - (.write w end))))) - -(defn- print-meta [o, #^Writer w] - (when-let [m (meta o)] - (when (and (pos? (count m)) - (or *print-dup* - (and *print-meta* *print-readably*))) - (.write w "#^") - (if (and (= (count m) 1) (:tag m)) - (pr-on (:tag m) w) - (pr-on m w)) - (.write w " ")))) - -(defmethod print-method nil [o, #^Writer w] - (.write w "nil")) - -(defmethod print-dup nil [o w] (print-method o w)) - -(defn print-ctor [o print-args #^Writer w] - (.write w "#=(") - (.write w (.getName #^Class (class o))) - (.write w ". ") - (print-args o w) - (.write w ")")) - -(defmethod print-method :default [o, #^Writer w] - (.write w "#<") - (.write w (.getSimpleName (class o))) - (.write w " ") - (.write w (str o)) - (.write w ">")) - -(defmethod print-method clojure.lang.Keyword [o, #^Writer w] - (.write w (str o))) - -(defmethod print-dup clojure.lang.Keyword [o w] (print-method o w)) - -(defmethod print-method Number [o, #^Writer w] - (.write w (str o))) - -(defmethod print-dup Number [o, #^Writer w] - (print-ctor o - (fn [o w] - (print-dup (str o) w)) - w)) - -(defmethod print-dup clojure.lang.AFn [o, #^Writer w] - (print-ctor o (fn [o w]) w)) - -(prefer-method print-dup clojure.lang.IPersistentCollection clojure.lang.AFn) -(prefer-method print-dup java.util.Map clojure.lang.AFn) -(prefer-method print-dup java.util.Collection clojure.lang.AFn) - -(defmethod print-method Boolean [o, #^Writer w] - (.write w (str o))) - -(defmethod print-dup Boolean [o w] (print-method o w)) - -(defn print-simple [o, #^Writer w] - (print-meta o w) - (.write w (str o))) - -(defmethod print-method clojure.lang.Symbol [o, #^Writer w] - (print-simple o w)) - -(defmethod print-dup clojure.lang.Symbol [o w] (print-method o w)) - -(defmethod print-method clojure.lang.Var [o, #^Writer w] - (print-simple o w)) - -(defmethod print-dup clojure.lang.Var [#^clojure.lang.Var o, #^Writer w] - (.write w (str "#=(var " (.name (.ns o)) "/" (.sym o) ")"))) - -(defmethod print-method clojure.lang.ISeq [o, #^Writer w] - (print-meta o w) - (print-sequential "(" pr-on " " ")" o w)) - -(defmethod print-dup clojure.lang.ISeq [o w] (print-method o w)) - -(defmethod print-method clojure.lang.IPersistentList [o, #^Writer w] - (print-meta o w) - (print-sequential "(" print-method " " ")" o w)) - -(prefer-method print-method clojure.lang.IPersistentList clojure.lang.ISeq) - -(defmethod print-method java.util.Collection [o, #^Writer w] - (print-ctor o #(print-sequential "[" print-method " " "]" %1 %2) w)) - -(prefer-method print-method clojure.lang.IPersistentCollection java.util.Collection) - -(defmethod print-dup java.util.Collection [o, #^Writer w] - (print-ctor o #(print-sequential "[" print-dup " " "]" %1 %2) w)) - -(defmethod print-dup clojure.lang.IPersistentCollection [o, #^Writer w] - (print-meta o w) - (.write w "#=(") - (.write w (.getName #^Class (class o))) - (.write w "/create ") - (print-sequential "[" print-dup " " "]" o w) - (.write w ")")) - -(prefer-method print-dup clojure.lang.IPersistentCollection java.util.Collection) - -(def #^{:tag String - :doc "Returns escape string for char or nil if none"} - char-escape-string - {\newline "\\n" - \tab "\\t" - \return "\\r" - \" "\\\"" - \\ "\\\\" - \formfeed "\\f" - \backspace "\\b"}) -(defmethod print-method String [#^String s, #^Writer w] - (if (or *print-dup* *print-readably*) - (do (.append w \") - (dotimes [n (count s)] - (let [c (.charAt s n) - e (char-escape-string c)] - (if e (.write w e) (.append w c)))) - (.append w \")) - (.write w s)) - nil) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; helper files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(load "core-proxy") +(load "core-print") +(load "genclass") -(defmethod print-dup String [s w] (print-method s w)) - -(defmethod print-method clojure.lang.IPersistentVector [v, #^Writer w] - (print-meta v w) - (print-sequential "[" pr-on " " "]" v w)) - -(defn- print-map [m print-one w] - (print-sequential - "{" - (fn [e #^Writer w] - (do (print-one (key e) w) (.append w \space) (print-one (val e) w))) - ", " - "}" - (seq m) w)) - -(defmethod print-method clojure.lang.IPersistentMap [m, #^Writer w] - (print-meta m w) - (print-map m pr-on w)) - -(defmethod print-method java.util.Map [m, #^Writer w] - (print-ctor m #(print-map (seq %1) print-method %2) w)) - -(prefer-method print-method clojure.lang.IPersistentMap java.util.Map) - -(defmethod print-dup java.util.Map [m, #^Writer w] - (print-ctor m #(print-map (seq %1) print-dup %2) w)) - -(defmethod print-dup clojure.lang.IPersistentMap [m, #^Writer w] - (print-meta m w) - (.write w "#=(") - (.write w (.getName (class m))) - (.write w "/create ") - (print-map m print-dup w) - (.write w ")")) - -(prefer-method print-dup clojure.lang.IPersistentCollection java.util.Map) - -(defmethod print-method clojure.lang.IPersistentSet [s, #^Writer w] - (print-meta s w) - (print-sequential "#{" pr-on " " "}" (seq s) w)) - -(defmethod print-method java.util.Set [s, #^Writer w] - (print-ctor s - #(print-sequential "#{" print-method " " "}" (seq %1) %2) - w)) - -;(prefer-method print-method clojure.lang.IPersistentSet java.util.Set) - -(def #^{:tag String - :doc "Returns name string for char or nil if none"} - char-name-string - {\newline "newline" - \tab "tab" - \space "space" - \backspace "backspace" - \formfeed "formfeed" - \return "return"}) - -(defmethod print-method java.lang.Character [#^Character c, #^Writer w] - (if (or *print-dup* *print-readably*) - (do (.append w \\) - (let [n (char-name-string c)] - (if n (.write w n) (.append w c)))) - (.append w c)) - nil) -(defmethod print-dup java.lang.Character [c w] (print-method c w)) -(defmethod print-dup java.lang.Integer [o w] (print-method o w)) -(defmethod print-dup java.lang.Double [o w] (print-method o w)) -(defmethod print-dup clojure.lang.Ratio [o w] (print-method o w)) -(defmethod print-dup java.math.BigDecimal [o w] (print-method o w)) -(defmethod print-dup clojure.lang.PersistentHashMap [o w] (print-method o w)) -(defmethod print-dup clojure.lang.PersistentHashSet [o w] (print-method o w)) -(defmethod print-dup clojure.lang.PersistentVector [o w] (print-method o w)) - -(def primitives-classnames - {Float/TYPE "Float/TYPE" - Integer/TYPE "Integer/TYPE" - Long/TYPE "Long/TYPE" - Boolean/TYPE "Boolean/TYPE" - Character/TYPE "Character/TYPE" - Double/TYPE "Double/TYPE" - Byte/TYPE "Byte/TYPE" - Short/TYPE "Short/TYPE"}) - -(defmethod print-method Class [#^Class c, #^Writer w] - (.write w (.getName c))) - -(defmethod print-dup Class [#^Class c, #^Writer w] - (cond - (.isPrimitive c) (do - (.write w "#=(identity ") - (.write w #^String (primitives-classnames c)) - (.write w ")")) - (.isArray c) (do - (.write w "#=(java.lang.Class/forName \"") - (.write w (.getName c)) - (.write w "\")")) - :else (do - (.write w "#=") - (.write w (.getName c))))) - -(defmethod print-method java.math.BigDecimal [b, #^Writer w] - (.write w (str b)) - (.write w "M")) - -(defmethod print-method java.util.regex.Pattern [p #^Writer w] - (.write w "#\"") - (loop [[#^Character c & r :as s] (seq (.pattern #^java.util.regex.Pattern p)) - qmode false] - (when s - (cond - (= c \\) (let [[#^Character c2 & r2] r] - (.append w \\) - (.append w c2) - (if qmode - (recur r2 (not= c2 \E)) - (recur r2 (= c2 \Q)))) - (= c \") (do - (if qmode - (.write w "\\E\\\"\\Q") - (.write w "\\\"")) - (recur r qmode)) - :else (do - (.append w c) - (recur r qmode))))) - (.append w \")) - -(defmethod print-dup java.util.regex.Pattern [p #^Writer w] (print-method p w)) - -(defmethod print-dup clojure.lang.Namespace [#^clojure.lang.Namespace n #^Writer w] - (.write w "#=(find-ns ") - (print-dup (.name n) w) - (.write w ")")) - -(def #^{:private true} print-initialized true) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; proxy ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(import - '(clojure.asm ClassWriter ClassVisitor Opcodes Type) - '(java.lang.reflect Modifier Constructor) - '(clojure.asm.commons Method GeneratorAdapter) - '(clojure.lang IProxy Reflector DynamicClassLoader IPersistentMap PersistentHashMap RT)) - -(def *proxy-classes* (ref {})) - -(defn method-sig [#^java.lang.reflect.Method meth] - [(. meth (getName)) (seq (. meth (getParameterTypes))) (. meth getReturnType)]) - -(defn get-proxy-class - "Takes an optional single class followed by zero or more - interfaces. If not supplied class defaults to Object. Creates an - returns an instance of a proxy class derived from the supplied - classes. The resulting value is cached and used for any subsequent - requests for the same class set. Returns a Class object." - [& bases] - (let [bases (if (. (first bases) (isInterface)) - (cons Object bases) - bases) - [super & interfaces] bases] - (or (get @*proxy-classes* bases) - (let [cv (new ClassWriter (. ClassWriter COMPUTE_MAXS)) - cname (str "clojure/lang/" (gensym "Proxy__")) - ctype (. Type (getObjectType cname)) - iname (fn [c] (.. Type (getType c) (getInternalName))) - fmap "__clojureFnMap" - totype (fn [c] (. Type (getType c))) - to-types (fn [cs] (if (pos? (count cs)) - (into-array (map totype cs)) - (make-array Type 0))) - super-type (totype super) - map-type (totype PersistentHashMap) - ifn-type (totype clojure.lang.IFn) - obj-type (totype Object) - sym-type (totype clojure.lang.Symbol) - rt-type (totype clojure.lang.RT) - ex-type (totype java.lang.UnsupportedOperationException) - gen-method - (fn [#^java.lang.reflect.Method meth else-gen] - (let [pclasses (. meth (getParameterTypes)) - ptypes (to-types pclasses) - rtype (totype (. meth (getReturnType))) - m (new Method (. meth (getName)) rtype ptypes) - gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv) - else-label (. gen (newLabel)) - end-label (. gen (newLabel)) - decl-type (. Type (getType (. meth (getDeclaringClass))))] - (. gen (visitCode)) - (. gen (loadThis)) - (. gen (getField ctype fmap map-type)) - ;get symbol corresponding to name - (. gen (push (. meth (getName)))) - (. gen (invokeStatic sym-type (. Method (getMethod "clojure.lang.Symbol create(String)")))) - ;lookup fn in map - (. gen (invokeStatic rt-type (. Method (getMethod "Object get(Object, Object)")))) - (. gen (dup)) - (. gen (ifNull else-label)) - ;if found - (. gen (loadThis)) - ;box args - (dotimes [i (count ptypes)] - (. gen (loadArg i)) - (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i)))) - ;call fn - (. gen (invokeInterface ifn-type (new Method "invoke" obj-type - (into-array (cons obj-type - (replicate (count ptypes) obj-type)))))) - ;unbox return - (. gen (unbox rtype)) - (when (= (. rtype (getSort)) (. Type VOID)) - (. gen (pop))) - (. gen (goTo end-label)) - - ;else call supplied alternative generator - (. gen (mark else-label)) - (. gen (pop)) - - (else-gen gen m) - - (. gen (mark end-label)) - (. gen (returnValue)) - (. gen (endMethod))))] - - ;start class definition - (. cv (visit (. Opcodes V1_5) (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_SUPER)) - cname nil (iname super) - (into-array (map iname (cons IProxy interfaces))))) - ;add field for fn mappings - (. cv (visitField (+ (. Opcodes ACC_PRIVATE) (. Opcodes ACC_VOLATILE)) - fmap (. map-type (getDescriptor)) nil nil)) - ;add ctors matching/calling super's - (doseq [#^Constructor ctor (. super (getDeclaredConstructors))] - (when-not (. Modifier (isPrivate (. ctor (getModifiers)))) - (let [ptypes (to-types (. ctor (getParameterTypes))) - m (new Method "<init>" (. Type VOID_TYPE) ptypes) - gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] - (. gen (visitCode)) - ;call super ctor - (. gen (loadThis)) - (. gen (dup)) - (. gen (loadArgs)) - (. gen (invokeConstructor super-type m)) - ;init fmap - (. gen (getStatic map-type "EMPTY" map-type)) - (. gen (putField ctype fmap map-type)) - - (. gen (returnValue)) - (. gen (endMethod))))) - ;add IProxy methods - (let [m (. Method (getMethod "void __updateClojureFnMappings(clojure.lang.IPersistentMap)")) - gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] - (. gen (visitCode)) - (. gen (loadThis)) - (. gen (dup)) - (. gen (getField ctype fmap map-type)) - (. gen (loadArgs)) - (. gen (invokeInterface (totype clojure.lang.IPersistentCollection) - (. Method (getMethod "clojure.lang.IPersistentCollection cons(Object)")))) - (. gen (checkCast map-type)) - (. gen (putField ctype fmap map-type)) - - (. gen (returnValue)) - (. gen (endMethod))) - (let [m (. Method (getMethod "clojure.lang.IPersistentMap __getClojureFnMappings()")) - gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] - (. gen (visitCode)) - (. gen (loadThis)) - (. gen (getField ctype fmap map-type)) - (. gen (returnValue)) - (. gen (endMethod))) - - ;calc set of supers' non-private instance methods - (let [mm (loop [mm {} considered #{} c super] - (if c - (let [[mm considered] - (loop [mm mm - considered considered - meths (concat - (seq (. c (getDeclaredMethods))) - (seq (. c (getMethods))))] - (if meths - (let [#^java.lang.reflect.Method meth (first meths) - mods (. meth (getModifiers)) - mk (method-sig meth)] - (if (or (considered mk) - (. Modifier (isPrivate mods)) - (. Modifier (isStatic mods)) - (. Modifier (isFinal mods)) - (= "finalize" (.getName meth))) - (recur mm (conj considered mk) (rest meths)) - (recur (assoc mm mk meth) (conj considered mk) (rest meths)))) - [mm considered]))] - (recur mm considered (. c (getSuperclass)))) - mm))] - ;add methods matching supers', if no mapping -> call super - (doseq [#^java.lang.reflect.Method meth (vals mm)] - (gen-method meth - (fn [gen m] - (. gen (loadThis)) - ;push args - (. gen (loadArgs)) - ;call super - (. gen (visitMethodInsn (. Opcodes INVOKESPECIAL) - (. super-type (getInternalName)) - (. m (getName)) - (. m (getDescriptor))))))) - - ;add methods matching interfaces', if no mapping -> throw - (doseq [#^Class iface interfaces] - (doseq [#^java.lang.reflect.Method meth (. iface (getMethods))] - (when-not (contains? mm (method-sig meth)) - (gen-method meth - (fn [gen m] - (. gen (throwException ex-type (. m (getName)))))))))) - - ;finish class def - (. cv (visitEnd)) - ;generate, cache and return class object - (let [loader (. RT ROOT_CLASSLOADER) - c (. loader (defineClass (. cname (replace "/" ".")) - (. cv (toByteArray))))] - (sync nil (commute *proxy-classes* assoc bases c)) - c))))) - -(defn construct-proxy - "Takes a proxy class and any arguments for its superclass ctor and - creates and returns an instance of the proxy." - [c & ctor-args] - (. Reflector (invokeConstructor c (to-array ctor-args)))) - -(defn update-proxy - "Takes a proxy instance and a map of symbols (whose names must - correspond to methods of the proxy superclass/superinterfaces) to - fns (which must take arguments matching the corresponding method, - plus an additional (explicit) first arg corresponding to this, and - updates (via assoc) the proxy's fn map. nil can be passed instead of - a fn, in which case the corresponding method will revert to the - default behavior. Note that this function can be used to update the - behavior of an existing instance without changing its identity." - [#^IProxy proxy mappings] - (. proxy (__updateClojureFnMappings mappings))) - -(defn proxy-mappings - "Takes a proxy instance and returns the proxy's fn map." - [#^IProxy proxy] - (. proxy (__getClojureFnMappings))) - -(defmacro proxy - "class-and-interfaces - a vector of class names - - args - a (possibly empty) vector of arguments to the superclass - constructor. - - f => (name [params*] body) or - (name ([params*] body) ([params+] body) ...) - - Expands to code which creates a instance of a proxy class that - implements the named class/interface(s) by calling the supplied - fns. A single class, if provided, must be first. If not provided it - 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 - 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 - which proxy is called. Each method fn takes an additional implicit - first arg, which is bound to 'this. Note that while method fns can - be provided to override protected methods, they have no other access - to protected members, nor to super, as these capabilities cannot be - proxied." - [class-and-interfaces args & fs] - `(let [pc# (get-proxy-class ~@class-and-interfaces) - p# (construct-proxy pc# ~@args)] - (update-proxy p# - ~(loop [fmap {} fs fs] - (if fs - (let [[sym & meths] (first fs) - meths (if (vector? (first meths)) - (list meths) - meths) - meths (map (fn [[params & body]] - (cons (apply vector 'this params) body)) - meths)] - (recur (assoc fmap (list `quote (symbol (name sym))) (cons `fn meths)) (rest fs))) - fmap))) - p#)) - -(defn proxy-call-with-super [call this meth] - (let [m (proxy-mappings this)] - (update-proxy this (assoc m meth nil)) - (let [ret (call)] - (update-proxy this m) - ret))) - -(defmacro proxy-super - "Use to call a superclass method in the body of a proxy method. - Note, expansion captures 'this" - [meth & args] - `(proxy-call-with-super (fn [] (. ~'this ~meth ~@args)) ~'this '~(symbol (name meth)))) - -(defn bean - "Takes a Java object and returns a read-only implementation of the - map abstraction based upon its JavaBean properties." - [#^Object x] - (let [c (. x (getClass)) - pmap (reduce (fn [m #^java.beans.PropertyDescriptor pd] - (let [name (. pd (getName)) - method (. pd (getReadMethod))] - (if (and method (zero? (alength (. method (getParameterTypes))))) - (assoc m (keyword name) (fn [] (. method (invoke x nil)))) - m))) - {} - (seq (.. java.beans.Introspector - (getBeanInfo c) - (getPropertyDescriptors)))) - v (fn [k] ((pmap k))) - snapshot (fn [] - (reduce (fn [m e] - (assoc m (key e) ((val e)))) - {} (seq pmap)))] - (proxy [clojure.lang.APersistentMap] - [] - (containsKey [k] (contains? pmap k)) - (entryAt [k] (when (contains? pmap k) (new clojure.lang.MapEntry k (v k)))) - (valAt ([k] (v k)) - ([k default] (if (contains? pmap k) (v k) default))) - (cons [m] (conj (snapshot) m)) - (count [] (count pmap)) - (assoc [k v] (assoc (snapshot) k v)) - (without [k] (dissoc (snapshot) k)) - (seq [] ((fn thisfn [pseq] - (when pseq - (lazy-cons (new clojure.lang.MapEntry (first pseq) (v (first pseq))) - (thisfn (rest pseq))))) (keys pmap)))))) diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index de686e7a..0e90565d 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -4471,8 +4471,7 @@ public static Object compile(Reader rdr, String sourcePath, String sourceName) t LINE_AFTER, pushbackReader.getLineNumber(), CONSTANTS, PersistentVector.EMPTY, KEYWORDS, PersistentHashMap.EMPTY, - VARS, PersistentHashMap.EMPTY, - COMPILE_FILES, RT.T + VARS, PersistentHashMap.EMPTY )); try diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java index 048aaf43..dc4451a6 100644 --- a/src/jvm/clojure/lang/RT.java +++ b/src/jvm/clojure/lang/RT.java @@ -368,8 +368,14 @@ public static void loadResourceScript(Class c, String name, boolean failIfNotFou InputStream ins = baseLoader().getResourceAsStream(name); if(ins != null) { - Compiler.load(new InputStreamReader(ins, UTF8), name, file); - ins.close(); + try + { + Compiler.load(new InputStreamReader(ins, UTF8), name, file); + } + finally + { + ins.close(); + } } else if(failIfNotFound) { @@ -392,26 +398,33 @@ static public long lastModified(URL url,String libfile) throws Exception{ return f.lastModified(); } } -static public void loadLib(String lib) throws Exception{ - loadLib(lib, true); -} -static public void compileLib(String lib) throws Exception{ - String libpath = lib.replace('.', '/'); - String cljfile = libpath + ".clj"; +static void compile(String cljfile) throws Exception{ InputStream ins = baseLoader().getResourceAsStream(cljfile); if(ins != null) { - Compiler.compile(new InputStreamReader(ins, UTF8), cljfile, cljfile.substring(cljfile.lastIndexOf("/"))); + try + { + Compiler.compile(new InputStreamReader(ins, UTF8), cljfile, + cljfile.substring(1 + cljfile.lastIndexOf("/"))); + } + finally + { + ins.close(); + } + } else - throw new FileNotFoundException("Could not locate Clojure resource on classpath: " + lib); + throw new FileNotFoundException("Could not locate Clojure resource on classpath: " + cljfile); } -static public void loadLib(String lib, boolean failIfNotFound) throws Exception{ - String libpath = lib.replace('.', '/'); - String classfile = libpath + ".class"; - String cljfile = libpath + ".clj"; +static public void load(String scriptbase) throws Exception{ + load(scriptbase, true); +} + +static public void load(String scriptbase, boolean failIfNotFound) throws Exception{ + String classfile = scriptbase + ".class"; + String cljfile = scriptbase + ".clj"; URL classURL = baseLoader().getResource(classfile); URL cljURL = baseLoader().getResource(cljfile); @@ -424,7 +437,7 @@ static public void loadLib(String lib, boolean failIfNotFound) throws Exception{ Var.pushThreadBindings( RT.map(CURRENT_NS, CURRENT_NS.get(), WARN_ON_REFLECTION, WARN_ON_REFLECTION.get())); - Reflector.invokeStaticMethod(classForName(lib), "load", EMPTY_ARRAY); + Reflector.invokeStaticMethod(classForName(scriptbase.replace('/','.')), "load", EMPTY_ARRAY); } finally { @@ -433,17 +446,20 @@ static public void loadLib(String lib, boolean failIfNotFound) throws Exception{ } else if(cljURL != null) { - loadResourceScript(RT.class, cljfile); + if (booleanCast(Compiler.COMPILE_FILES.get())) + compile(cljfile); + else + loadResourceScript(RT.class, cljfile); } else if(failIfNotFound) - throw new FileNotFoundException("Could not locate Clojure resource on classpath: " + lib); - + throw new FileNotFoundException(String.format("Could not locate %s or %s on classpath: ", classfile, cljfile)); } + static void doInit() throws Exception{ - loadLib("clojure.core"); - loadLib("clojure.zip",false); - loadLib("clojure.xml",false); - loadLib("clojure.set",false); + load("clojure/core"); + load("clojure/zip",false); + load("clojure/xml",false); + load("clojure/set",false); // try // { // Reflector.invokeStaticMethod("clojure.core", "load", EMPTY_ARRAY); |