blob: 044a4f099b1c463a1b2c9f29230ee40600ccb2a3 (
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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
(ns lux.compiler.js.base
(:refer-clojure :exclude [compile])
(:require (clojure [string :as string]
[set :as set]
[template :refer [do-template]])
clojure.core.match
clojure.core.match.array
(lux [base :as & :refer [deftuple |let |do return* return |case]]
[host :as &host])
[lux.compiler.core :as &&]
)
(:import (jdk.nashorn.api.scripting NashornScriptEngineFactory
NashornScriptEngine
ScriptObjectMirror
JSObject)
(jdk.nashorn.internal.runtime Undefined)
(java.io File
BufferedOutputStream
FileOutputStream))
)
(deftuple
["interpreter"
"buffer"])
(defn js-host []
(&/T [;; "interpreter"
(.getScriptEngine (new NashornScriptEngineFactory))
;; "buffer"
&/$None
]))
(defn run-js! [^String js-code]
(fn [compiler-state]
(|let [^NashornScriptEngine interpreter (->> compiler-state (&/get$ &/$host) (&/get$ $interpreter))]
(try (&/$Right (&/T [compiler-state
(.eval interpreter js-code)]))
(catch Exception ex
(&/$Left (str ex)))))))
(def ^:private lux-obj-class (Class/forName "[Ljava.lang.Object;"))
(defn ^:private _slice_ [wrap-lux-obj value]
(reify JSObject
(isFunction [self] true)
(call [self this args]
(let [slice (java.util.Arrays/copyOfRange value (aget args 0) (alength value))]
(wrap-lux-obj slice)))))
(defn ^:private _toString_ [obj]
(reify JSObject
(isFunction [self] true)
(call [self this args]
(&/adt->text obj)
)))
(defn ^:private _toString_simple [^String obj]
(reify JSObject
(isFunction [self] true)
(call [self this args]
obj
)))
(def ^:private i64-mask (dec (bit-shift-left 1 32)))
(deftype I64 [value]
JSObject
(getMember [self member]
(condp = member
"H" (-> value (unsigned-bit-shift-right 32) (bit-and i64-mask) int)
"L" (-> value (bit-and i64-mask) int)
;; else
(assert false (str "I64#getMember = " member)))))
(defn ^:private encode-char [value]
(reify JSObject
(getMember [self member]
(condp = member
"C" value
;; "toString" (_toString_simple value)
;; else
(assert false (str "encode-char#getMember = " member))))))
(deftype LuxJsObject [obj]
JSObject
(isFunction [self] false)
(getSlot [self idx]
(let [value (aget obj idx)]
(cond (instance? lux-obj-class value)
(new LuxJsObject value)
(instance? java.lang.Long value)
(new I64 value)
(instance? java.lang.Character value)
(encode-char (str value))
:else
value)))
(getMember [self member]
(condp = member
"toString" (_toString_ obj)
"length" (alength obj)
"slice" (_slice_ #(new LuxJsObject %) obj)
;; else
(assert false (str "wrap-lux-obj#getMember = " member)))))
(defn wrap-lux-obj [obj]
(if (instance? lux-obj-class obj)
(new LuxJsObject obj)
obj))
(defn ^:private int64? [^ScriptObjectMirror js-object]
(and (.hasMember js-object "H")
(.hasMember js-object "L")))
(defn ^:private encoded-char? [^ScriptObjectMirror js-object]
(.hasMember js-object "C"))
(defn ^:private decode-char [^ScriptObjectMirror js-object]
(-> (.getMember js-object "C")
(.charAt 0)))
(defn ^:private parse-int64 [^ScriptObjectMirror js-object]
(+ (-> (.getMember js-object "H")
long
(bit-shift-left 32))
(-> (.getMember js-object "L")
long)))
(defn js-to-lux [js-object]
(cond (or (nil? js-object)
(instance? java.lang.Boolean js-object)
(instance? java.lang.Integer js-object)
(instance? java.lang.String js-object))
js-object
(instance? java.lang.Number js-object)
(double js-object)
(instance? LuxJsObject js-object)
(.-obj ^LuxJsObject js-object)
(instance? I64 js-object)
(.-value ^I64 js-object)
;; (instance? Undefined js-object)
;; (assert false "UNDEFINED")
(instance? ScriptObjectMirror js-object)
(let [^ScriptObjectMirror js-object js-object]
(cond (.isArray js-object)
(let [array-vec (loop [num-keys (.size js-object)
idx 0
array-vec []]
(if (< idx num-keys)
(let [idx-key (str idx)]
(if (.hasMember js-object idx-key)
(recur num-keys
(inc idx)
(conj array-vec (js-to-lux (.getMember js-object idx-key))))
(recur (inc num-keys)
(inc idx)
(conj array-vec nil))))
array-vec))]
(&/T array-vec))
(.isFunction js-object)
js-object
(int64? js-object)
(parse-int64 js-object)
(encoded-char? js-object)
(decode-char js-object)
:else
(assert false (str "Unknown kind of JS object: " js-object))))
:else
(assert false (str "Unknown kind of JS object: " (class js-object) " :: " js-object))))
(defn run-js!+ [^String js-code]
(|do [raw (run-js! js-code)]
(return (js-to-lux raw))))
(def ^String unit (pr-str &/unit-tag))
(defn save-js! [name ^String script]
(|do [_ (run-js! script)
eval? &/get-eval
module &/get-module-name
:let [_ (when (not eval?)
(let [^String module* (&host/->module-class module)
module-dir (str @&&/!output-dir java.io.File/separator (.replace module* "/" java.io.File/separator))]
(do (.mkdirs (File. module-dir))
(&&/write-file (str module-dir java.io.File/separator (&host/def-name name) ".js") (.getBytes script)))))]]
(return nil)))
|
