From 554e3bd623df14da5401b941375e474a9ad93cba Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 11 Oct 2016 21:46:40 -0400 Subject: - Optimized the compiler code by dealing with the reflection warnings. --- src/lux/analyser/host.clj | 2 +- src/lux/base.clj | 15 ++++++++------- src/lux/compiler/host.clj | 14 +++++++------- src/lux/compiler/lambda.clj | 40 ++++++++++++++++++++-------------------- 4 files changed, 36 insertions(+), 35 deletions(-) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index b84b31dff..98baad662 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -881,7 +881,7 @@ (defn ^:private analyse-jvm-load-class [analyse exo-type ?values] (|do [:let [(&/$Cons [_ (&/$TextS _class-name)] (&/$Nil)) ?values] - class-loader &/loader + ^ClassLoader class-loader &/loader _ (try (do (.loadClass class-loader _class-name) (return nil)) (catch Exception e diff --git a/src/lux/base.clj b/src/lux/base.clj index 54a0354c6..f3abc6c1d 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -1072,17 +1072,18 @@ count-leading-0s (fn [^String input] (let [parts (.split input "^0*")] (if (= 2 (alength parts)) - (.length (aget parts 0)) + (.length ^String (aget parts 0)) 0)))] (defn encode-frac [input] (if (= 0 input) ".0" - (->> input - (Long/toUnsignedString) - remove-trailing-0s - (.concat (->> (count-bin-start-0 input) - (bit-shift-left 1) - (make-text-start-0)))))) + (let [^String prefix (->> (count-bin-start-0 input) + (bit-shift-left 1) + (make-text-start-0))] + (->> input + (Long/toUnsignedString) + remove-trailing-0s + (.concat prefix))))) (defn decode-frac [input] (if-let [[_ frac-text] (re-find #"^\.(.+)$" input)] diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 77eeb8559..3b2a53929 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -556,7 +556,7 @@ (&&/save-class! (second (string/split &&/function-class #"/")) (.toByteArray (doto =class .visitEnd))))) -(defn ^:private compile-LuxRT-adt-methods [=class] +(defn ^:private compile-LuxRT-adt-methods [^ClassWriter =class] (|let [_ (let [$begin (new Label) $not-rec (new Label)] (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "product_getLeft" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil) @@ -718,7 +718,7 @@ (.visitEnd)))] nil)) -(defn ^:private low-4b [=method] +(defn ^:private low-4b [^MethodVisitor =method] (doto =method ;; Assume there is a long at the top of the stack... ;; Add mask corresponding to -1 (FFFF...), on the low 32 bits. @@ -728,21 +728,21 @@ (.visitInsn Opcodes/LAND) )) -(defn ^:private high-4b [=method] +(defn ^:private high-4b [^MethodVisitor =method] (doto =method ;; Assume there is a long at the top of the stack... (.visitLdcInsn (int 32)) (.visitInsn Opcodes/LUSHR) )) -(defn ^:private swap2 [=method] +(defn ^:private swap2 [^MethodVisitor =method] (doto =method ;; X2, Y2 (.visitInsn Opcodes/DUP2_X2) ;; Y2, X2, Y2 (.visitInsn Opcodes/POP2) ;; Y2, X2 )) -(defn ^:private bit-set-64? [=method] +(defn ^:private bit-set-64? [^MethodVisitor =method] (doto =method ;; L, I (.visitLdcInsn (long 1)) ;; L, I, L @@ -1076,7 +1076,7 @@ nil)) (let [+wrapper-class+ (&host-generics/->bytecode-class-name "java.lang.Long")] - (defn ^:private compile-LuxRT-nat-methods [=class] + (defn ^:private compile-LuxRT-nat-methods [^ClassWriter =class] (|let [_ (let [$end (new Label) ;; $then (new Label) $else (new Label) @@ -1129,7 +1129,7 @@ (.visitEnd))] nil))) -(defn ^:private compile-LuxRT-pm-methods [=class] +(defn ^:private compile-LuxRT-pm-methods [^ClassWriter =class] (|let [_ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "pm_fail" "()V" nil nil) (.visitCode) (.visitTypeInsn Opcodes/NEW "java/lang/IllegalStateException") diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 084c38b80..c0096523f 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -82,7 +82,7 @@ (str "(" (&/fold str "" (&/|repeat (&/|length env) field-sig)) ")" -return))) -(defn ^:private init-function [method-writer arity closure-length] +(defn ^:private init-function [^MethodVisitor method-writer arity closure-length] (if (= 1 arity) (doto method-writer (.visitLdcInsn (int 0)) @@ -91,19 +91,19 @@ (.visitVarInsn Opcodes/ILOAD (inc closure-length)) (.visitMethodInsn Opcodes/INVOKESPECIAL &&/function-class "" "(I)V")))) -(defn ^:private add-lambda- [class class-name arity env] +(defn ^:private add-lambda- [^ClassWriter class class-name arity env] (let [closure-length (&/|length env)] - (doto (.visitMethod ^ClassWriter class Opcodes/ACC_PUBLIC "" (lambda--signature env arity) nil nil) + (doto (.visitMethod class Opcodes/ACC_PUBLIC "" (lambda--signature env arity) nil nil) (.visitCode) ;; Do normal object initialization (.visitVarInsn Opcodes/ALOAD 0) (init-function arity closure-length) ;; Add all of the closure variables - (-> (put-field! class-name (str &&/closure-prefix ?captured-id) field-sig #(.visitVarInsn % Opcodes/ALOAD (inc ?captured-id))) + (-> (put-field! class-name (str &&/closure-prefix ?captured-id) field-sig #(.visitVarInsn ^MethodVisitor % Opcodes/ALOAD (inc ?captured-id))) (->> (|let [[?name [_ (&o/$captured _ ?captured-id ?source)]] ?name+?captured]) (doseq [?name+?captured (&/->seq env)]))) ;; Add all the partial arguments - (-> (put-field! class-name (str &&/partial-prefix idx*) field-sig #(.visitVarInsn % Opcodes/ALOAD partial-register)) + (-> (put-field! class-name (str &&/partial-prefix idx*) field-sig #(.visitVarInsn ^MethodVisitor % Opcodes/ALOAD partial-register)) (->> (|let [partial-register (+ (inc idx*) (inc closure-length))]) (dotimes [idx* (dec arity)]))) ;; Finish @@ -112,9 +112,9 @@ (.visitEnd)))) (let [impl-flags (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL)] - (defn ^:private add-lambda-impl [class class-name compile arity impl-body] + (defn ^:private add-lambda-impl [^ClassWriter class class-name compile arity impl-body] (let [$begin (new Label)] - (&/with-writer (doto (.visitMethod ^ClassWriter class impl-flags "impl" (lambda-impl-signature arity) nil nil) + (&/with-writer (doto (.visitMethod class impl-flags "impl" (lambda-impl-signature arity) nil nil) (.visitCode) (.visitLabel $begin)) (|do [^MethodVisitor *writer* &/get-writer @@ -142,9 +142,9 @@ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "" (lambda--signature closed-over arity))]] (return nil))) -(defn ^:private add-lambda-reset [class-writer class-name arity env] +(defn ^:private add-lambda-reset [^ClassWriter class-writer class-name arity env] (if (> arity 1) - (doto (.visitMethod ^ClassWriter class-writer Opcodes/ACC_PUBLIC "reset" (reset-signature class-name) nil nil) + (doto (.visitMethod class-writer Opcodes/ACC_PUBLIC "reset" (reset-signature class-name) nil nil) (.visitCode) (.visitTypeInsn Opcodes/NEW class-name) (.visitInsn Opcodes/DUP) @@ -156,21 +156,21 @@ (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) (.visitEnd)) - (doto (.visitMethod ^ClassWriter class-writer Opcodes/ACC_PUBLIC "reset" (reset-signature class-name) nil nil) + (doto (.visitMethod class-writer Opcodes/ACC_PUBLIC "reset" (reset-signature class-name) nil nil) (.visitCode) (.visitVarInsn Opcodes/ALOAD 0) (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) (.visitEnd)))) -(defn ^:private add-lambda-apply-n [class-writer +degree+ class-name arity env compile impl-body] +(defn ^:private add-lambda-apply-n [^ClassWriter class-writer +degree+ class-name arity env compile impl-body] (if (> arity 1) (let [num-partials (dec arity) $default (new Label) $labels* (map (fn [_] (new Label)) (repeat num-partials nil)) $labels (vec (concat $labels* (list $default))) $end (new Label) - method-writer (.visitMethod ^ClassWriter class-writer Opcodes/ACC_PUBLIC &&/apply-method (&&/apply-signature +degree+) nil nil) + method-writer (.visitMethod class-writer Opcodes/ACC_PUBLIC &&/apply-method (&&/apply-signature +degree+) nil nil) frame-locals (to-array (list class-name "java/lang/Object" "java/lang/Object")) frame-stack (to-array [Opcodes/INTEGER]) arity-over-extent (- arity +degree+)] @@ -246,15 +246,15 @@ :let [??scope (&/|reverse ?scope) name (&host/location (&/|tail ??scope)) class-name (str (&host/->module-class (&/|head ??scope)) "/" name) - [=class save?] (|case ?prev-writer - (&/$Some _writer) - (&/T [_writer false]) + [^ClassWriter =class save?] (|case ?prev-writer + (&/$Some _writer) + (&/T [_writer false]) - (&/$None) - (&/T [(doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit &host/bytecode-version lambda-flags - class-name nil &&/function-class (into-array String []))) - true])) + (&/$None) + (&/T [(doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit &host/bytecode-version lambda-flags + class-name nil &&/function-class (into-array String []))) + true])) _ (doto =class (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC Opcodes/ACC_FINAL) &&/arity-field "I" nil (int arity)) (doto (.visitEnd))) -- cgit v1.2.3