()V
39 | RETURN
40 | MAXSTACK = 1
41 | MAXLOCALS = 1
42 |
43 | // access flags 0x1
44 | public invokePrim()J
45 | L0
46 | LINENUMBER 1 L0
47 | LCONST_1
48 | LDC 2
49 | ACONST_NULL
50 | ASTORE 0
51 | INVOKESTATIC clojure/lang/Numbers.add (JJ)J
52 | LRETURN
53 | LOCALVARIABLE this Lclojure/lang/AFunction; L0 L0 0
54 | MAXSTACK = 5
55 | MAXLOCALS = 1
56 |
57 | // access flags 0x1
58 | public invoke()Ljava/lang/Object;
59 | ALOAD 0
60 | INVOKEVIRTUAL user$fn__6242.invokePrim ()J
61 | INVOKESTATIC clojure/lang/RT.box (J)Ljava/lang/Number;
62 | ARETURN
63 | MAXSTACK = 2
64 | MAXLOCALS = 1
65 | }
66 | 3
67 | user=> (e/load "clojure.pprint")
68 | nil
69 | user=> (clojure.pprint/pprint 1)
70 | 1
71 | ```
72 |
73 | ## Differences From Clojure
74 | While the bytecode produced by `tools.emitter.jvm` is similar to the one produces by Clojure itself, there are some differences:
75 | * `tools.emitter.jvm` is capable of clearing locals closed over by loops, in the loop exit path
76 | * `tools.emitter.jvm` clears the "this" local before the last tail call in a method, see [CLJ-1250](http://dev.clojure.org/jira/browse/CLJ-1250)
77 | * `tools.emitter.jvm` clears unused locals after their creation
78 | * `tools.emitter.jvm` hoists loop and try bodies into separate methods rather than wrapping them in a fn, see [CLJ-701](http://dev.clojure.org/jira/browse/CLJ-701)
79 | * `tools.emitter.jvm` emits keyword invoke callsites only when the keyword is not namespaces, see [CLJ-1469](http://dev.clojure.org/jira/browse/CLJ-1469)
80 | * `tools.emitter.jvm` emits typed bytecode, enforcing any explicit tag, this breaks some functions in `clojure.core` like `ns-interns`. This behaviour might be reconsidered in the future.
81 | * `tools.emitter.jvm` handles [CLJ-1330](http://dev.clojure.org/jira/browse/CLJ-1330)
82 |
83 | ## Performances
84 |
85 | `clojure.tools.emitter.jvm/eval` is currently between 5x and 8x slower than `clojure.core/eval`
86 |
87 | ## SPONSORSHIP
88 |
89 | * Cognitect (http://cognitect.com/) has sponsored tools.emitter.jvm development (https://groups.google.com/d/msg/clojure/iaP16MHpX0E/EMtnGmOz-rgJ)
90 | * Ambrose BS (https://twitter.com/ambrosebs) has sponsored tools.emitter.jvm development in his typed clojure campaign (http://www.indiegogo.com/projects/typed-clojure).
91 |
92 | ## YourKit
93 |
94 | YourKit has given an open source license for their profiler, greatly simplifying the profiling of tools.emitter.jvm performance.
95 |
96 | YourKit is kindly supporting open source projects with its full-featured Java Profiler. YourKit, LLC is the creator of innovative and intelligent tools for profiling Java and .NET applications. Take a look at YourKit's leading software products:
97 |
98 | * YourKit Java Profiler and
99 | * YourKit .NET Profiler.
100 |
101 | ## Releases and Dependency Information
102 |
103 | Latest stable release: 0.1.0-beta5
104 |
105 | * [All Released Versions](http://search.maven.org/#search%7Cgav%7C1%7Cg%3A%22org.clojure%22%20AND%20a%3A%22tools.emitter.jvm%22)
106 |
107 | * [Development Snapshot Versions](https://oss.sonatype.org/index.html#nexus-search;gav%7Eorg.clojure%7Etools.emitter.jvm%7E%7E%7E)
108 |
109 | [Leiningen](https://github.com/technomancy/leiningen) dependency information:
110 |
111 | ```clojure
112 | [org.clojure/tools.emitter.jvm "0.1.0-beta5"]
113 | ```
114 | [Maven](http://maven.apache.org/) dependency information:
115 |
116 | ```xml
117 |
118 | org.clojure
119 | tools.emitter.jvm
120 | 0.1.0-beta5
121 |
122 | ```
123 |
124 | [Changelog](CHANGELOG.md)
125 | ========================================
126 |
127 | API Index
128 | ========================================
129 |
130 | * [CrossClj Documentation](http://crossclj.info/doc/org.clojure/tools.emitter.jvm/lastest/index.html)
131 | * [API index](http://clojure.github.io/tools.emitter.jvm)
132 |
133 | Developer Information
134 | ========================================
135 |
136 | * [GitHub project](https://github.com/clojure/tools.emitter.jvm)
137 | * [Bug Tracker](https://clojure.atlassian.net/browse/TEMJVM)
138 | * [Continuous Integration](https://github.com/clojure/tools.emitter.jvm/actions/workflows/test.yml)
139 |
140 | ## License
141 |
142 | Copyright © 2013-2023 Nicola Mometto, Rich Hickey & contributors.
143 |
144 | Distributed under the Eclipse Public License, the same as Clojure.
145 |
--------------------------------------------------------------------------------
/src/main/clojure/clojure/tools/emitter/passes/jvm/clear_locals.clj:
--------------------------------------------------------------------------------
1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors.
2 | ;; The use and distribution terms for this software are covered by the
3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 | ;; which can be found in the file epl-v10.html at the root of this distribution.
5 | ;; By using this software in any fashion, you are agreeing to be bound by
6 | ;; the terms of this license.
7 | ;; You must not remove this notice, or any other, from this software.
8 |
9 | (ns clojure.tools.emitter.passes.jvm.clear-locals
10 | (:require [clojure.tools.analyzer.ast :refer [update-children]]
11 | [clojure.tools.analyzer.utils :refer [ctx rseqv]]
12 | [clojure.tools.analyzer.passes.jvm
13 | [annotate-branch :refer [annotate-branch]]
14 | [annotate-loops :refer [annotate-loops]]]
15 | [clojure.tools.analyzer.passes.collect-closed-overs :refer [collect-closed-overs]]))
16 |
17 | (def ^:dynamic *clears*)
18 |
19 | (defmulti -clear-locals :op)
20 | (defmulti should-not-clear :op)
21 |
22 | (defmethod should-not-clear :local
23 | [ast]
24 | (or (= :letfn (:local ast))
25 | (:case-test ast)))
26 |
27 | (defmethod should-not-clear :binding
28 | [ast]
29 | (:case-test @(:atom ast)))
30 |
31 | (defmethod should-not-clear :default [ast]
32 | false)
33 |
34 | (defn maybe-clear-local
35 | [{:keys [name local env loops] :as ast}]
36 | (let [{:keys [closed-overs locals loop-closed-overs]} @*clears*
37 | loop-id (:loop-id env)]
38 | (if (and (#{:let :loop :catch :arg} local)
39 | (or (not (get (loop-closed-overs loop-id) name)) ;; if we're in a loop and the local is defined outside the loop
40 | (not loops) ;; it's only safe to clear it if we're in the loop exit path for this loop
41 | (and (not (loops loop-id)) ;; and if the local isn't defined outside different loop than this and we're
42 | (not (some (fn [id] (get (loop-closed-overs id) name)) loops)))) ;; in a recur path for that loop
43 | (or (not (closed-overs name)) ;; if it's a closed-over var, we can only clear it if we explicitely
44 | (:once env)) ;; declared the function to be run :once
45 | (not (locals name)) ;; if the local is in `locals` it means that it's used later in the body and can't be cleared here
46 | (not (should-not-clear ast))) ;; letfn bindings/case test
47 | (assoc ast :to-clear? true)
48 | ast)))
49 |
50 | (defn maybe-clear-this
51 | [{:keys [env] :as ast}]
52 | (-> (if (and (isa? (:context env) :ctx/return)
53 | (not (:in-try env)))
54 | (assoc ast :to-clear? true)
55 | ast)
56 | (update-children -clear-locals rseqv)))
57 |
58 | (defmethod -clear-locals :invoke
59 | [ast]
60 | (maybe-clear-this ast))
61 |
62 | (defmethod -clear-locals :protocol-invoke
63 | [ast]
64 | (maybe-clear-this ast))
65 |
66 | (defmethod -clear-locals :prim-invoke
67 | [ast]
68 | (maybe-clear-this ast))
69 |
70 | (defmethod -clear-locals :static-call
71 | [ast]
72 | (maybe-clear-this ast))
73 |
74 | (defmethod -clear-locals :instance-call
75 | [ast]
76 | (maybe-clear-this ast))
77 |
78 | (defmethod -clear-locals :default
79 | [{:keys [closed-overs op loop-id] :as ast}]
80 | (if closed-overs
81 | (let [[ast body-locals] (binding [*clears* (atom (if (= :loop op) ;; if we're in a loop those are not actually closed-overs
82 | (assoc-in @*clears* [:loop-closed-overs loop-id] closed-overs)
83 | (update-in @*clears* [:closed-overs] merge closed-overs)))] ;; clear locals in the body
84 | [(update-children ast -clear-locals rseqv) (:locals @*clears*)]) ;; and save encountered locals
85 | [ks vs] (reduce-kv (fn [[keys vals] k v]
86 | [(conj keys k) (conj vals v)])
87 | [[] []] closed-overs)
88 | closed-overs (zipmap ks (mapv maybe-clear-local vs))] ;; clear outer closed-overs at the point of the closure creation
89 | (swap! *clears* #(update-in % [:locals] into body-locals)) ;; merge the locals so that we know not to clear them "before"
90 | (if (#{:fn :reify} op)
91 | (assoc ast :closed-overs closed-overs)
92 | ast))
93 | (update-children ast -clear-locals rseqv)))
94 |
95 | (defmethod -clear-locals :if
96 | [{:keys [test then else] :as ast}]
97 | (let [[then then-clears] (binding [*clears* (atom @*clears*)] ;; push a new locals frame for every path so that
98 | [(-clear-locals then) @*clears*]) ;; we can clear the same local in different branches
99 | [else else-clears] (binding [*clears* (atom @*clears*)] ;; this is safe to do since the different paths will
100 | [(-clear-locals else) @*clears*]) ;; never interfere
101 | locals (into (:locals then-clears) ;; merge all the locals encountered in the branch paths
102 | (:locals else-clears))] ;; so that if we encounter them "before" in the body we know
103 | (swap! *clears* #(update-in % [:locals] into locals)) ;; that we cannot clear them since they are needed later
104 | (let [test (-clear-locals test)]
105 | (assoc ast
106 | :test test
107 | :then then
108 | :else else))))
109 |
110 | (defmethod -clear-locals :case
111 | [{:keys [test default thens] :as ast}]
112 | (let [[thens thens-locals]
113 | (reduce (fn [[thens locals] then]
114 | (let [[t l] (binding [*clears* (atom @*clears*)]
115 | [(-clear-locals then) (:locals @*clears*)])]
116 | [(conj thens t) (into locals l)]))
117 | [[] #{}] thens)
118 | [default {:keys [locals]}] (binding [*clears* (atom @*clears*)]
119 | [(-clear-locals default) @*clears*])]
120 | (swap! *clears* #(update-in % [:locals] into (into thens-locals locals)))
121 | (assoc ast
122 | :test test
123 | :thens thens
124 | :default default)))
125 |
126 | (defmethod -clear-locals :local
127 | [ast]
128 | (let [ast (maybe-clear-local ast)]
129 | (swap! *clears* #(update-in % [:locals] conj (:name ast))) ;; register that the local has been used and potentially cleared
130 | ast))
131 |
132 | (defmethod -clear-locals :binding
133 | [ast]
134 | (let [{:keys [init to-clear?] :as ast} (-> ast (update-children -clear-locals rseqv)
135 | maybe-clear-local)]
136 | (if (and init to-clear?)
137 | (update-in ast [:init :env] ctx :statement)
138 | ast)))
139 |
140 | (defn clear-locals
141 | "Attached :to-clear? true to all the nodes that the compiler
142 | can clear, those nodes can be:
143 | * :local nodes
144 | * :binding nodes
145 | * :invoke/protocol-invoke/prim-invoke/static-call/instance-call nodes
146 | in return position, meaning that the \"this\" local is eligible for
147 | clearing"
148 | {:pass-info {:walk :none :depends #{#'collect-closed-overs #'annotate-branch #'annotate-loops}}}
149 | [ast]
150 | (if (:disable-locals-clearing *compiler-options*)
151 | ast
152 | (binding [*clears* (atom {:closed-overs {}
153 | :loop-closed-overs {}
154 | :locals #{}})]
155 | (-clear-locals ast))))
156 |
--------------------------------------------------------------------------------
/src/main/clojure/clojure/tools/emitter/jvm.clj:
--------------------------------------------------------------------------------
1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors.
2 | ;; The use and distribution terms for this software are covered by the
3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 | ;; which can be found in the file epl-v10.html at the root of this distribution.
5 | ;; By using this software in any fashion, you are agreeing to be bound by
6 | ;; the terms of this license.
7 | ;; You must not remove this notice, or any other, from this software.
8 |
9 | (ns clojure.tools.emitter.jvm
10 | (:refer-clojure :exclude [eval macroexpand-1 macroexpand load])
11 | (:require [clojure.tools.analyzer.jvm :as a]
12 | [clojure.tools.analyzer :refer [macroexpand-1 macroexpand]]
13 | [clojure.tools.analyzer.passes :refer [schedule]]
14 | [clojure.tools.analyzer.env :as env]
15 | [clojure.tools.analyzer.utils :refer [mmerge]]
16 | [clojure.tools.emitter.jvm.emit :as e]
17 | [clojure.tools.emitter.jvm.transform :as t]
18 | [clojure.tools.analyzer.passes
19 | [collect-closed-overs :refer [collect-closed-overs]]
20 | [trim :refer [trim]]]
21 | [clojure.tools.emitter.passes.jvm
22 | [collect :refer [collect]]
23 | [collect-internal-methods :refer :all]
24 | [clear-locals :refer [clear-locals]]
25 | [annotate-class-id :refer [annotate-class-id]]
26 | [annotate-internal-name :refer [annotate-internal-name]]
27 | [ensure-tag :refer [ensure-tag]]]
28 | [clojure.java.io :as io]
29 | [clojure.string :as s]
30 | [clojure.tools.reader :as r]
31 | [clojure.tools.reader.reader-types :as readers])
32 | (:import (clojure.lang IFn DynamicClassLoader Atom)))
33 |
34 | (defn write-class
35 | "(λ ClassName → Bytecode) → Nil
36 |
37 | Writes the given bytecode to a file named by the ClassName and
38 | *compile-path*. Requires that *compile-path* be set. Returns Nil."
39 | [name bytecode]
40 | {:pre [(bound? #'clojure.core/*compile-path*)]}
41 | (let [path (str *compile-path* "/" name ".class")
42 | file (io/file path)]
43 | (.mkdirs (io/file (.getParent file)))
44 | (with-open [w (java.io.FileOutputStream. path)]
45 | (.write w bytecode)))
46 | nil)
47 |
48 | (defn compile-and-load
49 | ([class-ast]
50 | (compile-and-load class-ast (clojure.lang.RT/makeClassLoader)))
51 | ([{:keys [class-name] :as class-ast} class-loader]
52 | (let [bytecode (t/-compile class-ast)]
53 | (when (and (bound? #'clojure.core/*compile-files*)
54 | *compile-files*)
55 | (write-class class-name bytecode))
56 | (.defineClass ^DynamicClassLoader class-loader class-name bytecode nil))))
57 |
58 |
59 | (def passes (into (disj a/default-passes #'trim)
60 | #{#'collect-internal-methods
61 |
62 | #'ensure-tag
63 |
64 | #'annotate-class-id
65 | #'annotate-internal-name
66 |
67 | #'collect
68 | #'collect-closed-overs
69 | #'clear-locals}))
70 |
71 | (def run-passes
72 | (schedule passes))
73 |
74 | (defn eval
75 | "(eval form)
76 | (eval form eval-options-map)
77 |
78 | Form is a read Clojure s expression represented as a list.
79 | Eval-options-map is a map, defaulting to the empty map, the
80 | following values of which are significant. Returns the result of
81 | evaling the input expression.
82 |
83 | Options
84 | -----------
85 | :debug? :- (Option Bool)
86 | Enables or disables printing in eval. Used as the default value for
87 | printing in the emitter.
88 |
89 | :emit-opts :- (Option emit-options-map)
90 | An options map which will be merged with the default options
91 | provided to emit. Keys in this map take precidence over the default
92 | values provided to emit. The keys which are significant in this map
93 | are documented in the t.e.jvm.emit/emit docstring.
94 |
95 | :analyze-opts :- (Option analyze-options-map)
96 | An options map that will be passed to the analyzer. The keys which
97 | are significant in this map are documented in the t.a.jvm/analyze
98 | docstring.
99 |
100 | :class-loader :- (Option ClassLoader)
101 | An optional classloader into which compiled functions will be
102 | injected. If not provided, a new Clojure classloader will be
103 | used. If a class loader is provided here, one need not be provided
104 | in eval-opts.
105 |
106 | :compile-files :- (Option Bool)
107 | Enables or disables writing classfiles for generated classes. False
108 | by default."
109 |
110 | ([form]
111 | (eval form {}))
112 | ([form {:keys [debug? emit-opts class-loader analyze-opts compile-files]
113 | :or {debug? false
114 | emit-opts {}
115 | analyze-opts a/default-passes-opts
116 | compile-files (if (bound? #'clojure.core/*compile-files*)
117 | *compile-files* false)
118 | class-loader (clojure.lang.RT/makeClassLoader)}
119 | :as options}]
120 | {:pre [(instance? DynamicClassLoader class-loader)]}
121 | (let [mform (binding [macroexpand-1 a/macroexpand-1]
122 | (macroexpand form (a/empty-env)))]
123 | (if (and (seq? mform) (= 'do (first mform)))
124 | (let [[statements ret] (loop [statements [] [e & exprs] (rest mform)]
125 | (if (seq exprs)
126 | (recur (conj statements e) exprs)
127 | [statements e]))]
128 | (doseq [expr statements]
129 | (eval expr options))
130 | (eval ret options))
131 | (binding [a/run-passes run-passes
132 | *compile-files* compile-files]
133 | (let [cs (-> (a/analyze `(^:once fn* [] ~mform) (a/empty-env) analyze-opts)
134 | (e/emit-classes (merge {:debug? debug?} emit-opts)))
135 | classes (mapv #(compile-and-load % class-loader) cs)]
136 | ((.newInstance ^Class (last classes)))))))))
137 |
138 | (def root-directory @#'clojure.core/root-directory)
139 |
140 | (defn load
141 | "(load resource)
142 | (load resource load-options-map)
143 |
144 | Resource is a string identifier for a Clojure resource on the
145 | classpath. Load-options is a a map, defalting to the empty map, in
146 | which the following keys are meaningful. Returns nil.
147 |
148 | Options
149 | -----------
150 | :debug? :- (Option Bool)
151 | Enables or disables printing in eval. Used as the default value for
152 | printing in the emitter.
153 |
154 | :eval-opts :- (Option eval-options-map)
155 | An options map which will be merged with the default options
156 | provided to eval. Keys set in this map take precidence over the
157 | default values supplied to eval. The keys which are significant in
158 | this map are documented in the t.e.jvm/eval docstring.
159 |
160 | :class-loader :- (Option ClassLoader)
161 | An optional classloader into which compiled functions will be
162 | injected. If not provided, a new Clojure classloader will be
163 | used. If a class loader is provided here, one need not be provided
164 | in eval-opts.
165 |
166 | :compile-files :- (Option Bool)
167 | Enables or disables writing classfiles for generated classes. False
168 | by default."
169 |
170 | ([res]
171 | (load res {}))
172 | ([res {:keys [debug? eval-opts class-loader compile-files]
173 | :or {debug? false
174 | eval-opts {}
175 | compile-files (if (bound? #'clojure.core/*compile-files*)
176 | *compile-files* false)
177 | class-loader (clojure.lang.RT/makeClassLoader)}
178 | :as options}]
179 | (let [p (str (apply str (replace {\. \/ \- \_} res)) ".clj")
180 | eof (Object.)
181 | p (if (.startsWith p "/")
182 | (subs p 1)
183 | (subs (str (root-directory (ns-name *ns*)) "/" p) 1))
184 | file (-> p io/resource io/reader slurp)
185 | reader (readers/indexing-push-back-reader file 1 p)]
186 | (binding [*ns* *ns*
187 | *file* p
188 | *compile-files* compile-files]
189 | (loop []
190 | (let [form (r/read reader false eof)]
191 | (when (not= eof form)
192 | (eval form (merge eval-opts
193 | (when class-loader
194 | {:class-loader class-loader
195 | :compile-files compile-files})))
196 | (recur))))
197 | nil))))
198 |
--------------------------------------------------------------------------------
/src/main/clojure/clojure/tools/emitter/jvm/intrinsics.clj:
--------------------------------------------------------------------------------
1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors.
2 | ;; The use and distribution terms for this software are covered by the
3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 | ;; which can be found in the file epl-v10.html at the root of this distribution.
5 | ;; By using this software in any fashion, you are agreeing to be bound by
6 | ;; the terms of this license.
7 | ;; You must not remove this notice, or any other, from this software.
8 |
9 | (ns clojure.tools.emitter.jvm.intrinsics
10 | (:import (org.objectweb.asm Opcodes)))
11 |
12 | (def intrinsic
13 | {"public static double clojure.lang.Numbers.add(double,double)" [Opcodes/DADD]
14 | "public static long clojure.lang.Numbers.and(long,long)" [Opcodes/LAND]
15 | "public static long clojure.lang.Numbers.or(long,long)" [Opcodes/LOR]
16 | "public static long clojure.lang.Numbers.xor(long,long)" [Opcodes/LXOR]
17 | "public static double clojure.lang.Numbers.multiply(double,double)" [Opcodes/DMUL]
18 | "public static double clojure.lang.Numbers.divide(double,double)" [Opcodes/DDIV]
19 | "public static long clojure.lang.Numbers.remainder(long,long)" [Opcodes/LREM]
20 | "public static long clojure.lang.Numbers.shiftLeft(long,long)" [Opcodes/L2I Opcodes/LSHL]
21 | "public static long clojure.lang.Numbers.shiftRight(long,long)" [Opcodes/L2I Opcodes/LSHR]
22 | "public static double clojure.lang.Numbers.minus(double)" [Opcodes/DNEG]
23 | "public static double clojure.lang.Numbers.minus(double,double)" [Opcodes/DSUB]
24 | "public static double clojure.lang.Numbers.inc(double)" [Opcodes/DCONST_1 Opcodes/DADD]
25 | "public static double clojure.lang.Numbers.dec(double)" [Opcodes/DCONST_1 Opcodes/DSUB]
26 | "public static long clojure.lang.Numbers.quotient(long,long)" [Opcodes/LDIV]
27 | "public static int clojure.lang.Numbers.shiftLeftInt(int,int)" [Opcodes/ISHL]
28 | "public static int clojure.lang.Numbers.shiftRightInt(int,int)" [Opcodes/ISHR]
29 | "public static int clojure.lang.Numbers.unchecked_int_add(int,int)" [Opcodes/IADD]
30 | "public static int clojure.lang.Numbers.unchecked_int_subtract(int,int)" [Opcodes/ISUB]
31 | "public static int clojure.lang.Numbers.unchecked_int_negate(int)" [Opcodes/INEG]
32 | "public static int clojure.lang.Numbers.unchecked_int_inc(int)" [Opcodes/ICONST_1 Opcodes/IADD]
33 | "public static int clojure.lang.Numbers.unchecked_int_dec(int)" [Opcodes/ICONST_1 Opcodes/ISUB]
34 | "public static int clojure.lang.Numbers.unchecked_int_multiply(int,int)" [Opcodes/IMUL]
35 | "public static int clojure.lang.Numbers.unchecked_int_divide(int,int)" [Opcodes/IDIV]
36 | "public static int clojure.lang.Numbers.unchecked_int_remainder(int,int)" [Opcodes/IREM]
37 | "public static long clojure.lang.Numbers.unchecked_add(long,long)" [Opcodes/LADD]
38 | "public static double clojure.lang.Numbers.unchecked_add(double,double)" [Opcodes/DADD]
39 | "public static long clojure.lang.Numbers.unchecked_minus(long)" [Opcodes/LNEG]
40 | "public static double clojure.lang.Numbers.unchecked_minus(double)" [Opcodes/DNEG]
41 | "public static double clojure.lang.Numbers.unchecked_minus(double,double)" [Opcodes/DSUB]
42 | "public static long clojure.lang.Numbers.unchecked_minus(long,long)" [Opcodes/LSUB]
43 | "public static long clojure.lang.Numbers.unchecked_multiply(long,long)" [Opcodes/LMUL]
44 | "public static double clojure.lang.Numbers.unchecked_multiply(double,double)" [Opcodes/DMUL]
45 | "public static double clojure.lang.Numbers.unchecked_inc(double)" [Opcodes/DCONST_1 Opcodes/DADD]
46 | "public static long clojure.lang.Numbers.unchecked_inc(long)" [Opcodes/LCONST_1 Opcodes/LADD]
47 | "public static double clojure.lang.Numbers.unchecked_dec(double)" [Opcodes/DCONST_1 Opcodes/DSUB]
48 | "public static long clojure.lang.Numbers.unchecked_dec(long)" [Opcodes/LCONST_1 Opcodes/LSUB]
49 |
50 | "public static short clojure.lang.RT.aget(short[]int)" [Opcodes/SALOAD]
51 | "public static float clojure.lang.RT.aget(float[]int)" [Opcodes/FALOAD]
52 | "public static double clojure.lang.RT.aget(double[]int)" [Opcodes/DALOAD]
53 | "public static int clojure.lang.RT.aget(int[]int)" [Opcodes/IALOAD]
54 | "public static long clojure.lang.RT.aget(long[]int)" [Opcodes/LALOAD]
55 | "public static char clojure.lang.RT.aget(char[]int)" [Opcodes/CALOAD]
56 | "public static byte clojure.lang.RT.aget(byte[]int)" [Opcodes/BALOAD]
57 | "public static boolean clojure.lang.RT.aget(boolean[]int)" [Opcodes/BALOAD]
58 | "public static java.lang.Object clojure.lang.RT.aget(java.lang.Object[]int)" [Opcodes/AALOAD]
59 | "public static int clojure.lang.RT.alength(int[])" [Opcodes/ARRAYLENGTH]
60 | "public static int clojure.lang.RT.alength(long[])" [Opcodes/ARRAYLENGTH]
61 | "public static int clojure.lang.RT.alength(char[])" [Opcodes/ARRAYLENGTH]
62 | "public static int clojure.lang.RT.alength(java.lang.Object[])" [Opcodes/ARRAYLENGTH]
63 | "public static int clojure.lang.RT.alength(byte[])" [Opcodes/ARRAYLENGTH]
64 | "public static int clojure.lang.RT.alength(float[])" [Opcodes/ARRAYLENGTH]
65 | "public static int clojure.lang.RT.alength(short[])" [Opcodes/ARRAYLENGTH]
66 | "public static int clojure.lang.RT.alength(boolean[])" [Opcodes/ARRAYLENGTH]
67 | "public static int clojure.lang.RT.alength(double[])" [Opcodes/ARRAYLENGTH]
68 |
69 | "public static double clojure.lang.RT.doubleCast(long)" [Opcodes/L2D]
70 | "public static double clojure.lang.RT.doubleCast(double)" [Opcodes/NOP]
71 | "public static double clojure.lang.RT.doubleCast(float)" [Opcodes/F2D]
72 | "public static double clojure.lang.RT.doubleCast(int)" [Opcodes/I2D]
73 | "public static double clojure.lang.RT.doubleCast(short)" [Opcodes/I2D]
74 | "public static double clojure.lang.RT.doubleCast(byte)" [Opcodes/I2D]
75 | "public static double clojure.lang.RT.uncheckedDoubleCast(double)" [Opcodes/NOP]
76 | "public static double clojure.lang.RT.uncheckedDoubleCast(float)" [Opcodes/F2D]
77 | "public static double clojure.lang.RT.uncheckedDoubleCast(long)" [Opcodes/L2D]
78 | "public static double clojure.lang.RT.uncheckedDoubleCast(int)" [Opcodes/I2D]
79 | "public static double clojure.lang.RT.uncheckedDoubleCast(short)" [Opcodes/I2D]
80 | "public static double clojure.lang.RT.uncheckedDoubleCast(byte)" [Opcodes/I2D]
81 | "public static long clojure.lang.RT.longCast(long)" [Opcodes/NOP]
82 | "public static long clojure.lang.RT.longCast(short)" [Opcodes/I2L]
83 | "public static long clojure.lang.RT.longCast(byte)" [Opcodes/I2L]
84 | "public static long clojure.lang.RT.longCast(int)" [Opcodes/I2L]
85 | "public static int clojure.lang.RT.uncheckedIntCast(long)" [Opcodes/L2I]
86 | "public static int clojure.lang.RT.uncheckedIntCast(double)" [Opcodes/D2I]
87 | "public static int clojure.lang.RT.uncheckedIntCast(byte)" [Opcodes/NOP]
88 | "public static int clojure.lang.RT.uncheckedIntCast(short)" [Opcodes/NOP]
89 | "public static int clojure.lang.RT.uncheckedIntCast(char)" [Opcodes/NOP]
90 | "public static int clojure.lang.RT.uncheckedIntCast(int)" [Opcodes/NOP]
91 | "public static int clojure.lang.RT.uncheckedIntCast(float)" [Opcodes/F2I]
92 | "public static long clojure.lang.RT.uncheckedLongCast(short)" [Opcodes/I2L]
93 | "public static long clojure.lang.RT.uncheckedLongCast(float)" [Opcodes/F2L]
94 | "public static long clojure.lang.RT.uncheckedLongCast(double)" [Opcodes/D2L]
95 | "public static long clojure.lang.RT.uncheckedLongCast(byte)" [Opcodes/I2L]
96 | "public static long clojure.lang.RT.uncheckedLongCast(long)" [Opcodes/NOP]
97 | "public static long clojure.lang.RT.uncheckedLongCast(int)" [Opcodes/I2L]})
98 |
99 | (def intrinsic-predicate
100 | {"public static boolean clojure.lang.Numbers.lt(double,double)" [Opcodes/DCMPG Opcodes/IFGE]
101 | "public static boolean clojure.lang.Numbers.lt(long,long)" [Opcodes/LCMP Opcodes/IFGE]
102 | "public static boolean clojure.lang.Numbers.equiv(double,double)" [Opcodes/DCMPL Opcodes/IFNE]
103 | "public static boolean clojure.lang.Numbers.equiv(long,long)" [Opcodes/LCMP Opcodes/IFNE]
104 | "public static boolean clojure.lang.Numbers.lte(double,double)" [Opcodes/DCMPG Opcodes/IFGT]
105 | "public static boolean clojure.lang.Numbers.lte(long,long)" [Opcodes/LCMP Opcodes/IFGT]
106 | "public static boolean clojure.lang.Numbers.gt(long,long)" [Opcodes/LCMP Opcodes/IFLE]
107 | "public static boolean clojure.lang.Numbers.gt(double,double)" [Opcodes/DCMPL Opcodes/IFLE]
108 | "public static boolean clojure.lang.Numbers.gte(long,long)" [Opcodes/LCMP Opcodes/IFLT]
109 | "public static boolean clojure.lang.Numbers.gte(double,double)" [Opcodes/DCMPL Opcodes/IFLT]
110 | "public static boolean clojure.lang.Util.equiv(long,long)" [Opcodes/LCMP Opcodes/IFNE]
111 | "public static boolean clojure.lang.Util.equiv(boolean,boolean)" [Opcodes/IF_ICMPNE]
112 | "public static boolean clojure.lang.Util.equiv(double,double)" [Opcodes/DCMPL Opcodes/IFNE]
113 |
114 | "public static boolean clojure.lang.Numbers.isZero(double)" [Opcodes/DCONST_0 Opcodes/DCMPL Opcodes/IFNE]
115 | "public static boolean clojure.lang.Numbers.isZero(long)" [Opcodes/LCONST_0 Opcodes/LCMP Opcodes/IFNE]
116 | "public static boolean clojure.lang.Numbers.isPos(long)" [Opcodes/LCONST_0 Opcodes/LCMP Opcodes/IFLE]
117 | "public static boolean clojure.lang.Numbers.isPos(double)" [Opcodes/DCONST_0 Opcodes/DCMPL Opcodes/IFLE]
118 | "public static boolean clojure.lang.Numbers.isNeg(long)" [Opcodes/LCONST_0 Opcodes/LCMP Opcodes/IFGE]
119 | "public static boolean clojure.lang.Numbers.isNeg(double)" [Opcodes/DCONST_0 Opcodes/DCMPG Opcodes/IFGE]})
120 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | Eclipse Public License - v 1.0
2 |
3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC
4 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM
5 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.
6 |
7 | 1. DEFINITIONS
8 |
9 | "Contribution" means:
10 |
11 | a) in the case of the initial Contributor, the initial code and documentation
12 | distributed under this Agreement, and
13 | b) in the case of each subsequent Contributor:
14 | i) changes to the Program, and
15 | ii) additions to the Program;
16 |
17 | where such changes and/or additions to the Program originate from and are
18 | distributed by that particular Contributor. A Contribution 'originates'
19 | from a Contributor if it was added to the Program by such Contributor
20 | itself or anyone acting on such Contributor's behalf. Contributions do not
21 | include additions to the Program which: (i) are separate modules of
22 | software distributed in conjunction with the Program under their own
23 | license agreement, and (ii) are not derivative works of the Program.
24 |
25 | "Contributor" means any person or entity that distributes the Program.
26 |
27 | "Licensed Patents" mean patent claims licensable by a Contributor which are
28 | necessarily infringed by the use or sale of its Contribution alone or when
29 | combined with the Program.
30 |
31 | "Program" means the Contributions distributed in accordance with this
32 | Agreement.
33 |
34 | "Recipient" means anyone who receives the Program under this Agreement,
35 | including all Contributors.
36 |
37 | 2. GRANT OF RIGHTS
38 | a) Subject to the terms of this Agreement, each Contributor hereby grants
39 | Recipient a non-exclusive, worldwide, royalty-free copyright license to
40 | reproduce, prepare derivative works of, publicly display, publicly
41 | perform, distribute and sublicense the Contribution of such Contributor,
42 | if any, and such derivative works, in source code and object code form.
43 | b) Subject to the terms of this Agreement, each Contributor hereby grants
44 | Recipient a non-exclusive, worldwide, royalty-free patent license under
45 | Licensed Patents to make, use, sell, offer to sell, import and otherwise
46 | transfer the Contribution of such Contributor, if any, in source code and
47 | object code form. This patent license shall apply to the combination of
48 | the Contribution and the Program if, at the time the Contribution is
49 | added by the Contributor, such addition of the Contribution causes such
50 | combination to be covered by the Licensed Patents. The patent license
51 | shall not apply to any other combinations which include the Contribution.
52 | No hardware per se is licensed hereunder.
53 | c) Recipient understands that although each Contributor grants the licenses
54 | to its Contributions set forth herein, no assurances are provided by any
55 | Contributor that the Program does not infringe the patent or other
56 | intellectual property rights of any other entity. Each Contributor
57 | disclaims any liability to Recipient for claims brought by any other
58 | entity based on infringement of intellectual property rights or
59 | otherwise. As a condition to exercising the rights and licenses granted
60 | hereunder, each Recipient hereby assumes sole responsibility to secure
61 | any other intellectual property rights needed, if any. For example, if a
62 | third party patent license is required to allow Recipient to distribute
63 | the Program, it is Recipient's responsibility to acquire that license
64 | before distributing the Program.
65 | d) Each Contributor represents that to its knowledge it has sufficient
66 | copyright rights in its Contribution, if any, to grant the copyright
67 | license set forth in this Agreement.
68 |
69 | 3. REQUIREMENTS
70 |
71 | A Contributor may choose to distribute the Program in object code form under
72 | its own license agreement, provided that:
73 |
74 | a) it complies with the terms and conditions of this Agreement; and
75 | b) its license agreement:
76 | i) effectively disclaims on behalf of all Contributors all warranties
77 | and conditions, express and implied, including warranties or
78 | conditions of title and non-infringement, and implied warranties or
79 | conditions of merchantability and fitness for a particular purpose;
80 | ii) effectively excludes on behalf of all Contributors all liability for
81 | damages, including direct, indirect, special, incidental and
82 | consequential damages, such as lost profits;
83 | iii) states that any provisions which differ from this Agreement are
84 | offered by that Contributor alone and not by any other party; and
85 | iv) states that source code for the Program is available from such
86 | Contributor, and informs licensees how to obtain it in a reasonable
87 | manner on or through a medium customarily used for software exchange.
88 |
89 | When the Program is made available in source code form:
90 |
91 | a) it must be made available under this Agreement; and
92 | b) a copy of this Agreement must be included with each copy of the Program.
93 | Contributors may not remove or alter any copyright notices contained
94 | within the Program.
95 |
96 | Each Contributor must identify itself as the originator of its Contribution,
97 | if
98 | any, in a manner that reasonably allows subsequent Recipients to identify the
99 | originator of the Contribution.
100 |
101 | 4. COMMERCIAL DISTRIBUTION
102 |
103 | Commercial distributors of software may accept certain responsibilities with
104 | respect to end users, business partners and the like. While this license is
105 | intended to facilitate the commercial use of the Program, the Contributor who
106 | includes the Program in a commercial product offering should do so in a manner
107 | which does not create potential liability for other Contributors. Therefore,
108 | if a Contributor includes the Program in a commercial product offering, such
109 | Contributor ("Commercial Contributor") hereby agrees to defend and indemnify
110 | every other Contributor ("Indemnified Contributor") against any losses,
111 | damages and costs (collectively "Losses") arising from claims, lawsuits and
112 | other legal actions brought by a third party against the Indemnified
113 | Contributor to the extent caused by the acts or omissions of such Commercial
114 | Contributor in connection with its distribution of the Program in a commercial
115 | product offering. The obligations in this section do not apply to any claims
116 | or Losses relating to any actual or alleged intellectual property
117 | infringement. In order to qualify, an Indemnified Contributor must:
118 | a) promptly notify the Commercial Contributor in writing of such claim, and
119 | b) allow the Commercial Contributor to control, and cooperate with the
120 | Commercial Contributor in, the defense and any related settlement
121 | negotiations. The Indemnified Contributor may participate in any such claim at
122 | its own expense.
123 |
124 | For example, a Contributor might include the Program in a commercial product
125 | offering, Product X. That Contributor is then a Commercial Contributor. If
126 | that Commercial Contributor then makes performance claims, or offers
127 | warranties related to Product X, those performance claims and warranties are
128 | such Commercial Contributor's responsibility alone. Under this section, the
129 | Commercial Contributor would have to defend claims against the other
130 | Contributors related to those performance claims and warranties, and if a
131 | court requires any other Contributor to pay any damages as a result, the
132 | Commercial Contributor must pay those damages.
133 |
134 | 5. NO WARRANTY
135 |
136 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN
137 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR
138 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE,
139 | NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each
140 | Recipient is solely responsible for determining the appropriateness of using
141 | and distributing the Program and assumes all risks associated with its
142 | exercise of rights under this Agreement , including but not limited to the
143 | risks and costs of program errors, compliance with applicable laws, damage to
144 | or loss of data, programs or equipment, and unavailability or interruption of
145 | operations.
146 |
147 | 6. DISCLAIMER OF LIABILITY
148 |
149 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY
150 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL,
151 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION
152 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
153 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
154 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE
155 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY
156 | OF SUCH DAMAGES.
157 |
158 | 7. GENERAL
159 |
160 | If any provision of this Agreement is invalid or unenforceable under
161 | applicable law, it shall not affect the validity or enforceability of the
162 | remainder of the terms of this Agreement, and without further action by the
163 | parties hereto, such provision shall be reformed to the minimum extent
164 | necessary to make such provision valid and enforceable.
165 |
166 | If Recipient institutes patent litigation against any entity (including a
167 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself
168 | (excluding combinations of the Program with other software or hardware)
169 | infringes such Recipient's patent(s), then such Recipient's rights granted
170 | under Section 2(b) shall terminate as of the date such litigation is filed.
171 |
172 | All Recipient's rights under this Agreement shall terminate if it fails to
173 | comply with any of the material terms or conditions of this Agreement and does
174 | not cure such failure in a reasonable period of time after becoming aware of
175 | such noncompliance. If all Recipient's rights under this Agreement terminate,
176 | Recipient agrees to cease use and distribution of the Program as soon as
177 | reasonably practicable. However, Recipient's obligations under this Agreement
178 | and any licenses granted by Recipient relating to the Program shall continue
179 | and survive.
180 |
181 | Everyone is permitted to copy and distribute copies of this Agreement, but in
182 | order to avoid inconsistency the Agreement is copyrighted and may only be
183 | modified in the following manner. The Agreement Steward reserves the right to
184 | publish new versions (including revisions) of this Agreement from time to
185 | time. No one other than the Agreement Steward has the right to modify this
186 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The
187 | Eclipse Foundation may assign the responsibility to serve as the Agreement
188 | Steward to a suitable separate entity. Each new version of the Agreement will
189 | be given a distinguishing version number. The Program (including
190 | Contributions) may always be distributed subject to the version of the
191 | Agreement under which it was received. In addition, after a new version of the
192 | Agreement is published, Contributor may elect to distribute the Program
193 | (including its Contributions) under the new version. Except as expressly
194 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or
195 | licenses to the intellectual property of any Contributor under this Agreement,
196 | whether expressly, by implication, estoppel or otherwise. All rights in the
197 | Program not expressly granted under this Agreement are reserved.
198 |
199 | This Agreement is governed by the laws of the State of New York and the
200 | intellectual property laws of the United States of America. No party to this
201 | Agreement will bring a legal action under this Agreement more than one year
202 | after the cause of action arose. Each party waives its rights to a jury trial in
203 | any resulting litigation.
204 |
205 |
206 |
--------------------------------------------------------------------------------
/epl.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 | Eclipse Public License - Version 1.0
8 |
25 |
26 |
27 |
28 |
29 |
30 | Eclipse Public License - v 1.0
31 |
32 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE
33 | PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR
34 | DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS
35 | AGREEMENT.
36 |
37 | 1. DEFINITIONS
38 |
39 | "Contribution" means:
40 |
41 | a) in the case of the initial Contributor, the initial
42 | code and documentation distributed under this Agreement, and
43 | b) in the case of each subsequent Contributor:
44 | i) changes to the Program, and
45 | ii) additions to the Program;
46 | where such changes and/or additions to the Program
47 | originate from and are distributed by that particular Contributor. A
48 | Contribution 'originates' from a Contributor if it was added to the
49 | Program by such Contributor itself or anyone acting on such
50 | Contributor's behalf. Contributions do not include additions to the
51 | Program which: (i) are separate modules of software distributed in
52 | conjunction with the Program under their own license agreement, and (ii)
53 | are not derivative works of the Program.
54 |
55 | "Contributor" means any person or entity that distributes
56 | the Program.
57 |
58 | "Licensed Patents" mean patent claims licensable by a
59 | Contributor which are necessarily infringed by the use or sale of its
60 | Contribution alone or when combined with the Program.
61 |
62 | "Program" means the Contributions distributed in accordance
63 | with this Agreement.
64 |
65 | "Recipient" means anyone who receives the Program under
66 | this Agreement, including all Contributors.
67 |
68 | 2. GRANT OF RIGHTS
69 |
70 | a) Subject to the terms of this Agreement, each
71 | Contributor hereby grants Recipient a non-exclusive, worldwide,
72 | royalty-free copyright license to reproduce, prepare derivative works
73 | of, publicly display, publicly perform, distribute and sublicense the
74 | Contribution of such Contributor, if any, and such derivative works, in
75 | source code and object code form.
76 |
77 | b) Subject to the terms of this Agreement, each
78 | Contributor hereby grants Recipient a non-exclusive, worldwide,
79 | royalty-free patent license under Licensed Patents to make, use, sell,
80 | offer to sell, import and otherwise transfer the Contribution of such
81 | Contributor, if any, in source code and object code form. This patent
82 | license shall apply to the combination of the Contribution and the
83 | Program if, at the time the Contribution is added by the Contributor,
84 | such addition of the Contribution causes such combination to be covered
85 | by the Licensed Patents. The patent license shall not apply to any other
86 | combinations which include the Contribution. No hardware per se is
87 | licensed hereunder.
88 |
89 | c) Recipient understands that although each Contributor
90 | grants the licenses to its Contributions set forth herein, no assurances
91 | are provided by any Contributor that the Program does not infringe the
92 | patent or other intellectual property rights of any other entity. Each
93 | Contributor disclaims any liability to Recipient for claims brought by
94 | any other entity based on infringement of intellectual property rights
95 | or otherwise. As a condition to exercising the rights and licenses
96 | granted hereunder, each Recipient hereby assumes sole responsibility to
97 | secure any other intellectual property rights needed, if any. For
98 | example, if a third party patent license is required to allow Recipient
99 | to distribute the Program, it is Recipient's responsibility to acquire
100 | that license before distributing the Program.
101 |
102 | d) Each Contributor represents that to its knowledge it
103 | has sufficient copyright rights in its Contribution, if any, to grant
104 | the copyright license set forth in this Agreement.
105 |
106 | 3. REQUIREMENTS
107 |
108 | A Contributor may choose to distribute the Program in object code
109 | form under its own license agreement, provided that:
110 |
111 | a) it complies with the terms and conditions of this
112 | Agreement; and
113 |
114 | b) its license agreement:
115 |
116 | i) effectively disclaims on behalf of all Contributors
117 | all warranties and conditions, express and implied, including warranties
118 | or conditions of title and non-infringement, and implied warranties or
119 | conditions of merchantability and fitness for a particular purpose;
120 |
121 | ii) effectively excludes on behalf of all Contributors
122 | all liability for damages, including direct, indirect, special,
123 | incidental and consequential damages, such as lost profits;
124 |
125 | iii) states that any provisions which differ from this
126 | Agreement are offered by that Contributor alone and not by any other
127 | party; and
128 |
129 | iv) states that source code for the Program is available
130 | from such Contributor, and informs licensees how to obtain it in a
131 | reasonable manner on or through a medium customarily used for software
132 | exchange.
133 |
134 | When the Program is made available in source code form:
135 |
136 | a) it must be made available under this Agreement; and
137 |
138 | b) a copy of this Agreement must be included with each
139 | copy of the Program.
140 |
141 | Contributors may not remove or alter any copyright notices contained
142 | within the Program.
143 |
144 | Each Contributor must identify itself as the originator of its
145 | Contribution, if any, in a manner that reasonably allows subsequent
146 | Recipients to identify the originator of the Contribution.
147 |
148 | 4. COMMERCIAL DISTRIBUTION
149 |
150 | Commercial distributors of software may accept certain
151 | responsibilities with respect to end users, business partners and the
152 | like. While this license is intended to facilitate the commercial use of
153 | the Program, the Contributor who includes the Program in a commercial
154 | product offering should do so in a manner which does not create
155 | potential liability for other Contributors. Therefore, if a Contributor
156 | includes the Program in a commercial product offering, such Contributor
157 | ("Commercial Contributor") hereby agrees to defend and
158 | indemnify every other Contributor ("Indemnified Contributor")
159 | against any losses, damages and costs (collectively "Losses")
160 | arising from claims, lawsuits and other legal actions brought by a third
161 | party against the Indemnified Contributor to the extent caused by the
162 | acts or omissions of such Commercial Contributor in connection with its
163 | distribution of the Program in a commercial product offering. The
164 | obligations in this section do not apply to any claims or Losses
165 | relating to any actual or alleged intellectual property infringement. In
166 | order to qualify, an Indemnified Contributor must: a) promptly notify
167 | the Commercial Contributor in writing of such claim, and b) allow the
168 | Commercial Contributor to control, and cooperate with the Commercial
169 | Contributor in, the defense and any related settlement negotiations. The
170 | Indemnified Contributor may participate in any such claim at its own
171 | expense.
172 |
173 | For example, a Contributor might include the Program in a commercial
174 | product offering, Product X. That Contributor is then a Commercial
175 | Contributor. If that Commercial Contributor then makes performance
176 | claims, or offers warranties related to Product X, those performance
177 | claims and warranties are such Commercial Contributor's responsibility
178 | alone. Under this section, the Commercial Contributor would have to
179 | defend claims against the other Contributors related to those
180 | performance claims and warranties, and if a court requires any other
181 | Contributor to pay any damages as a result, the Commercial Contributor
182 | must pay those damages.
183 |
184 | 5. NO WARRANTY
185 |
186 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS
187 | PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS
188 | OF ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION,
189 | ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY
190 | OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely
191 | responsible for determining the appropriateness of using and
192 | distributing the Program and assumes all risks associated with its
193 | exercise of rights under this Agreement , including but not limited to
194 | the risks and costs of program errors, compliance with applicable laws,
195 | damage to or loss of data, programs or equipment, and unavailability or
196 | interruption of operations.
197 |
198 | 6. DISCLAIMER OF LIABILITY
199 |
200 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT
201 | NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT,
202 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING
203 | WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF
204 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
205 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR
206 | DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED
207 | HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
208 |
209 | 7. GENERAL
210 |
211 | If any provision of this Agreement is invalid or unenforceable under
212 | applicable law, it shall not affect the validity or enforceability of
213 | the remainder of the terms of this Agreement, and without further action
214 | by the parties hereto, such provision shall be reformed to the minimum
215 | extent necessary to make such provision valid and enforceable.
216 |
217 | If Recipient institutes patent litigation against any entity
218 | (including a cross-claim or counterclaim in a lawsuit) alleging that the
219 | Program itself (excluding combinations of the Program with other
220 | software or hardware) infringes such Recipient's patent(s), then such
221 | Recipient's rights granted under Section 2(b) shall terminate as of the
222 | date such litigation is filed.
223 |
224 | All Recipient's rights under this Agreement shall terminate if it
225 | fails to comply with any of the material terms or conditions of this
226 | Agreement and does not cure such failure in a reasonable period of time
227 | after becoming aware of such noncompliance. If all Recipient's rights
228 | under this Agreement terminate, Recipient agrees to cease use and
229 | distribution of the Program as soon as reasonably practicable. However,
230 | Recipient's obligations under this Agreement and any licenses granted by
231 | Recipient relating to the Program shall continue and survive.
232 |
233 | Everyone is permitted to copy and distribute copies of this
234 | Agreement, but in order to avoid inconsistency the Agreement is
235 | copyrighted and may only be modified in the following manner. The
236 | Agreement Steward reserves the right to publish new versions (including
237 | revisions) of this Agreement from time to time. No one other than the
238 | Agreement Steward has the right to modify this Agreement. The Eclipse
239 | Foundation is the initial Agreement Steward. The Eclipse Foundation may
240 | assign the responsibility to serve as the Agreement Steward to a
241 | suitable separate entity. Each new version of the Agreement will be
242 | given a distinguishing version number. The Program (including
243 | Contributions) may always be distributed subject to the version of the
244 | Agreement under which it was received. In addition, after a new version
245 | of the Agreement is published, Contributor may elect to distribute the
246 | Program (including its Contributions) under the new version. Except as
247 | expressly stated in Sections 2(a) and 2(b) above, Recipient receives no
248 | rights or licenses to the intellectual property of any Contributor under
249 | this Agreement, whether expressly, by implication, estoppel or
250 | otherwise. All rights in the Program not expressly granted under this
251 | Agreement are reserved.
252 |
253 | This Agreement is governed by the laws of the State of New York and
254 | the intellectual property laws of the United States of America. No party
255 | to this Agreement will bring a legal action under this Agreement more
256 | than one year after the cause of action arose. Each party waives its
257 | rights to a jury trial in any resulting litigation.
258 |
259 |
260 |
261 |
262 |
--------------------------------------------------------------------------------
/src/main/clojure/clojure/tools/emitter/jvm/transform.clj:
--------------------------------------------------------------------------------
1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors.
2 | ;; The use and distribution terms for this software are covered by the
3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 | ;; which can be found in the file epl-v10.html at the root of this distribution.
5 | ;; By using this software in any fashion, you are agreeing to be bound by
6 | ;; the terms of this license.
7 | ;; You must not remove this notice, or any other, from this software.
8 |
9 | (ns clojure.tools.emitter.jvm.transform
10 | (:refer-clojure :exclude [type ints longs floats doubles chars shorts bytes booleans])
11 | (:require [clojure.string :as s]
12 | [clojure.tools.analyzer.jvm.utils :refer [maybe-class]]
13 | [clojure.tools.analyzer.utils :refer [boolean?]]
14 | [clojure.core.memoize :refer [lru]]
15 | [clojure.reflect :as r])
16 | (:import (org.objectweb.asm Type Label Opcodes ClassWriter ClassReader)
17 | (org.objectweb.asm.commons GeneratorAdapter Method)
18 | (org.objectweb.asm.util CheckClassAdapter TraceClassVisitor)))
19 |
20 | (def ^:const objects (class (object-array [])))
21 | (def ^:const ints (class (int-array [])))
22 | (def ^:const longs (class (long-array [])))
23 | (def ^:const floats (class (float-array [])))
24 | (def ^:const doubles (class (double-array [])))
25 | (def ^:const chars (class (char-array [])))
26 | (def ^:const shorts (class (short-array [])))
27 | (def ^:const bytes (class (byte-array [])))
28 | (def ^:const booleans (class (boolean-array [])))
29 |
30 |
31 | (defn special [c]
32 | (case (name c)
33 | "int" Integer/TYPE
34 | "float" Float/TYPE
35 | "void" Void/TYPE
36 | "long" Long/TYPE
37 | "byte" Byte/TYPE
38 | "short" Short/TYPE
39 | "char" Character/TYPE
40 | "double" Double/TYPE
41 | "boolean" Boolean/TYPE
42 |
43 | "objects" objects
44 | "ints" ints
45 | "longs" longs
46 | "floats" floats
47 | "doubles" doubles
48 | "chars" chars
49 | "shorts" shorts
50 | "bytes" bytes
51 | "booleans" booleans
52 |
53 | nil))
54 |
55 | (def typename (lru r/typename))
56 |
57 | (defn type-str [x]
58 | (cond
59 |
60 | (class? x)
61 | (typename x)
62 |
63 | (special x)
64 | (typename (special x))
65 |
66 | :else
67 | (name x)))
68 |
69 | (defn method-desc [ret method args]
70 | (Method/getMethod (str (type-str ret) " "
71 | (name method)
72 | \( (s/join ", " (map type-str args)) \))))
73 |
74 | (def ^:dynamic *labels*)
75 | (def ^:dynamic *locals*)
76 |
77 | (defmulti -compile :op)
78 | (defmulti -exec (fn [op _ _] op))
79 |
80 | (declare type)
81 | (defn omit? [[pre-i & pre-a] [i & a] [post-i & post-a]]
82 | (when (= :check-cast i)
83 | (let [check-cast (type (first a))]
84 | (cond
85 |
86 | (= :check-cast post-i)
87 | true
88 |
89 | (#{:invoke-static :invoke-virtual :invoke-interface
90 | :invoke-constructor :get-static :get-field} pre-i)
91 | (= (type (last pre-a)) check-cast)
92 | ;; (#{:put-static :put-field} post-i)
93 | ;; (= (type (last post-a)) check-cast)
94 |
95 | :else
96 | (= :return-value post-i)))))
97 |
98 | (defn transform [gen bc]
99 | (binding [*locals* (atom {:locals {} :next-id 0})
100 | *labels* (atom {})]
101 | (loop [pre nil
102 | [inst & args :as cur] (first bc)
103 | bc (next bc)]
104 | (when cur
105 | (when-not (omit? pre cur (first bc))
106 | (-exec inst args gen))
107 | (recur cur (first bc) (next bc))))))
108 |
109 | (def ^Class get-class
110 | (lru
111 | (fn [type-desc]
112 | (cond
113 | (nil? type-desc)
114 | Object
115 |
116 | (class? type-desc)
117 | type-desc
118 |
119 | (special type-desc)
120 | (special type-desc)
121 |
122 | :else
123 | (try
124 | (Class/forName (name type-desc))
125 | (catch ClassNotFoundException e))))))
126 |
127 | (def ^Type type
128 | (lru
129 | (fn [type-desc]
130 | (if-let [class (get-class type-desc)]
131 | (Type/getType class)
132 | (Type/getObjectType (s/replace type-desc \. \/))))))
133 |
134 | (defmethod -exec :invoke-static
135 | [_ [[method & args] ret] ^GeneratorAdapter gen]
136 | (let [[class method-name]
137 | [(namespace method) (name method)]]
138 | (.invokeStatic gen (type class) (method-desc ret method-name args))))
139 |
140 | (defmethod -exec :invoke-virtual
141 | [_ [[method & args] ret] ^GeneratorAdapter gen]
142 | (let [[class method-name]
143 | [(namespace method) (name method)]]
144 | (.invokeVirtual gen (type class) (method-desc ret method-name args))))
145 |
146 | (defmethod -exec :invoke-interface
147 | [_ [[method & args] ret] ^GeneratorAdapter gen]
148 | (let [[class method-name]
149 | [(namespace method) (name method)]]
150 | (.invokeInterface gen (type class) (method-desc ret method-name args))))
151 |
152 | (defmethod -exec :invoke-constructor
153 | [_ [[method & args] ret] ^GeneratorAdapter gen]
154 | (let [[class method-name]
155 | [(namespace method) (name method)]]
156 | (.invokeConstructor gen (type class) (method-desc ret method-name args))))
157 |
158 | (defmethod -exec :check-cast
159 | [_ [class] ^GeneratorAdapter gen]
160 | (.checkCast gen (type class)))
161 |
162 | (defmethod -exec :no-op
163 | [_ _ _])
164 |
165 | (defmethod -exec :new-array
166 | [_ [class] ^GeneratorAdapter gen]
167 | (.newArray gen (type class)))
168 |
169 | (defmethod -exec :array-store
170 | [_ [class] ^GeneratorAdapter gen]
171 | (.arrayStore gen (type class)))
172 |
173 | (defmethod -exec :new-instance
174 | [_ [class] ^GeneratorAdapter gen]
175 | (.newInstance gen (type class)))
176 |
177 | (defmethod -exec :instance-of
178 | [_ [class] ^GeneratorAdapter gen]
179 | (.instanceOf gen (type class)))
180 |
181 | (defmethod -exec :get-static
182 | [_ args ^GeneratorAdapter gen]
183 | (let [[class field tag]
184 | (if (= 3 (count args))
185 | args
186 | [(namespace (first args)) (name (first args)) (second args)])]
187 | (.getStatic gen (type class) (munge (name field)) (type tag))))
188 |
189 | (defmethod -exec :put-static
190 | [_ args ^GeneratorAdapter gen]
191 | (let [[class field tag]
192 | (if (= 3 (count args))
193 | args
194 | [(namespace (first args)) (name (first args)) (second args)])]
195 | (.putStatic gen (type class) (munge (name field)) (type tag))))
196 |
197 | (defmethod -exec :get-field
198 | [_ args ^GeneratorAdapter gen]
199 | (let [[class field tag]
200 | (if (= 3 (count args))
201 | args
202 | [(namespace (first args)) (name (first args)) (second args)])]
203 | (.getField gen (type class) (munge (name field)) (type tag))))
204 |
205 | (defmethod -exec :put-field
206 | [_ args ^GeneratorAdapter gen]
207 | (let [[class field tag]
208 | (if (= 3 (count args))
209 | args
210 | [(namespace (first args)) (name (first args)) (second args)])]
211 | (.putField gen (type class) (munge (name field)) (type tag))))
212 |
213 | (defn get-label [^GeneratorAdapter gen label]
214 | (or (@*labels* label)
215 | (let [l (.newLabel gen)]
216 | (swap! *labels* assoc label l)
217 | l)))
218 |
219 | (defmethod -exec :mark
220 | [_ [label] ^GeneratorAdapter gen]
221 | (.mark gen (get-label gen label)))
222 |
223 | (defmethod -exec :label
224 | [_ [label] ^GeneratorAdapter gen]
225 | (.visitLabel gen (get-label gen label)))
226 |
227 | (defmethod -exec :go-to
228 | [_ [label] ^GeneratorAdapter gen]
229 | (.goTo gen (get-label gen label)))
230 |
231 | (defmethod -exec :start-method
232 | [_ _ ^GeneratorAdapter gen]
233 | (.visitCode gen))
234 |
235 | (defmethod -exec :end-method
236 | [_ _ ^GeneratorAdapter gen]
237 | (.endMethod gen))
238 |
239 | (defmethod -exec :return-value
240 | [_ _ ^GeneratorAdapter gen]
241 | (.returnValue gen))
242 |
243 | (defmethod -exec :load-this
244 | [_ _ ^GeneratorAdapter gen]
245 | (.loadThis gen))
246 |
247 | (defmethod -exec :load-args
248 | [_ _ ^GeneratorAdapter gen]
249 | (.loadArgs gen))
250 |
251 | (defmethod -exec :swap
252 | [_ _ ^GeneratorAdapter gen]
253 | (.swap gen))
254 |
255 | (defmethod -exec :dup
256 | [_ _ ^GeneratorAdapter gen]
257 | (.dup gen))
258 |
259 | (defmethod -exec :dup-x1
260 | [_ _ ^GeneratorAdapter gen]
261 | (.dupX1 gen))
262 |
263 | (defmethod -exec :dup-x2
264 | [_ _ ^GeneratorAdapter gen]
265 | (.dupX2 gen))
266 |
267 | (defmethod -exec :dup2
268 | [_ _ ^GeneratorAdapter gen]
269 | (.dup2 gen))
270 |
271 | (defmethod -exec :dup2-x1
272 | [_ _ ^GeneratorAdapter gen]
273 | (.dup2X1 gen))
274 |
275 | (defmethod -exec :dup2-x2
276 | [_ _ ^GeneratorAdapter gen]
277 | (.dup2X2 gen))
278 |
279 | (defmethod -exec :pop
280 | [_ _ ^GeneratorAdapter gen]
281 | (.pop gen))
282 |
283 | (defmethod -exec :pop2
284 | [_ _ ^GeneratorAdapter gen]
285 | (.pop2 gen))
286 |
287 | (defmethod -exec :throw-exception
288 | [_ _ ^GeneratorAdapter gen]
289 | (.throwException gen))
290 |
291 | (defmethod -exec :monitor-enter
292 | [_ _ ^GeneratorAdapter gen]
293 | (.monitorEnter gen))
294 |
295 | (defmethod -exec :monitor-exit
296 | [_ _ ^GeneratorAdapter gen]
297 | (.monitorExit gen))
298 |
299 | (defn opcode [op]
300 | (cond
301 | (integer? op)
302 | op
303 |
304 | (nil? op)
305 | 0
306 |
307 | :else
308 | (case (name op)
309 | "ISTORE" Opcodes/ISTORE
310 | "ILOAD" Opcodes/ILOAD
311 | "ACONST_NULL" Opcodes/ACONST_NULL
312 | "IF_ACMPEQ" Opcodes/IF_ACMPEQ
313 | "IF_ACMPNE" Opcodes/IF_ACMPNE
314 | "ISHR" Opcodes/ISHR
315 | "IAND" Opcodes/IAND
316 | "public" Opcodes/ACC_PUBLIC
317 | "bridge" Opcodes/ACC_BRIDGE
318 | "super" Opcodes/ACC_SUPER
319 | "final" Opcodes/ACC_FINAL
320 | "static" Opcodes/ACC_STATIC
321 | "private" Opcodes/ACC_PRIVATE
322 | "volatile-mutable" Opcodes/ACC_VOLATILE
323 | "unsynchronized-mutable" 0
324 | "EQ" GeneratorAdapter/EQ
325 | "NE" GeneratorAdapter/NE)))
326 |
327 | (defmethod -exec :insn
328 | [_ [insn] ^GeneratorAdapter gen]
329 | (.visitInsn gen (opcode insn)))
330 |
331 | (defmethod -exec :jump-insn
332 | [_ [insn label] ^GeneratorAdapter gen]
333 | (.visitJumpInsn gen (opcode insn) (get-label gen label)))
334 |
335 | (defmethod -exec :if-null
336 | [_ [label] ^GeneratorAdapter gen]
337 | (.ifNull gen (get-label gen label)))
338 |
339 | (defmethod -exec :if-z-cmp
340 | [_ [insn label] ^GeneratorAdapter gen]
341 | (.ifZCmp gen (opcode insn) (get-label gen label)))
342 |
343 | (defmethod -exec :if-cmp
344 | [_ [t insn label] ^GeneratorAdapter gen]
345 | (.ifCmp gen (type t) (opcode insn) (get-label gen label)))
346 |
347 | (defn get-local
348 | ([local] (get-local local nil))
349 | ([local tag]
350 | (if (integer? local)
351 | local
352 | (let [{:keys [locals next-id]} @*locals*]
353 | (or (locals local)
354 | (do
355 | (swap! *locals* #(assoc-in % [:locals local] next-id))
356 | (swap! *locals* update-in [:next-id]
357 | (if (#{Long/TYPE Double/TYPE} (get-class tag))
358 | #(+ 2 %)
359 | inc))
360 |
361 | next-id))))))
362 |
363 | (defmethod -exec :load-arg
364 | [_ [arg] ^GeneratorAdapter gen]
365 | (.loadArg gen (int arg)))
366 |
367 | (defmethod -exec :store-arg
368 | [_ [arg] ^GeneratorAdapter gen]
369 | (.storeArg gen (int arg)))
370 |
371 | (defmethod -exec :var-insn
372 | [_ [insn local] ^GeneratorAdapter gen]
373 | (.visitVarInsn gen (.getOpcode (type (namespace insn))
374 | (opcode (name insn)))
375 | (get-local local)))
376 |
377 | (defmethod -exec :aload
378 | [_ [local] ^GeneratorAdapter gen]
379 | (.visitVarInsn gen Opcodes/ALOAD (get-local local)))
380 |
381 | (defmethod -exec :astore
382 | [_ [local] ^GeneratorAdapter gen]
383 | (.visitVarInsn gen Opcodes/ASTORE (get-local local)))
384 |
385 | (defn descriptor [tag]
386 | (.getDescriptor (type tag)))
387 |
388 | (defmethod -exec :try-catch-block
389 | [_ [l1 l2 l3 t] ^GeneratorAdapter gen]
390 | (.visitTryCatchBlock gen (get-label gen l1) (get-label gen l2) (get-label gen l3)
391 | (when t (apply str (butlast (rest (descriptor t)))))))
392 |
393 | (defmethod -exec :local-variable
394 | [_ [desc tag _ l1 l2 local] ^GeneratorAdapter gen]
395 | (.visitLocalVariable gen (name desc) (descriptor tag) nil (get-label gen l1)
396 | (get-label gen l2) (get-local local tag)))
397 |
398 | (defmethod -exec :line-number
399 | [_ [line label] ^GeneratorAdapter gen]
400 | (.visitLineNumber gen (int line) (get-label gen label)))
401 |
402 | (defmethod -exec :table-switch-insn
403 | [_ [l h default-label labels] ^GeneratorAdapter gen]
404 | (.visitTableSwitchInsn gen (int (get-local l)) (int (get-local h))
405 | (get-label gen default-label)
406 | (into-array Label (mapv #(get-label gen %) labels))))
407 |
408 | (defmethod -exec :lookup-switch-insn
409 | [_ [l t labels] ^GeneratorAdapter gen]
410 | (.visitLookupSwitchInsn gen (get-label gen l) (int-array (map get-local t))
411 | (into-array Label (mapv #(get-label gen %) labels))))
412 |
413 | ;; todo: smarter
414 | (defmethod -exec :push
415 | [_ [x] ^GeneratorAdapter gen]
416 | (cond
417 |
418 | (or (nil? x) (string? x))
419 | (.push gen ^String x)
420 |
421 | (instance? Integer x)
422 | (.push gen (int x))
423 |
424 | (instance? Long x)
425 | (.push gen (long x))
426 |
427 | (instance? Float x)
428 | (.push gen (float x))
429 |
430 | (instance? Double x)
431 | (.push gen (double x))
432 |
433 | (or (instance? Character x)
434 | (instance? Short x))
435 | (.visitIntInsn gen Opcodes/SIPUSH (int x))
436 |
437 | (instance? Byte x)
438 | (.visitIntInsn gen Opcodes/BIPUSH (int x))
439 |
440 | (boolean? x)
441 | (.push gen (boolean x))
442 |
443 | :else
444 | (throw (ex-info "Invalid argument to :push" {:val x}))))
445 |
446 | (defn compute-attr [attr]
447 | (reduce (fn [r x] (+ r (opcode x))) 0 attr))
448 |
449 | (defmethod -compile :method
450 | [{:keys [attr method code cv]}]
451 | (let [[[method-name & args] ret] method
452 | m (method-desc ret method-name args)
453 | gen (GeneratorAdapter. (compute-attr attr) m nil nil cv)]
454 |
455 | (transform gen (seq code))))
456 |
457 | (defmethod -compile :field
458 | [{:keys [attr tag cv] :as f}]
459 | (let [tag (if (keyword? tag) (Class/forName (name tag)) tag)]
460 | (.visitField ^ClassWriter cv (compute-attr attr) (munge (name (:name f)))
461 | (descriptor tag) nil nil)))
462 |
463 | (defmethod -compile :class
464 | [{:keys [name attr super fields methods debug? interfaces] :as c}]
465 | (let [cv (ClassWriter. ClassWriter/COMPUTE_MAXS)
466 | interfaces (into interfaces (keep :interface methods))
467 | cname #(s/replace (type-str %) \. \/)
468 | name (cname name)]
469 |
470 | (.visit cv Opcodes/V1_6 (compute-attr attr) name nil (cname super)
471 | (into-array String (mapv cname interfaces)))
472 |
473 | (.visitSource cv name nil)
474 |
475 | (doseq [f fields]
476 | (-compile (assoc f :cv cv)))
477 |
478 | (doseq [m methods]
479 | (-compile (assoc m :cv cv)))
480 |
481 | (.visitEnd cv)
482 | (let [bc (.toByteArray cv)]
483 | (when debug?
484 | (let [cr (ClassReader. bc)
485 | w (java.io.PrintWriter. *out*)
486 | v (TraceClassVisitor. w)
487 | v (CheckClassAdapter. v)]
488 | (.accept cr v 0)))
489 | bc)))
490 |
--------------------------------------------------------------------------------
/src/main/clojure/clojure/tools/emitter/jvm/emit.clj:
--------------------------------------------------------------------------------
1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors.
2 | ;; The use and distribution terms for this software are covered by the
3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 | ;; which can be found in the file epl-v10.html at the root of this distribution.
5 | ;; By using this software in any fashion, you are agreeing to be bound by
6 | ;; the terms of this license.
7 | ;; You must not remove this notice, or any other, from this software.
8 |
9 | (ns clojure.tools.emitter.jvm.emit
10 | (:refer-clojure :exclude [cast])
11 | (:require [clojure.tools.analyzer.utils :as u]
12 | [clojure.tools.analyzer.jvm.utils :refer [primitive? numeric? box prim-or-obj] :as j.u]
13 | [clojure.string :as s]
14 | [clojure.tools.emitter.jvm.intrinsics :refer [intrinsic intrinsic-predicate]])
15 | (:import clojure.lang.Reflector))
16 |
17 | (defmulti -emit (fn [{:keys [op]} _] op))
18 | (defmulti -emit-set! (fn [{:keys [target]} _] (:op target)))
19 |
20 | (def nil-expr
21 | {:op :const :type :nil :form nil :val nil})
22 |
23 | (defn emit-box [tag box unchecked?]
24 | (if (and (primitive? tag)
25 | (not (primitive? box)))
26 | (cond
27 | (numeric? tag)
28 | [[:invoke-static [:clojure.lang.RT/box tag] :java.lang.Number]
29 | [:check-cast box]]
30 | (= Character/TYPE tag)
31 | [[:invoke-static [:clojure.lang.RT/box :char] :java.lang.Character]]
32 | (= Boolean/TYPE tag)
33 | [[:invoke-static [:clojure.lang.RT/box :boolean] :java.lang.Object]
34 | [:check-cast :java.lang.Boolean]])
35 | (when (primitive? box)
36 | (let [method (if (and (numeric? box) (or unchecked? *unchecked-math*))
37 | (str "unchecked" (s/capitalize (.getName ^Class box)) "Cast")
38 | (str (.getName ^Class box) "Cast"))
39 | tag (prim-or-obj tag)
40 | method-sig (str (.getMethod clojure.lang.RT method (into-array Class [tag])))]
41 | (if-let [ops (intrinsic method-sig)]
42 | (mapv (fn [op] [:insn op]) ops)
43 | [[:invoke-static [(keyword "clojure.lang.RT" method) tag] box]])))))
44 |
45 | (defn emit-cast
46 | ([tag cast] (emit-cast tag cast false))
47 | ([tag cast unchecked?]
48 | (if (not (or (primitive? tag)
49 | (primitive? cast)))
50 | (when-not (#{Void Void/TYPE} cast)
51 | [[:check-cast cast]])
52 | (emit-box tag cast unchecked?))))
53 |
54 | (defn emit-pop [tag]
55 | (if (#{Double/TYPE Long/TYPE} tag)
56 | [:pop2]
57 | [:pop]))
58 |
59 | (def ^:dynamic *classes*)
60 |
61 | (defn emit
62 | "(λ AST) → Bytecode
63 | (λ AST → Options) → Bytecode
64 |
65 | AST is an analyzed, macroexpanded t.a.jvm AST. Options is a map, the
66 | following values of which are significant. Returns a (potentially
67 | empty) sequence of bytecodes. *classes* must be bound before calling
68 | emit.
69 |
70 | Options
71 | -----------
72 | :debug? :- (Option bool)
73 | Controls development debug level printing throughout code generation."
74 |
75 | ([ast]
76 | (emit ast {}))
77 |
78 | ([{:keys [env o-tag tag op type unchecked?] :as ast} frame]
79 | (let [bytecode (-emit ast frame)
80 | statement? (isa? (:context env) :ctx/statement)
81 | m (meta bytecode)]
82 | (if statement?
83 | (if (:const m)
84 | []
85 | (into bytecode
86 | (when (and (not (:untyped m))
87 | (not (:container m))
88 | (not= Void/TYPE tag))
89 | [(emit-pop tag)])))
90 | (into bytecode
91 | `[~@(when (and (not (:container m))
92 | (or (:untyped m)
93 | (= Void/TYPE tag)))
94 | [[:insn :ACONST_NULL]])
95 | ~@(when (and (not= tag o-tag)
96 | (not= :const op))
97 | (emit-cast o-tag tag unchecked?))])))))
98 |
99 | (defn emit-classes
100 | "(λ AST) → (Seq Class-AST)
101 | (λ AST → Options) → (Seq Class-AST)
102 |
103 | Compiles the given AST into potentially several classes, returning a
104 | sequence of ASTs defining classes.
105 |
106 | Options
107 | -----------
108 | :debug :- (Option bool)
109 | Controls developlent debug level printing throughout code generation."
110 |
111 | ([ast]
112 | (emit-classes ast {}))
113 |
114 | ([ast opts]
115 | (binding [*classes* (atom {:classes []
116 | :ids #{}})]
117 | (emit ast opts)
118 | (:classes @*classes*))))
119 |
120 | (defmethod -emit :import
121 | [{:keys [class]} frame]
122 | [[:get-static :clojure.lang.RT/CURRENT_NS :clojure.lang.Var]
123 | [:invoke-virtual [:clojure.lang.Var/deref] :java.lang.Object]
124 | [:check-cast :clojure.lang.Namespace]
125 | [:push class]
126 | [:invoke-static [:java.lang.Class/forName :java.lang.String] :java.lang.Class]
127 | [:invoke-virtual [:clojure.lang.Namespace/importClass :java.lang.Class] :java.lang.Class]])
128 |
129 | (defmethod -emit :throw
130 | [{:keys [exception]} frame]
131 | `^:untyped
132 | [~@(emit (assoc exception :tag java.lang.Throwable) frame)
133 | [:throw-exception]])
134 |
135 | (defmethod -emit :monitor-enter
136 | [{:keys [target]} frame]
137 | `^:untyped
138 | [~@(emit target frame)
139 | [:monitor-enter]])
140 |
141 | (defmethod -emit :monitor-exit
142 | [{:keys [target]} frame]
143 | `^:untyped
144 | [~@(emit target frame)
145 | [:monitor-exit]])
146 |
147 | (defn cast [to el]
148 | (if (numeric? to)
149 | (condp = (box to)
150 | Integer
151 | (.intValue ^Number el)
152 |
153 | Long
154 | (.longValue ^Number el)
155 |
156 | Double
157 | (.doubleValue ^Number el)
158 |
159 | Float
160 | (.floatValue ^Number el)
161 |
162 | Short
163 | (.shortValue ^Number el)
164 |
165 | Byte
166 | (.byteValue ^Number el))
167 | (clojure.core/cast to el)))
168 |
169 | (defmethod -emit :const
170 | [{:keys [val id tag] :as ast} frame]
171 | ^:const
172 | [(case val
173 | (true false)
174 | (if (primitive? tag)
175 | [:push val]
176 | [:get-static (if val :java.lang.Boolean/TRUE :java.lang.Boolean/FALSE)
177 | :java.lang.Boolean])
178 |
179 | nil
180 | [:insn :ACONST_NULL]
181 |
182 | (if (or (primitive? tag)
183 | (string? val))
184 | [:push (cast (or (box tag) (class val)) val)]
185 | [:get-static (frame :class) (str "const__" id) tag]))])
186 |
187 | (defmethod -emit :quote
188 | [{:keys [expr]} frame]
189 | (-emit expr frame))
190 |
191 | (defn emit-var
192 | [{:keys [id]} frame]
193 | ^:const
194 | [[:get-static (frame :class) (str "const__" id) clojure.lang.Var]])
195 |
196 | (defmethod -emit :var
197 | [{:keys [var] :as ast} frame]
198 | (conj
199 | (emit-var ast frame)
200 | [:invoke-virtual [(if (u/dynamic? var)
201 | :clojure.lang.Var/get
202 | :clojure.lang.Var/getRawRoot)] :java.lang.Object]))
203 |
204 | (defmethod -emit-set! :var
205 | [{:keys [target val] :as ast} frame]
206 | `[~@(emit-var target frame)
207 | ~@(emit val frame)
208 | [:invoke-virtual [:clojure.lang.Var/set :java.lang.Object] :java.lang.Object]])
209 |
210 | (defmethod -emit :the-var
211 | [ast frame]
212 | (emit-var ast frame))
213 |
214 | (defmethod -emit :def
215 | [{:keys [var meta init env] :as ast} frame]
216 | `[~@(emit-var ast frame)
217 | ~@(when (u/dynamic? var)
218 | [[:push true]
219 | [:invoke-virtual [:clojure.lang.Var/setDynamic :boolean] :clojure.lang.Var]])
220 | ~@(when meta
221 | `[[:dup]
222 | ~@(emit meta frame)
223 | [:invoke-virtual [:clojure.lang.Var/setMeta :clojure.lang.IPersistentMap] :void]])
224 | ~@(when init
225 | `[[:dup]
226 | ~@(emit init frame)
227 | [:invoke-virtual [:clojure.lang.Var/bindRoot :java.lang.Object] :void]])
228 | ~@(when (u/macro? var)
229 | [[:dup]
230 | [:invoke-virtual [:clojure.lang.Var/setMacro] :void]])])
231 |
232 | (defmethod -emit :set!
233 | [ast frame]
234 | (-emit-set! ast frame))
235 |
236 | (defn emit-as-array [list frame]
237 | `[[:push ~(int (count list))]
238 | [:new-array :java.lang.Object]
239 | ~@(mapcat (fn [i item]
240 | `[[:dup]
241 | [:push ~(int i)]
242 | ~@(emit item frame)
243 | [:array-store :java.lang.Object]])
244 | (range) list)])
245 |
246 | (defmethod -emit :map
247 | [{:keys [keys vals form]} frame]
248 | `[~@(emit-as-array (interleave keys vals) frame)
249 | ~@(if (sorted? form)
250 | [[:invoke-static [:clojure.lang.RT/seq :java.lang.Object] :clojure.lang.ISeq]
251 | [:invoke-static [:clojure.lang.PersistentTreeMap/create :clojure.lang.ISeq] :clojure.lang.PersistentTreeMap]]
252 | [[:invoke-static [:clojure.lang.RT/map :objects] :clojure.lang.IPersistentMap]])])
253 |
254 | (defmethod -emit :vector
255 | [{:keys [items]} frame]
256 | (conj
257 | (emit-as-array items frame)
258 | [:invoke-static [:clojure.lang.RT/vector :objects] :clojure.lang.IPersistentVector]))
259 |
260 | (defmethod -emit :set
261 | [{:keys [items form]} frame]
262 | `[~@(emit-as-array items frame)
263 | ~@(if (sorted? form)
264 | [[:invoke-static [:clojure.lang.RT/seq :java.lang.Object] :clojure.lang.ISeq]
265 | [:invoke-static [:clojure.lang.PersistentTreeSet/create :clojure.lang.ISeq] :clojure.lang.PersistentTreeSet]]
266 | [[:invoke-static [:clojure.lang.RT/set :objects] :clojure.lang.IPersistentSet]])])
267 |
268 | (defmethod -emit :with-meta
269 | [{:keys [meta expr]} frame]
270 | (into
271 | (emit expr frame)
272 | `[~@(emit meta frame)
273 | [:invoke-interface [:clojure.lang.IObj/withMeta :clojure.lang.IPersistentMap]
274 | :clojure.lang.IObj]]))
275 |
276 | (defmethod -emit :do
277 | [{:keys [statements ret]} frame]
278 | (with-meta
279 | (vec (mapcat #(emit % frame) (conj statements ret)))
280 | {:container true}))
281 |
282 | (defn label []
283 | (keyword (gensym "label__")))
284 |
285 | (defn local []
286 | (keyword (gensym "local__")))
287 |
288 | (defn emit-try
289 | [{:keys [body catches finally env tag]} frame]
290 | (let [[start-label end-label ret-label finally-label] (repeatedly label)
291 | catches (mapv #(assoc %
292 | :start-label (label)
293 | :end-label (label)) catches)
294 | context (:context env)
295 | [ret-local finally-local] (repeatedly local)
296 | ret-local-tag (let [t (.getName ^Class tag)]
297 | (if (= "void" t) "Object" t))]
298 |
299 | `^:container
300 | [[:mark ~start-label]
301 | ~@(emit body frame)
302 | ~@(if (isa? context :ctx/statement)
303 | [[:insn :ACONST_NULL]
304 | [:pop]]
305 | [[:var-insn (keyword ret-local-tag "ISTORE") ret-local]])
306 | [:mark ~end-label]
307 | ~@(when finally
308 | (emit finally frame))
309 | [:go-to ~ret-label]
310 |
311 | ~@(mapcat
312 | (fn [{:keys [body start-label end-label local]}]
313 | `[[:mark ~start-label]
314 | [:astore ~(:name local)]
315 | ~@(emit body frame)
316 | ~@(if (isa? context :ctx/statement)
317 | (when (not (#{Void Void/TYPE} (:tag body)))
318 | [(emit-pop (:tag body))])
319 | [[:var-insn (keyword ret-local-tag "ISTORE") ret-local]])
320 | [:mark ~end-label]
321 | ~@(when finally
322 | (emit finally frame))
323 | [:go-to ~ret-label]])
324 | catches)
325 | ~@(when finally
326 | `[[:mark ~finally-label]
327 | [:astore ~finally-local]
328 | ~@(emit finally frame)
329 | [:aload ~finally-local]
330 | [:throw-exception]])
331 |
332 | [:mark ~ret-label]
333 | ~@(when-not (isa? context :ctx/statement)
334 | [[:var-insn (keyword ret-local-tag "ILOAD") ret-local]])
335 | [:mark ~(label)]
336 |
337 | ~@(for [c catches :let [^Class class (-> c :class :val)]]
338 | [:try-catch-block start-label end-label (:start-label c) class])
339 |
340 | ~@(when finally
341 | `[~[:try-catch-block start-label end-label finally-label nil]
342 | ~@(for [{:keys [start-label end-label] :as c} catches]
343 | [:try-catch-block start-label end-label finally-label nil])])
344 |
345 | ~@(for [{:keys [local start-label end-label body] :as c} catches]
346 | [:local-variable (:name local) Exception nil start-label end-label (:name local)])]))
347 |
348 | (defn emit-line-number
349 | [{:keys [line]} & [l]]
350 | (when line
351 | (let [l (or l (label))]
352 | [[:mark l]
353 | [:line-number line l]])))
354 |
355 | (defmethod -emit :static-field
356 | [{:keys [field o-tag class env]} frame]
357 | `^:const
358 | [~@(emit-line-number env)
359 | ~[:get-static class field o-tag]])
360 |
361 | (defn dup [tag]
362 | (if (#{Long/TYPE Double/TYPE} tag)
363 | [:dup2]
364 | [:dup]))
365 |
366 | (defn dup-x1 [tag]
367 | (if (#{Long/TYPE Double/TYPE} tag)
368 | [:dup2-x1]
369 | [:dup-x1]))
370 |
371 | (defn dup-x2 [tag]
372 | (if (#{Long/TYPE Double/TYPE} tag)
373 | [:dup2-x2]
374 | [:dup-x2]))
375 |
376 | (defmethod -emit-set! :static-field
377 | [{:keys [target val env]} frame]
378 | (let [{:keys [o-tag class field]} target]
379 | `[~@(emit-line-number env)
380 | ~@(emit (assoc val :tag o-tag) frame)
381 | ~(dup o-tag)
382 | ~[:put-static class field o-tag]]))
383 |
384 | (defmethod -emit :instance-field
385 | [{:keys [instance class field env o-tag]} frame]
386 | `^:const
387 | [~@(emit-line-number env)
388 | ~@(emit (assoc instance :tag class) frame)
389 | ~[:get-field class field o-tag]])
390 |
391 | (defmethod -emit-set! :instance-field
392 | [{:keys [target val env]} frame]
393 | (let [{:keys [instance class field o-tag]} target]
394 | `[~@(emit-line-number env)
395 | ~@(emit (assoc instance :tag class) frame)
396 | ~@(emit (assoc val :tag o-tag) frame)
397 | ~(dup-x1 o-tag)
398 | ~[:put-field class field o-tag]]))
399 |
400 | (defmethod -emit :keyword-invoke
401 | [{:keys [env target keyword args] :as ast} frame]
402 | (let [id (:id keyword)
403 | [end-label fault-label] (repeatedly label)]
404 | `[~@(emit-line-number env)
405 | [:get-static ~(name (frame :class)) ~(str "thunk__" id) :clojure.lang.ILookupThunk]
406 | [:dup]
407 | ~@(emit target frame)
408 | [:dup-x2]
409 | [:invoke-interface [:clojure.lang.ILookupThunk/get :java.lang.Object] :java.lang.Object]
410 | [:dup-x2]
411 | [:jump-insn :IF_ACMPEQ ~fault-label]
412 | [:pop]
413 | [:go-to ~end-label]
414 |
415 | [:mark ~fault-label]
416 | [:swap]
417 | [:pop]
418 | [:dup]
419 | [:get-static ~(name (frame :class)) ~(str "site__" id) :clojure.lang.KeywordLookupSite]
420 | [:swap]
421 | [:invoke-interface [:clojure.lang.ILookupSite/fault :java.lang.Object] :clojure.lang.ILookupThunk]
422 | [:dup]
423 | [:put-static ~(name (frame :class)) ~(str "thunk__" id) :clojure.lang.ILookupThunk]
424 | [:swap]
425 | [:invoke-interface [:clojure.lang.ILookupThunk/get :java.lang.Object] :java.lang.Object]
426 | [:mark ~end-label]]))
427 |
428 | (defmethod -emit :new
429 | [{:keys [env class args validated?]} frame]
430 | (let [cname (.getName ^Class (:val class))]
431 | (if validated?
432 | `[[:new-instance ~cname]
433 | [:dup]
434 | ~@(mapcat #(emit % frame) args)
435 | [:invoke-constructor [~(keyword cname "")
436 | ~@(mapv :tag args)] :void]]
437 | `[[:push ~cname]
438 | [:invoke-static [:java.lang.Class/forName :java.lang.String] :java.lang.Class]
439 | ~@(emit-as-array args frame)
440 | [:invoke-static [:clojure.lang.Reflector/invokeConstructor :java.lang.Class :objects] :java.lang.Object]])))
441 |
442 | (defn emit-intrinsic [{:keys [args method ^Class class false-label]}]
443 | (let [m (str (.getMethod class (name method) (into-array Class (mapv :tag args))))]
444 | (if false-label
445 | (when-let [ops (intrinsic-predicate m)]
446 | (with-meta (conj (mapv (fn [op] [:insn op]) (butlast ops))
447 | [:jump-insn (last ops) false-label])
448 | {:intrinsic-predicate true}))
449 | (when-let [ops (intrinsic m)]
450 | (mapv (fn [op] [:insn op]) ops)))))
451 |
452 | (defmethod -emit :static-call
453 | [{:keys [env o-tag validated? args method ^Class class false-label to-clear?] :as ast} frame]
454 | (if validated?
455 | (let [intrinsic (emit-intrinsic ast)]
456 | `^{:intrinsic-predicate ~(-> intrinsic meta :intrinsic-predicate)}
457 | [~@(emit-line-number env)
458 | ~@(mapcat #(emit % frame) args)
459 | ~@(or intrinsic
460 | `[~@(when to-clear?
461 | [[:insn :ACONST_NULL]
462 | [:var-insn :clojure.lang.Object/ISTORE 0]])
463 | [:invoke-static [~(keyword (.getName class) (str method))
464 | ~@(mapv :tag args)] ~o-tag]])])
465 | `[[:push ~(.getName class)]
466 | [:invoke-static [:java.lang.Class/forName :java.lang.String] :java.lang.Class]
467 | [:push ~(str method)]
468 | ~@(emit-as-array args frame)
469 | ~@(when to-clear?
470 | [[:insn :ACONST_NULL]
471 | [:var-insn :clojure.lang.Object/ISTORE 0]])
472 | [:invoke-static [:clojure.lang.Reflector/invokeStaticMethod
473 | :java.lang.Class :java.lang.String :objects]
474 | :java.lang.Object]]))
475 |
476 | (defmethod -emit :instance-call
477 | [{:keys [env o-tag validated? args method ^Class class instance to-clear?]} frame]
478 | (if validated?
479 | `[~@(emit-line-number env)
480 | ~@(emit (assoc instance :tag class) frame)
481 | ~@(mapcat #(emit % frame) args)
482 | ~@(when to-clear?
483 | [[:insn :ACONST_NULL]
484 | [:var-insn :clojure.lang.Object/ISTORE 0]])
485 | [~(if (.isInterface class)
486 | :invoke-interface
487 | :invoke-virtual)
488 | [~(keyword (.getName class) (str method)) ~@(mapv :tag args)] ~o-tag]]
489 | `[~@(emit instance frame)
490 | [:push ~(str method)]
491 | ~@(emit-as-array args frame)
492 | ~@(when to-clear?
493 | [[:insn :ACONST_NULL]
494 | [:var-insn :clojure.lang.Object/ISTORE 0]])
495 | [:invoke-static [:clojure.lang.Reflector/invokeInstanceMethod
496 | :java.lang.Object :java.lang.String :objects]
497 | :java.lang.Object]]))
498 |
499 | (defmethod -emit :host-interop
500 | [{:keys [m-or-f target env]} frame]
501 | `[~@(emit target frame)
502 | [:push ~(str m-or-f)]
503 | [:invoke-static [:clojure.lang.Reflector/invokeNoArgInstanceMember :java.lang.Object :java.lang.String] :Object]])
504 |
505 | (defmethod -emit-set! :host-interop
506 | [{:keys [target val env]} frame]
507 | `[~@(emit-line-number env)
508 | ~@(emit (:target target) frame)
509 | [:push ~(str (:m-or-f target))]
510 | ~@(emit val frame)
511 | [:invoke-static [:clojure.lang.Reflector/setInstanceField :java.lang.Object :java.lang.String :java.lang.Object] :java.lang.Object]])
512 |
513 | (defmethod -emit :instance?
514 | [{:keys [target class]} frame]
515 | `[~@(emit target frame)
516 | ~[:instance-of (.getName ^Class class)]])
517 |
518 | (defmethod -emit :if
519 | [{:keys [test then else env]} frame]
520 | (let [[null-label false-label end-label] (repeatedly label)
521 | test-expr (emit (assoc test :false-label false-label) frame)]
522 | `^:container
523 | [~@(emit-line-number env)
524 | ~@test-expr
525 | ~@(when (not (:intrinsic-predicate (meta test-expr)))
526 | (if (not= (:tag test) Boolean/TYPE)
527 | [[:dup]
528 | [:if-null null-label]
529 | [:get-static :java.lang.Boolean/FALSE :java.lang.Boolean]
530 | [:jump-insn :IF_ACMPEQ false-label]]
531 | [[:if-z-cmp :EQ false-label]]))
532 | ~@(emit then frame)
533 | [:go-to ~end-label]
534 | [:mark ~null-label]
535 | [:pop]
536 | [:mark ~false-label]
537 | ~@(emit else frame)
538 | [:mark ~end-label]]))
539 |
540 | (defn emit-args-and-invoke
541 | ([args frame] (emit-args-and-invoke args frame false))
542 | ([args {:keys [to-clear?] :as frame} proto?]
543 | (let [frame (dissoc frame :to-clear?)]
544 | `[~@(mapcat #(emit % frame) (take 19 args))
545 | ~@(when-let [args (seq (drop 19 args))]
546 | (emit-as-array args frame))
547 | ~@(when to-clear?
548 | [[:insn :ACONST_NULL]
549 | [:var-insn :clojure.lang.Object/ISTORE 0]])
550 | [:invoke-interface [:clojure.lang.IFn/invoke ~@(repeat (min 20 (count args)) :java.lang.Object) ~@(when proto? [:java.lang.Object])] :java.lang.Object]])))
551 |
552 | (defmethod -emit :invoke
553 | [{:keys [fn args env to-clear?]} frame]
554 | `[~@(emit fn frame)
555 | [:check-cast :clojure.lang.IFn]
556 | ~@(emit-args-and-invoke args (assoc frame :to-clear? to-clear?))])
557 |
558 | (defmethod -emit :protocol-invoke
559 | [{:keys [protocol-fn target args env to-clear?]} frame]
560 | (let [[on-label call-label end-label] (repeatedly label)
561 | v (:var protocol-fn)
562 | id (:id protocol-fn)
563 |
564 | ^Class pinterface (:on-interface @(:protocol (meta v)))]
565 | `[~@(emit target frame)
566 | [:dup]
567 | [:invoke-static [:clojure.lang.Util/classOf :java.lang.Object] :java.lang.Class]
568 |
569 | [:get-static ~(name (frame :class)) ~(str "cached__class__" id) :java.lang.Class]
570 | [:jump-insn :IF_ACMPEQ ~call-label]
571 |
572 | [:dup]
573 | [:instance-of ~pinterface]
574 | [:if-z-cmp :NE ~on-label]
575 |
576 | [:dup]
577 | [:invoke-static [:clojure.lang.Util/classOf :java.lang.Object] :java.lang.Class]
578 | [:put-static ~(frame :class) ~(str "cached__class__" id) :java.lang.Class]
579 |
580 | [:mark ~call-label]
581 | ~@(emit-var protocol-fn frame)
582 | [:invoke-virtual [:clojure.lang.Var/getRawRoot] :java.lang.Object]
583 | [:swap]
584 | ~@(emit-args-and-invoke args (assoc frame :to-clear? to-clear?) true)
585 | [:go-to ~end-label]
586 |
587 | [:mark ~on-label]
588 |
589 | ~@(mapcat #(emit % frame) args)
590 | ~@(when to-clear?
591 | [[:insn :ACONST_NULL]
592 | [:var-insn :clojure.lang.Object/ISTORE 0]])
593 | [:invoke-interface [~(keyword (.getName pinterface)
594 | (munge (name (:form protocol-fn))))
595 | ~@(repeat (count args) :java.lang.Object)] :java.lang.Object]
596 |
597 | [:mark ~end-label]]))
598 |
599 | (defmethod -emit :prim-invoke
600 | [{:keys [fn args ^Class prim-interface o-tag to-clear?]} frame]
601 | `[~@(emit fn frame)
602 | [:check-cast ~prim-interface]
603 | ~@(mapcat #(emit % frame) args)
604 | ~@(when to-clear?
605 | [[:insn :ACONST_NULL]
606 | [:var-insn :clojure.lang.Object/ISTORE 0]])
607 | [:invoke-interface [~(keyword (.getName prim-interface) "invokePrim")
608 | ~@(mapv :tag args)] ~o-tag]])
609 |
610 | (defn emit-shift-mask
611 | [{:keys [shift mask]}]
612 | (when (not (zero? mask))
613 | [[:push (int shift)]
614 | [:insn :ISHR]
615 | [:push (int mask)]
616 | [:insn :IAND]]))
617 |
618 | (defn emit-test-ints
619 | [{:keys [test test-type] :as ast} frame default-label]
620 | (cond
621 | (nil? (:tag test))
622 | ;; reflection warning
623 | `[~@(emit test frame)
624 | [:instance-of :java.lang.Number]
625 | [:if-z-cmp :EQ ~default-label]
626 | ~@(emit (assoc test :tag Integer/TYPE :unchecked? true) frame)
627 | ~@(emit-shift-mask ast)]
628 |
629 | (numeric? (:tag test))
630 | `[~@(emit (assoc test :tag Integer/TYPE :unchecked? true) frame)
631 | ~@(emit-shift-mask ast)]
632 |
633 | :else
634 | [[:go-to default-label]]))
635 |
636 | (defn emit-test-hashes
637 | [{:keys [test] :as ast} frame]
638 | `[~@(emit test frame)
639 | [:invoke-static [:clojure.lang.Util/hash :java.lang.Object] :int]
640 | ~@(emit-shift-mask ast)])
641 |
642 | (defn emit-then-ints
643 | [tag comp test then default-label mask frame]
644 | (cond
645 | (nil? tag)
646 | `[~@(emit comp frame)
647 | ~@(emit test frame)
648 | [:invoke-static [:clojure.lang.Util/equiv :java.lang.Object :java.lang.Object] :boolean]
649 | [:if-z-cmp :EQ ~default-label]
650 | ~@(emit then frame)]
651 |
652 | (= tag Long/TYPE)
653 | `[~@(emit (assoc test :tag Long/TYPE :unchecked? true) frame)
654 | ~@(emit (assoc comp :tag Long/TYPE :unchecked? true) frame)
655 | [:if-cmp :long :NE ~default-label]
656 | ~@(emit then frame)]
657 |
658 | (numeric? tag)
659 | `[~@(when (not (zero? mask))
660 | `[~@(emit (assoc test :tag Long/TYPE :unchecked? true) frame)
661 | ~@(emit (assoc comp :tag Long/TYPE :unchecked? true) frame)
662 | [:if-cmp :long :NE ~default-label]])
663 | ~@(emit then frame)]
664 |
665 | :else
666 | [[:go-to default-label]]))
667 |
668 | (defn emit-then-hashes
669 | [comp test then test-type default-label frame]
670 | `[~@(emit comp frame)
671 | ~@(emit test frame)
672 | ~@(if (= :hash-identity test-type)
673 | [[:jump-insn :IF_ACMPNE default-label]]
674 | [[:invoke-static [:clojure.lang.Util/equiv :java.lang.Object :java.lang.Object] :boolean]
675 | [:if-z-cmp :EQ default-label]])
676 | ~@(emit then frame)])
677 |
678 | (defmethod -emit :case
679 | [{:keys [test default tests thens shift mask low high switch-type test-type skip-check? env] :as ast} frame]
680 | (let [testc (count tests)
681 | tests (into (sorted-map) (zipmap (mapv :hash tests) (mapv :test tests)))
682 | thens (apply sorted-map (mapcat (juxt :hash :then) thens))
683 | [default-label end-label] (repeatedly label)
684 | tests-ks (keys tests)
685 | tests-vs (repeatedly (count tests-ks) label)
686 | labels (zipmap tests-ks tests-vs)]
687 | `^:container
688 | [~@(emit-line-number env)
689 | ~@(if (= :int test-type)
690 | (emit-test-ints ast frame default-label)
691 | (emit-test-hashes ast frame))
692 | ~(if (= :sparse switch-type)
693 | [:lookup-switch-insn default-label tests-ks tests-vs] ; to array
694 | [:table-switch-insn low high default-label
695 | (mapv (fn [i] (if (contains? labels i) (labels i) default-label)) (range low (inc high)))])
696 | ~@(mapcat (fn [[i label]]
697 | `[[:mark ~label]
698 | ~@(cond
699 | (= :int test-type)
700 | (emit-then-ints (:tag test) test (tests i) (thens i) default-label mask frame)
701 |
702 | (contains? skip-check? i)
703 | [(emit (thens i) frame)]
704 |
705 | :else
706 | (emit-then-hashes test (tests i) (thens i) test-type default-label frame))
707 | [:go-to ~end-label]])
708 | labels)
709 | [:mark ~default-label]
710 | ~@(emit default frame)
711 | [:mark ~end-label]]))
712 |
713 | (defn emit-bindings [bindings labels frame]
714 | (mapcat (fn [{:keys [init to-clear? tag name] :as binding} label]
715 | `[~@(emit init frame)
716 | ~(if to-clear?
717 | (emit-pop tag)
718 | [:var-insn (keyword (.getName ^Class tag) "ISTORE") name])
719 | ~@(when label
720 | [[:mark label]])])
721 | bindings labels))
722 |
723 | (defn emit-let
724 | [{:keys [op bindings body env]} frame]
725 | (let [loop? (= :loop op)
726 | [end-label loop-label & labels] (repeatedly (+ 2 (count bindings)) label)]
727 | (with-meta
728 | `[~@(emit-bindings bindings labels frame)
729 | [:mark ~loop-label]
730 | ~@(emit body (merge frame (when loop? {:loop-label loop-label
731 | :loop-locals bindings})))
732 | [:mark ~end-label]
733 | ~@(mapv (fn [{:keys [name tag]} label]
734 | [:local-variable name tag nil label end-label name])
735 | (remove :to-clear? bindings) labels)]
736 | (if loop? {} {:container true}))))
737 |
738 | (defmethod -emit :let
739 | [ast frame]
740 | (emit-let ast frame))
741 |
742 | (defmethod -emit :loop
743 | [{:keys [closed-overs tag internal-method-name] :as ast} {:keys [class params] :as frame}]
744 | (let [locals (remove #(#{:arg :field} (:local %)) (vals closed-overs))
745 | method-sig (into [(keyword class (str internal-method-name))]
746 | (into (mapv :tag params)
747 | (mapv :o-tag locals)))]
748 | `[[:load-this]
749 | ~@(mapcat (fn [l] (-emit (assoc l :op :local) frame)) (concat params locals))
750 | ~[:invoke-virtual method-sig tag]]))
751 |
752 | (defmethod -emit :try
753 | [{:keys [closed-overs tag internal-method-name env] :as ast} {:keys [class params] :as frame}]
754 | (let [locals (remove #(#{:arg :field} (:local %)) (vals closed-overs))
755 | method-sig (into [(keyword class (str internal-method-name))]
756 | (into (mapv :tag params)
757 | (mapv :o-tag locals)))
758 | statement? (isa? (:context env) :ctx/statement)
759 | tag (if statement? :void tag)]
760 | `^:container
761 | [[:load-this]
762 | ~@(mapcat (fn [l] (-emit (assoc l :op :local) frame)) (concat params locals))
763 | ~[:invoke-virtual method-sig tag]
764 | ~@(if (and (not statement?)
765 | (#{Void Void/TYPE} tag))
766 | [[:insn :ACONST_NULL]])]))
767 |
768 | (defn emit-letfn-bindings [bindings class-names frame]
769 | (let [binds (set (mapv :name bindings))]
770 | (mapcat (fn [{:keys [init tag name]} class-name]
771 | (let [{:keys [closed-overs]} init]
772 | `[[:var-insn ~(keyword (.getName ^Class tag) "ILOAD") ~name]
773 | [:check-cast ~class-name]
774 |
775 | ~@(mapcat (fn [[k c]]
776 | (when (binds k)
777 | `[[:dup]
778 | ~@(emit (assoc c :op :local) frame)
779 | ~[:put-field class-name k (:tag c)]]))
780 | closed-overs)
781 |
782 | [:pop]]))
783 | bindings class-names)))
784 |
785 |
786 | (defn emit-binds [bindings frame]
787 | (mapv
788 | (fn [{:keys [init tag name] :as binding}]
789 | (let [init (emit init frame)
790 | class-name (-> init first second)] ;; weak
791 | [class-name
792 | `[~@init
793 | [:var-insn ~(keyword (.getName ^Class tag) "ISTORE") ~name]]]))
794 | bindings))
795 |
796 | (defmethod -emit :letfn
797 | [{:keys [bindings body env]} frame]
798 | (let [[loop-label end-label] (repeatedly label)]
799 | `^:container
800 | [~@(emit-bindings (mapv #(assoc % :init nil-expr) bindings) (repeat nil) frame)
801 |
802 | ~@(let [binds (emit-binds bindings frame)
803 | bindings-emit(mapcat second binds)
804 | class-names (mapv first binds)]
805 | `[~@bindings-emit
806 | ~@(emit-letfn-bindings bindings class-names frame)])
807 |
808 | [:mark ~loop-label]
809 | ~@(emit body frame)
810 | [:mark ~end-label]
811 | ~@(mapv (fn [{:keys [name tag]}]
812 | [:local-variable name tag nil loop-label end-label name])
813 | bindings)]))
814 |
815 | (defmethod -emit :recur
816 | [{:keys [exprs]} {:keys [loop-label loop-locals] :as frame}]
817 | `[~@(mapcat (fn [arg] (emit arg frame)) exprs)
818 | ~@(rseq (mapv (fn [{:keys [local tag] :as arg} {:keys [name] :as binding}]
819 | (if (= :arg local)
820 | [:store-arg (:arg-id binding)]
821 | [:var-insn (keyword (.getName ^Class tag) "ISTORE") name]))
822 | exprs loop-locals))
823 | [:go-to ~loop-label]])
824 |
825 | (defn emit-internal-methods [methods {:keys [class params] :as frame}]
826 | (mapv (fn [{:keys [closed-overs tag internal-method-name body] :as ast}]
827 | (let [locals (remove #(#{:arg :field} (:local %)) (vals closed-overs))
828 | [loop-label end-label] (repeatedly label)
829 | bc `[[:start-method]
830 | [:local-variable :this :clojure.lang.AFunction nil ~loop-label ~end-label :this]
831 | [:label ~loop-label]
832 | ~@(mapv (fn [{:keys [name tag]}]
833 | [:local-variable name tag nil loop-label end-label name])
834 | params)
835 | ~@(mapcat (fn [i {:keys [name o-tag] :as l}]
836 | `[[:load-arg ~i]
837 | ~[:local-variable name o-tag nil loop-label end-label name]
838 | ~[:var-insn (keyword (.getName ^Class o-tag) "ISTORE") name]])
839 | (iterate inc (count params)) locals)
840 | ~@(case (:op ast)
841 | :loop
842 | (emit-let ast frame)
843 | :try
844 | (emit-try ast frame))
845 | ~@(emit-cast (prim-or-obj tag) tag)
846 | [:label ~end-label]
847 | [:return-value]
848 | [:end-method]]
849 | method-sig (into [(keyword internal-method-name)]
850 | (into (mapv :tag params)
851 | (mapv :o-tag locals)))]
852 |
853 | {:op :method
854 | :attr #{:private}
855 | :method [method-sig (if (isa? (-> body :env :context) :ctx/statement)
856 | :void
857 | tag)]
858 | :code bc}))
859 | methods))
860 |
861 | (defmethod -emit :fn-method
862 | [{:keys [params tag fixed-arity variadic? body env internal-methods]}
863 | {:keys [class] :as frame}]
864 | (let [arg-tags (mapv (comp prim-or-obj :tag) params)
865 | return-type (prim-or-obj tag)
866 | tags (conj arg-tags return-type)
867 | prim-interface (j.u/prim-interface tags)
868 |
869 | primitive? (some primitive? tags)
870 |
871 | method-name (cond
872 | variadic? :doInvoke
873 | primitive? :invokePrim
874 | :else
875 | :invoke)
876 |
877 | ;; arg-types
878 | [loop-label end-label] (repeatedly label)
879 |
880 | code
881 | `[[:start-method]
882 | [:local-variable :this :clojure.lang.AFunction nil ~loop-label ~end-label :this]
883 | ~@(mapcat (fn [{:keys [name arg-id o-tag tag]}]
884 | `[~[:local-variable name tag nil loop-label end-label name]
885 | ~@(when-not (= tag o-tag)
886 | [[:load-arg arg-id]
887 | [:check-cast tag]
888 | [:store-arg arg-id]])])
889 | params)
890 | [:mark ~loop-label]
891 | ~@(emit-line-number env loop-label)
892 | ~@(emit body (assoc frame
893 | :loop-label loop-label
894 | :loop-locals params
895 | :params params))
896 | [:mark ~end-label]
897 | [:return-value]
898 | [:end-method]]]
899 |
900 | ;; should emit typed only when there's an interface, otherwise it's useless
901 |
902 | `[~{:op :method
903 | :attr #{:public}
904 | :method [(into [method-name] arg-tags) return-type]
905 | :code code}
906 | ~@(when primitive?
907 | [{:op :method
908 | :attr #{:public}
909 | :interface prim-interface
910 | :method [(into [:invoke] (repeat (count params) :java.lang.Object))
911 | :java.lang.Object]
912 | :code `[[:start-method]
913 | [:load-this]
914 | ~@(mapcat (fn [{:keys [tag]} id]
915 | `[~[:load-arg id]
916 | ~@(emit-cast Object tag)])
917 | params (range))
918 | ~[:invoke-virtual (into [(keyword class "invokePrim")] arg-tags) return-type]
919 | ~@(emit-cast return-type Object)
920 | [:return-value]
921 | [:end-method]]}])
922 | ~@(when internal-methods
923 | (emit-internal-methods internal-methods (assoc frame :params params)))]))
924 |
925 | ;; addAnnotations
926 | (defmethod -emit :method
927 | [{:keys [this params name bridges tag fixed-arity variadic? body env internal-methods]}
928 | {:keys [class] :as frame}]
929 |
930 | (let [method-name name
931 | return-type tag
932 | arg-types (mapv :tag params)
933 | [loop-label end-label] (repeatedly label)
934 |
935 | code
936 | `[[:start-method]
937 | ~[:local-variable (:name this) class nil loop-label end-label (:name this)]
938 | ~@(mapv (fn [{:keys [tag name]}]
939 | [:local-variable name tag nil loop-label end-label name])
940 | params)
941 | [:mark ~loop-label]
942 | ~@(emit-line-number env loop-label)
943 | ~@(emit (assoc body
944 | :tag return-type
945 | :o-tag (or (:tag body) Object))
946 | (assoc frame
947 | :loop-label loop-label
948 | :loop-locals params
949 | :params params))
950 | [:mark ~end-label]
951 | [:return-value]
952 | [:end-method]]]
953 |
954 | `[~{:op :method
955 | :attr #{:public}
956 | :method [(into [method-name] arg-types) return-type]
957 | :code code}
958 | ~@(let [target [(into [(keyword class (str method-name))] arg-types) return-type]]
959 | (for [{:keys [name parameter-types return-type]} bridges]
960 | {:op :method
961 | :attr #{:public :bridge}
962 | :method [(into [method-name] parameter-types) return-type]
963 | :code `[[:start-method]
964 | [:load-this]
965 | [:load-args]
966 | [:invoke-virtual ~@target]
967 | [:return-value]
968 | [:end-method]]}))
969 | ~@(when internal-methods
970 | (emit-internal-methods internal-methods (assoc frame :params params)))]))
971 |
972 | (defmethod -emit :local
973 | [{:keys [to-clear? local name tag o-tag arg-id]}
974 | {:keys [closed-overs class] :as frame}]
975 | (let [to-clear? (and to-clear?
976 | (not (primitive? o-tag)))]
977 | (cond
978 | (closed-overs name)
979 | `[[:load-this]
980 | ~[:get-field class name o-tag]
981 | ~@(when to-clear?
982 | [[:load-this]
983 | [:insn :ACONST_NULL]
984 | [:put-field class name o-tag]])]
985 |
986 | (= :arg local)
987 | `[[:load-arg ~arg-id]
988 | ~@(when to-clear?
989 | [[:insn :ACONST_NULL]
990 | [:store-arg arg-id]])]
991 |
992 | (= :fn local)
993 | [[:var-insn :clojure.lang.AFunction/ILOAD 0]]
994 |
995 | (= :this local)
996 | [[:var-insn :clojure.lang.Object/ILOAD 0]]
997 |
998 | :else
999 | `[~[:var-insn (keyword (.getName ^Class o-tag) "ILOAD") name]
1000 | ~@(when to-clear?
1001 | [[:insn :ACONST_NULL]
1002 | [:var-insn (keyword (.getName ^Class o-tag) "ISTORE") name]])])))
1003 |
1004 | (defmethod -emit-set! :local
1005 | [{:keys [target val env]} {:keys [class] :as frame}]
1006 | (let [{:keys [o-tag name]} target]
1007 | `[~@(emit-line-number env)
1008 | [:load-this]
1009 | ~@(emit (assoc val :tag Object) frame)
1010 | ~[:put-field class name Object]
1011 | ~@(-emit target frame)]))
1012 |
1013 | (defmulti -emit-value (fn [type value] type))
1014 |
1015 | (defn emit-value [t o]
1016 | `[~@(-emit-value t o)
1017 | ~@(when-let [m (and (u/obj? o)
1018 | (meta o))]
1019 | `[[:check-cast :clojure.lang.IObj]
1020 | ~@(-emit-value :map m)
1021 | [:check-cast :clojure.lang.IPersistentMap]
1022 | [:invoke-interface [:clojure.lang.IObj/withMeta :clojure.lang.IPersistentMap]
1023 | :clojure.lang.IObj]])])
1024 |
1025 | (defmethod -emit-value :nil [_ _]
1026 | [[:insn :ACONST_NULL]])
1027 |
1028 | (defmethod -emit-value :string [_ s]
1029 | [[:push s]])
1030 |
1031 | (defmethod -emit-value :bool [_ b]
1032 | [[:get-static (if b :java.lang.Boolean/TRUE :java.lang.Boolean/FALSE)
1033 | :java.lang.Boolean]])
1034 |
1035 | (defmethod -emit-value :number [_ n]
1036 | (cond
1037 | (instance? Long n)
1038 | [[:push n]
1039 | [:invoke-static [:java.lang.Long/valueOf :long] :java.lang.Long]]
1040 |
1041 | (instance? Integer n)
1042 | [[:push n]
1043 | [:invoke-static [:java.lang.Integer/valueOf :int] :java.lang.Integer]]
1044 |
1045 | (instance? Double n)
1046 | [[:push n]
1047 | [:invoke-static [:java.lang.Double/valueOf :double] :java.lang.Double]]
1048 |
1049 | (instance? Float n)
1050 | [[:push n]
1051 | [:invoke-static [:java.lang.Float/valueOf :float] :java.lang.Float]]
1052 |
1053 | (instance? Byte n)
1054 | [[:push n]
1055 | [:invoke-static [:java.lang.Byte/valueOf :byte] :java.lang.Byte]]
1056 |
1057 | (instance? Short n)
1058 | [[:push n]
1059 | [:invoke-static [:java.lang.Short/valueOf :short] :java.lang.Short]]
1060 |
1061 | :else
1062 | (-emit-value :default n)))
1063 |
1064 | (defmethod -emit-value :class [_ c]
1065 | (if (primitive? c)
1066 | [[:get-static (box c) "TYPE" :java.lang.Class]]
1067 | [[:push (.getName ^Class c)]
1068 | [:invoke-static [:java.lang.Class/forName :java.lang.String] :java.lang.Class]]))
1069 |
1070 | (defmethod -emit-value :symbol [_ s]
1071 | [[:push (namespace s)]
1072 | [:push (name s)]
1073 | [:invoke-static [:clojure.lang.Symbol/intern :java.lang.String :java.lang.String]
1074 | :clojure.lang.Symbol]])
1075 |
1076 | (defmethod -emit-value :keyword [_ k]
1077 | [[:push (namespace k)]
1078 | [:push (name k)]
1079 | [:invoke-static [:clojure.lang.Keyword/intern :java.lang.String :java.lang.String]
1080 | :clojure.lang.Keyword]])
1081 |
1082 | (defmethod -emit-value :var [_ ^clojure.lang.Var v]
1083 | [[:push (str (ns-name (.ns v)))]
1084 | [:push (name (.sym v))]
1085 | [:invoke-static [:clojure.lang.RT/var :java.lang.String :java.lang.String]
1086 | :clojure.lang.Var]])
1087 |
1088 | (defn emit-values-as-array [list]
1089 | `[[:push ~(int (count list))]
1090 | [:new-array :java.lang.Object]
1091 | ~@(mapcat (fn [i item]
1092 | `[[:dup]
1093 | [:push ~(int i)]
1094 | ~@(emit-value (u/classify item) item)
1095 | [:array-store :java.lang.Object]])
1096 | (range) list)])
1097 |
1098 | (defmethod -emit-value :map [_ m]
1099 | (let [arr (mapcat identity m)
1100 | sorted? (sorted? m)
1101 | hmap? (= clojure.lang.PersistentHashMap (class m))]
1102 | (if (empty? m)
1103 | [(cond
1104 | sorted?
1105 | [:get-static :clojure.lang.PersistentTreeMap/EMPTY :clojure.lang.PersistentTreeMap]
1106 | hmap?
1107 | [:get-static :clojure.lang.PersistentHashMap/EMPTY :clojure.lang.PersistentHashMap]
1108 | :else
1109 | [:get-static :clojure.lang.PersistentArrayMap/EMPTY :clojure.lang.PersistentArrayMap])]
1110 | `[~@(emit-values-as-array arr)
1111 | ~@(cond
1112 | sorted?
1113 | [[:invoke-static [:clojure.lang.RT/seq :java.lang.Object] :clojure.lang.ISeq]
1114 | [:invoke-static [:clojure.lang.PersistentTreeMap/create :clojure.lang.ISeq] :clojure.lang.PersistentTreeMap]]
1115 | (and hmap? (<= (count m) 8))
1116 | [[:invoke-static [:clojure.lang.RT/seq :java.lang.Object] :clojure.lang.ISeq]
1117 | [:invoke-static [:clojure.lang.PersistentHashMap/create :clojure.lang.ISeq] :clojure.lang.PersistentHashMap]]
1118 | (and (= clojure.lang.PersistentArrayMap (class m)) (> (count m) 8))
1119 | [[:invoke-static [:clojure.lang.PersistentArrayMap/createAsIfByAssoc :objects] :clojure.lang.PersistentArrayMap]]
1120 | :else
1121 | [[:invoke-static [:clojure.lang.RT/map :objects] :clojure.lang.IPersistentMap]])])))
1122 |
1123 | (defmethod -emit-value :vector [_ v]
1124 | (if (empty? v)
1125 | [[:get-static :clojure.lang.PersistentVector/EMPTY :clojure.lang.PersistentVector]]
1126 | `[~@(emit-values-as-array v)
1127 | [:invoke-static [:clojure.lang.RT/vector :objects] :clojure.lang.IPersistentVector]]))
1128 |
1129 | (defmethod -emit-value :set [_ s]
1130 | (let [sorted? (sorted? s)]
1131 | (if (empty? s)
1132 | [(if sorted?
1133 | [:get-static :clojure.lang.PersistentTreeSet/EMPTY :clojure.lang.PersistentTreeSet]
1134 | [:get-static :clojure.lang.PersistentHashSet/EMPTY :clojure.lang.PersistentHashSet])]
1135 | `[~@(emit-values-as-array s)
1136 | ~@(if sorted?
1137 | [[:invoke-static [:clojure.lang.RT/seq :java.lang.Object] :clojure.lang.ISeq]
1138 | [:invoke-static [:clojure.lang.PersistentTreeSet/create :clojure.lang.ISeq] :clojure.lang.PersistentTreeSet]]
1139 | [[:invoke-static [:clojure.lang.RT/set :objects] :clojure.lang.IPersistentSet]])])))
1140 |
1141 | (defmethod -emit-value :seq [_ s]
1142 | (if (empty? s)
1143 | [[:get-static :clojure.lang.PersistentList/EMPTY :clojure.lang.PersistentList$EmptyList]]
1144 | `[~@(emit-values-as-array s)
1145 | [:invoke-static [:java.util.Arrays/asList :objects] :java.util.List]
1146 | [:invoke-static [:clojure.lang.PersistentList/create :java.util.List]
1147 | :clojure.lang.IPersistentList]]))
1148 |
1149 | (defmethod -emit-value :char [_ c]
1150 | [[:push c]
1151 | [:invoke-static [:java.lang.Character/valueOf :char] :java.lang.Character]])
1152 |
1153 | (defmethod -emit-value :regex [_ r]
1154 | `[~@(emit-value :string (str r))
1155 | [:invoke-static [:java.util.regex.Pattern/compile :java.lang.String]
1156 | :java.util.regex.Pattern]])
1157 |
1158 | (defmethod -emit-value :class [_ c]
1159 | (if (primitive? c)
1160 | [[:get-static (box c) "TYPE" :java.lang.Class]]
1161 | [[:push (.getName ^Class c)]
1162 | [:invoke-static [:java.lang.Class/forName :java.lang.String] :java.lang.Class]]))
1163 |
1164 | (defmethod -emit-value :record [_ r]
1165 | (let [r-class (.getName (class r))]
1166 | `[~@(emit-value :map r)
1167 | ~[:invoke-static [(keyword r-class "create") :clojure.lang.IPersistentMap] r-class]]))
1168 |
1169 | (defmethod -emit-value :type [_ t]
1170 | (let [t-class (.getName (class t))
1171 | fields (Reflector/invokeStaticMethod t-class "getBasis" (object-array []))]
1172 | `[[:new-instance ~t-class]
1173 | [:dup]
1174 | ~@(mapcat (fn [field]
1175 | (let [val (Reflector/getInstanceField t (name field))]
1176 | (emit-value (u/classify val) val))) fields)
1177 | [:invoke-constructor [~(keyword t-class "")
1178 | ~@(mapv (comp j.u/maybe-class :tag meta) fields)]
1179 | :void]]))
1180 |
1181 | (defmethod -emit-value :default [_ o]
1182 | (try
1183 | (let [s (binding [*print-dup* true] (pr-str o))]
1184 | (when (or (not (seq s))
1185 | (= "#<" (subs s 0 2)))
1186 | (throw (ex-info "Can't embed unreadable object in code"
1187 | {:object o})))
1188 | [[:push s]
1189 | [:invoke-static [:clojure.lang.RT/readString :java.lang.String] :java.lang.Object]])
1190 | (catch Exception e
1191 | (if (instance? clojure.lang.ExceptionInfo e)
1192 | (throw e)
1193 | (throw (ex-info "Can't embed object in code"
1194 | {:object o}))))))
1195 |
1196 | (defn emit-constants [{:keys [class constants]}]
1197 | (mapcat (fn [{:keys [val id tag type]}]
1198 | `[~@(emit-value (or type (u/classify val)) val)
1199 | [:check-cast ~tag]
1200 | ~[:put-static class (str "const__" id) tag]])
1201 | (vals constants)))
1202 |
1203 | (defn emit-keyword-callsites
1204 | [{:keys [keyword-callsites constants class]}]
1205 | (mapcat (fn [k]
1206 | (let [{:keys [id]} (constants {:form k :tag clojure.lang.Keyword :meta nil})]
1207 | `[[:new-instance :clojure.lang.KeywordLookupSite]
1208 | [:dup]
1209 | ~@(emit-value :keyword k)
1210 | [:invoke-constructor [:clojure.lang.KeywordLookupSite/ :clojure.lang.Keyword] :void]
1211 | [:dup]
1212 | ~[:put-static class (str "site__" id) :clojure.lang.KeywordLookupSite]
1213 | ~[:put-static class (str "thunk__" id) :clojure.lang.ILookupThunk]]))
1214 | keyword-callsites))
1215 |
1216 |
1217 | ;; TODO: generalize this for deftype/reify: needs mutable field handling + altCtor + annotations
1218 | ;; add smap
1219 |
1220 | (defn emit-class
1221 | [{:keys [class-name meta methods variadic? constants closed-overs keyword-callsites
1222 | protocol-callsites env annotations super interfaces op fields class-id]
1223 | :as ast}
1224 | {:keys [debug? class-loader] :as frame}]
1225 | (let [old-frame frame
1226 |
1227 | constants (into {}
1228 | (remove #(let [{:keys [tag type]} (val %)]
1229 | (or (primitive? tag)
1230 | (#{:string :bool} type)))
1231 | constants))
1232 |
1233 | consts (vals constants)
1234 | constant-table (zipmap (mapv :id consts) consts)
1235 |
1236 | frame (merge frame
1237 | {:class class-name
1238 | :constants constants
1239 | :constant-table constant-table
1240 | :closed-overs closed-overs
1241 | :keyword-callsites keyword-callsites
1242 | :protocol-callsites protocol-callsites})
1243 |
1244 | consts (mapv (fn [{:keys [id tag]}]
1245 | {:op :field
1246 | :attr #{:public :final :static}
1247 | :name (str "const__" id)
1248 | :tag tag})
1249 | consts)
1250 |
1251 | meta-field (when meta
1252 | [{:op :field
1253 | :attr #{:public :final}
1254 | :name "__meta"
1255 | :tag clojure.lang.IPersistentMap}])
1256 |
1257 | keyword-callsites (mapcat (fn [k]
1258 | (let [{:keys [id]} (constants {:form k :tag clojure.lang.Keyword :meta nil})]
1259 | [{:op :field
1260 | :attr #{:public :final :static}
1261 | :name (str "site__" id)
1262 | :tag clojure.lang.KeywordLookupSite}
1263 | {:op :field
1264 | :attr #{:public :final :static}
1265 | :name (str "thunk__" id)
1266 | :tag clojure.lang.ILookupThunk}]))
1267 | keyword-callsites)
1268 |
1269 | protocol-callsites (mapcat (fn [p]
1270 | (let [{:keys [id]} (constants {:form p :tag clojure.lang.Var :meta (clojure.core/meta p)})]
1271 | [{:op :field
1272 | :attr #{:private :static}
1273 | :name (str "cached__class__" id)
1274 | :tag java.lang.Class}]))
1275 | protocol-callsites)
1276 |
1277 | deftype? (= op :deftype)
1278 | defrecord? (contains? closed-overs '__meta)
1279 |
1280 | closed-overs (mapv (fn [{:keys [name local o-tag tag mutable] :as l}]
1281 | (merge l
1282 | {:op :field
1283 | :attr (when deftype?
1284 | (if mutable
1285 | #{mutable}
1286 | #{:public :final}))
1287 | :tag o-tag}))
1288 | (if deftype?
1289 | fields ;; preserve order
1290 | (vals closed-overs)))
1291 |
1292 | ctor-types (into (if meta [:clojure.lang.IPersistentMap] [])
1293 | (mapv (if deftype? (comp prim-or-obj :tag) :tag) closed-overs))
1294 |
1295 | class-ctors [{:op :method
1296 | :attr #{:public :static}
1297 | :method [[:] :void]
1298 | :code `[[:start-method]
1299 | ~@(emit-line-number env)
1300 | ~@(when (seq constants)
1301 | (emit-constants frame))
1302 | ~@(when (seq keyword-callsites)
1303 | (emit-keyword-callsites frame))
1304 | [:return-value]
1305 | [:end-method]]}
1306 | (let [[start-label end-label] (repeatedly label)]
1307 | {:op :method
1308 | :attr #{:public}
1309 | :method `[[: ~@ctor-types] :void]
1310 | :code `[[:start-method]
1311 | ~@(emit-line-number env)
1312 | [:label ~start-label]
1313 | [:load-this]
1314 | [:invoke-constructor [~(keyword (name super) "")] :void]
1315 | ~@(when meta
1316 | [[:load-this]
1317 | [:load-arg 0]
1318 | [:put-field class-name :__meta :clojure.lang.IPersistentMap]])
1319 | ~@(mapcat
1320 | (fn [{:keys [name tag]} t id]
1321 | `[[:load-this]
1322 | ~[:load-arg id]
1323 | ~@(emit-cast t tag)
1324 | ~[:put-field class-name name tag]])
1325 | closed-overs ctor-types (if meta (rest (range)) (range)))
1326 |
1327 | [:label ~end-label]
1328 | [:return-value]
1329 | [:end-method]]})]
1330 |
1331 | defrecord-ctor (when defrecord?
1332 | [{:op :method
1333 | :attr #{:public}
1334 | :method `[[: ~@(drop-last 2 ctor-types)] :void]
1335 | :code `[[:start-method]
1336 | [:load-this]
1337 | [:load-args]
1338 | [:insn :ACONST_NULL]
1339 | [:insn :ACONST_NULL]
1340 | [:invoke-constructor [~(keyword class-name "") ~@ctor-types] :void]
1341 | [:return-value]
1342 | [:end-method]]}])
1343 |
1344 | variadic-method (when variadic?
1345 | (let [required-arity (->> methods (filter :variadic?) first :fixed-arity)]
1346 | [{:op :method
1347 | :attr #{:public}
1348 | :method [[:getRequiredArity] :int]
1349 | :code `[[:start-method]
1350 | [:push ~(int required-arity)]
1351 | [:return-value]
1352 | [:end-method]]}]))
1353 |
1354 | meta-methods (when meta
1355 | [{:op :method
1356 | :attr #{:public}
1357 | :method `[[: ~@(rest ctor-types)] :void]
1358 | :code `[[:start-method]
1359 | [:load-this]
1360 | [:insn :ACONST_NULL]
1361 | [:load-args]
1362 | [:invoke-constructor [~(keyword class-name "")
1363 | ~@ctor-types] :void]
1364 | [:return-value]
1365 | [:end-method]]}
1366 | {:op :method
1367 | :attr #{:public}
1368 | :method`[[:meta] :clojure.lang.IPersistentMap]
1369 | :code [[:start-method]
1370 | [:load-this]
1371 | [:get-field class-name :__meta :clojure.lang.IPersistentMap]
1372 | [:return-value]
1373 | [:end-method]]}
1374 | {:op :method
1375 | :attr #{:public}
1376 | :method`[[:withMeta :clojure.lang.IPersistentMap] :clojure.lang.IObj]
1377 | :code `[[:start-method]
1378 | [:new-instance ~class-name]
1379 | [:dup]
1380 | [:load-arg 0]
1381 | ~@(mapcat
1382 | (fn [{:keys [name tag]}]
1383 | [[:load-this]
1384 | [:get-field class-name name tag]])
1385 | closed-overs)
1386 | [:invoke-constructor [~(keyword class-name "")
1387 | ~@ctor-types] :void]
1388 | [:return-value]
1389 | [:end-method]]}])
1390 |
1391 | deftype-fields (vec (remove '#{__meta __extmap} (mapv :form closed-overs)))
1392 |
1393 | deftype-methods (when deftype?
1394 | `[~{:op :method
1395 | :attr #{:public :static}
1396 | :method [[:getBasis] :clojure.lang.IPersistentVector]
1397 | :code `[[:start-method]
1398 | ~@(emit-value :vector (mapv munge deftype-fields))
1399 | [:return-value]
1400 | [:end-method]]}
1401 | ~@(when defrecord?
1402 | [{:op :method
1403 | :attr #{:public :static}
1404 | :method [[:create :clojure.lang.IPersistentMap] class-name]
1405 | :code `[[:start-method]
1406 | ~@(mapcat
1407 | (fn [field id]
1408 | `[[:load-arg 0]
1409 | ~@(emit-value :keyword field)
1410 | [:insn :ACONST_NULL]
1411 | [:invoke-interface [:clojure.lang.IPersistentMap/valAt :java.lang.Object :java.lang.Object] :java.lang.Object]
1412 | [:astore ~id]
1413 | [:load-arg 0]
1414 | ~@(emit-value :keyword field)
1415 | [:invoke-interface [:clojure.lang.IPersistentMap/without :java.lang.Object] :clojure.lang.IPersistentMap]
1416 | [:store-arg 0]])
1417 | deftype-fields (rest (range)))
1418 | [:new-instance ~class-name]
1419 | [:dup]
1420 | ~@(for [i (rest (range (inc (count deftype-fields))))]
1421 | [:var-insn :java.lang.Object/ILOAD i])
1422 | [:insn :ACONST_NULL]
1423 | [:load-arg 0]
1424 | [:invoke-static [:clojure.lang.RT/seqOrElse :java.lang.Object] :java.lang.Object]
1425 | [:invoke-constructor [~(keyword class-name "")
1426 | ~@ctor-types] :void]
1427 | [:return-value]
1428 | [:end-method]]}])])
1429 |
1430 | jvm-ast {:op :class
1431 | :debug? debug?
1432 | :attr #{:public :super :final}
1433 | :annotations annotations
1434 | :class-name class-name
1435 | :name class-name
1436 | :super super
1437 | :interfaces interfaces
1438 | :fields (concat consts keyword-callsites
1439 | meta-field closed-overs protocol-callsites)
1440 | :methods (concat class-ctors defrecord-ctor deftype-methods
1441 | variadic-method meta-methods
1442 | (mapcat #(-emit % frame) methods))}]
1443 |
1444 | (when-not (get-in @*classes* [:ids class-id])
1445 | (swap! *classes* update-in [:classes] conj jvm-ast)
1446 | (when class-id
1447 | (swap! *classes* update-in [:ids] conj class-id)))
1448 |
1449 | (if deftype?
1450 | [[:insn :ACONST_NULL]]
1451 | `[[:new-instance ~class-name]
1452 | [:dup]
1453 | ~@(when meta
1454 | [[:insn :ACONST_NULL]])
1455 | ~@(mapcat #(emit (assoc % :op :local) old-frame)
1456 | closed-overs)
1457 | [:invoke-constructor [~(keyword class-name "")
1458 | ~@ctor-types] :void]])))
1459 |
1460 | (defmethod -emit :reify
1461 | [{:keys [class-name] :as ast}
1462 | frame]
1463 | (let [class-name (.getName ^Class class-name)
1464 | ast (assoc ast
1465 | :class-name class-name
1466 | :super :java.lang.Object
1467 | :meta {})]
1468 | (emit-class ast frame)))
1469 |
1470 | (defmethod -emit :deftype
1471 | [{:keys [class-name] :as ast}
1472 | frame]
1473 | (let [class-name (.getName ^Class class-name)
1474 | ast (assoc ast
1475 | :class-name class-name
1476 | :super :java.lang.Object)]
1477 | (with-meta
1478 | (emit-class ast frame)
1479 | {:untyped true})))
1480 |
1481 | (defmethod -emit :fn
1482 | [{:keys [form internal-name variadic?] :as ast}
1483 | frame]
1484 | (let [class-name (str (namespace-munge *ns*)
1485 | "$"
1486 | (munge internal-name))
1487 | super (if variadic? :clojure.lang.RestFn :clojure.lang.AFunction)
1488 | ast (assoc ast
1489 | :class-name class-name
1490 | :super super)]
1491 | (emit-class ast frame)))
1492 |
--------------------------------------------------------------------------------