Skip to content
Browse files

Add 'new' support and fix a couple of problems with class literals

  • Loading branch information...
1 parent 6364ab5 commit f7608ac13e8e4e8fe4f900c3ad871b3e433bf604 @remleduff committed Mar 12, 2012
View
10 src/clojure/analyzer.clj
@@ -13,7 +13,7 @@
(def ^:dynamic *file* nil)
(def ^:dynamic *warn-on-undeclared* false)
-(def specials '#{if def fn* do let* loop* recur . reify quote})
+(def specials '#{if def fn* do let* loop* recur new . reify quote})
(def ^:dynamic *recur-frames* nil)
@@ -351,6 +351,14 @@ facilitate code walking without knowing the details of the op set."
[_ env [_ x] _]
{:op :constant :env env :form x})
+(defmethod parse 'new
+ [_ env [_ ctor & args] _]
+ (disallowing-recur
+ (let [enve (assoc env :context :expr)
+ ctorexpr (analyze enve ctor)
+ argexprs (vec (map #(analyze enve %) args))]
+ {:env env :op :new :ctor ctorexpr :args argexprs :children (conj argexprs ctorexpr)})))
+
;; dot accessor code
(def ^:private property-symbol? #(boolean (and (symbol? %) (re-matches #"^-.*" (name %)))))
View
29 src/clojure/java/compiler.clj
@@ -190,7 +190,9 @@
callsites)))
(defn- closed-overs [{:as form :keys [env referenced-locals params]}]
- (remove (fn [{name :name}] (or (-> env :locals name :this) (not (contains? (:locals env) name)))) referenced-locals))
+ (remove (fn [{name :name}] (or (-> env :locals name :this)
+ (not (contains? (:locals env) name))))
+ referenced-locals))
(defn- emit-closed-overs [cv {:as form :keys [env params]}]
(doseq [{:as lb :keys [name type]} (closed-overs form)]
@@ -475,6 +477,18 @@
(emit-invoke-proto ast)
(emit-invoke-fn ast)))
+(defn- emit-instance [type args]
+ (.newInstance *gen* type)
+ (.dup *gen*)
+ (doseq [arg args]
+ (emit arg))
+ (.invokeConstructor *gen* type (apply asm-method "<init>" "void" (map expression-type args))))
+
+(defmethod emit-boxed :new
+ [{:keys [ctor args env]}]
+ (let [type (-> ctor :form asm-type)]
+ (emit-instance type args)))
+
(defn- emit-var [v]
(let [var (var! v)
{:keys [class statics]} @*frame*]
@@ -608,21 +622,20 @@
(notsup '(emit-variadic-fn-method meth))
(emit-method cv meth))))
-(defn- emit-closure [type form]
+(defn- emit-closure [type args]
(.newInstance *gen* type)
(.dup *gen*)
- (let [closed-overs (closed-overs form)]
- (doseq [{name :name} closed-overs]
- (emit-local name))
- (.invokeConstructor *gen* type (apply asm-method "<init>" "void" (map :type closed-overs)))))
+ (doseq [{name :name} args]
+ (emit-local name))
+ (.invokeConstructor *gen* type (apply asm-method "<init>" "void" (map :type args))))
(defmethod emit-boxed :fn [ast]
(let [name (str (or (:name ast) (gensym)))
cw (emit-class name (assoc ast :super "clojure/lang/AFn") emit-fn-methods)
bytecode (.toByteArray cw)
class (load-class name bytecode ast)
type (asm-type class)]
- (emit-closure type ast)))
+ (emit-closure type (closed-overs ast))))
(defmethod emit-boxed :do
[{:keys [statements ret env]}]
@@ -716,7 +729,7 @@
bytecode (.toByteArray cw)
class (load-class name bytecode ast)
type (asm-type class)]
- (emit-closure type ast)))
+ (emit-closure type (closed-overs ast))))
(defmethod emit-boxed :vector [args]
(emit-as-array (:children args))
View
11 src/clojure/java/compiler/analysis.clj
@@ -94,7 +94,6 @@
;; ---
-
(defn- rprintln [args]
(println "---" args)
args)
@@ -212,11 +211,17 @@
[{:as form :keys [info env]}]
(let [sym (:name info)
lb (-> env :locals sym)
- v (clojure.analyzer/resolve-var env sym)]
+ v (clojure.analyzer/resolve-var env sym)
+ o (resolve sym)]
(when-not (:name v)
(throw (Util/runtimeException (str "No such var: " sym))))
- (if lb
+ (cond
+ ;; Transform vars that represent classes into constants
+ (instance? java.lang.Class o)
+ (assoc form :op :constant)
+ lb
(assoc form :referenced-locals #{{:name sym :type (expression-type form)}})
+ :else
(assoc form :vars #{sym}))))
(defmethod collect-vars :def
View
4 test/test/clojure/java/compiler.clj
@@ -28,6 +28,7 @@
(deftest test-eval
(is (= 1 (c/eval '1)))
+ (is (= java.lang.Object (c/eval 'java.lang.Object)))
(testing "vector"
(is (= [1 2] (c/eval '[1 2]))))
(testing "map"
@@ -49,7 +50,8 @@
(is (= 10 ((c/eval '(fn [x] (if (< x 10) (recur (inc x)) x))) 1)))
(is (= 10 (c/eval '(loop [x 1] (if (< x 10) (recur (inc x)) x))))))
(testing "do"
- (is (= :success (c/eval '(do (+ 1 2) :success))))))
+ (is (= :success (c/eval '(do (+ 1 2) :success)))))
+ (is (instance? java.lang.Object (c/eval '(new java.lang.Object)))))
(deftest let
(is (= 9 (c/eval '(let [x 9] x))))

0 comments on commit f7608ac

Please sign in to comment.
Something went wrong with that request. Please try again.