blob: 47566a626a6d047ba31b89fbb1d9e825230e11a5 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
(ns lux.compiler.jvm.base
(:require (clojure [template :refer [do-template]]
[string :as string])
[clojure.java.io :as io]
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
(lux [base :as & :refer [|let |do return* return fail*]]
[type :as &type]
[host :as &host])
(lux.analyser [base :as &a]
[module :as &a-module])
[lux.host.generics :as &host-generics]
[lux.compiler.core :as &&])
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
MethodVisitor)
(java.io File
BufferedOutputStream
FileOutputStream)
(java.lang.reflect Field)))
;; [Constants]
(def ^:const ^String function-class
(&host/internal &host/function-class))
(def ^:const ^String lux-utils-class
(&host/internal &host/lux-utils-class))
(def ^:const ^String unit-tag-field "unit_tag")
;; Formats
(def ^:const ^String local-prefix "l")
(def ^:const ^String partial-prefix "p")
(def ^:const ^String closure-prefix "c")
(def ^:const ^String apply-method "apply")
(defn ^String apply-signature [n]
(str "(" (apply str (repeat n "Ljava/lang/Object;")) ")Ljava/lang/Object;"))
(def ^:const num-apply-variants 8)
(def ^:const arity-field "_arity_")
(def ^:const partials-field "_partials_")
;; [Utils]
(defn ^:private write-output [module name data]
(let [^String module* (&host/->module-class module)
module-dir (str @&&/!output-dir java.io.File/separator (.replace module* "/" java.io.File/separator))]
(.mkdirs (File. module-dir))
(&&/write-file (str module-dir java.io.File/separator name ".class") data)))
(defn class-exists?
"(-> Text Text (IO Bit))"
[^String module ^String class-name]
(|do [_ (return nil)
:let [full-path (str @&&/!output-dir java.io.File/separator module java.io.File/separator class-name ".class")
exists? (.exists (File. full-path))]]
(return exists?)))
;; [Exports]
(defn ^Class load-class! [^ClassLoader loader name]
(.loadClass loader name))
(defn save-class! [name bytecode]
(|do [eval? &/get-eval
module &/get-module-name
loader &/loader
!classes &/classes
:let [real-name (str (&host-generics/->class-name module) "." name)
_ (swap! !classes assoc real-name bytecode)
_ (when (not eval?)
(write-output module name bytecode))
;; _ (load-class! loader real-name)
]]
(return nil)))
(do-template [<wrap-name> <unwrap-name> <class> <unwrap-method> <prim> <dup>]
(do (defn <wrap-name> [^MethodVisitor writer]
(doto writer
(.visitMethodInsn Opcodes/INVOKESTATIC <class> "valueOf" (str "(" <prim> ")" (&host-generics/->type-signature <class>)))))
(defn <unwrap-name> [^MethodVisitor writer]
(doto writer
(.visitTypeInsn Opcodes/CHECKCAST <class>)
(.visitMethodInsn Opcodes/INVOKEVIRTUAL <class> <unwrap-method> (str "()" <prim>)))))
wrap-boolean unwrap-boolean "java/lang/Boolean" "booleanValue" "Z" Opcodes/DUP_X1
wrap-byte unwrap-byte "java/lang/Byte" "byteValue" "B" Opcodes/DUP_X1
wrap-short unwrap-short "java/lang/Short" "shortValue" "S" Opcodes/DUP_X1
wrap-int unwrap-int "java/lang/Integer" "intValue" "I" Opcodes/DUP_X1
wrap-long unwrap-long "java/lang/Long" "longValue" "J" Opcodes/DUP_X2
wrap-float unwrap-float "java/lang/Float" "floatValue" "F" Opcodes/DUP_X1
wrap-double unwrap-double "java/lang/Double" "doubleValue" "D" Opcodes/DUP_X2
wrap-char unwrap-char "java/lang/Character" "charValue" "C" Opcodes/DUP_X1
)
|
