aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEduardo Julian2015-09-14 23:27:38 -0400
committerEduardo Julian2015-09-14 23:27:38 -0400
commit8a67a7e51b3875c3ebba4e8d0acbd275aaa2c356 (patch)
treeb4b3fe1cb8ce02e9754d11dc9e24b442fa4b6f09 /src
parent12402b01ce04428fee46a9441a4d1f4cf16db179 (diff)
- Added the possibility to define anonymous classes.
- Fixed some bugs.
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj62
-rw-r--r--src/lux/analyser/host.clj307
-rw-r--r--src/lux/base.clj5
-rw-r--r--src/lux/compiler.clj24
-rw-r--r--src/lux/compiler/host.clj166
-rw-r--r--src/lux/host.clj69
-rw-r--r--src/lux/type.clj6
7 files changed, 390 insertions, 249 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 03709b226..a412362d9 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -71,85 +71,85 @@
(defn ^:private aba7 [analyse eval! compile-module compile-token exo-type token]
(|case token
;; Arrays
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_znewarray")] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_znewarray")] (&/$Cons ?length (&/$Nil))))
(&&host/analyse-jvm-znewarray analyse ?length)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_zastore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_zastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
(&&host/analyse-jvm-zastore analyse ?array ?idx ?elem)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_zaload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_zaload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
(&&host/analyse-jvm-zaload analyse ?array ?idx)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_bnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_bnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons ?length (&/$Nil)))))
(&&host/analyse-jvm-bnewarray analyse ?length)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_bastore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_bastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
(&&host/analyse-jvm-bastore analyse ?array ?idx ?elem)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_baload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_baload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
(&&host/analyse-jvm-baload analyse ?array ?idx)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_snewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_snewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons ?length (&/$Nil)))))
(&&host/analyse-jvm-snewarray analyse ?length)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_sastore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_sastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
(&&host/analyse-jvm-sastore analyse ?array ?idx ?elem)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_saload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_saload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
(&&host/analyse-jvm-saload analyse ?array ?idx)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_inewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_inewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons ?length (&/$Nil)))))
(&&host/analyse-jvm-inewarray analyse ?length)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_iastore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_iastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
(&&host/analyse-jvm-iastore analyse ?array ?idx ?elem)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_iaload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_iaload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
(&&host/analyse-jvm-iaload analyse ?array ?idx)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons ?length (&/$Nil)))))
(&&host/analyse-jvm-lnewarray analyse ?length)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lastore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
(&&host/analyse-jvm-lastore analyse ?array ?idx ?elem)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_laload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_laload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
(&&host/analyse-jvm-laload analyse ?array ?idx)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_fnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_fnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons ?length (&/$Nil)))))
(&&host/analyse-jvm-fnewarray analyse ?length)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_fastore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_fastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
(&&host/analyse-jvm-fastore analyse ?array ?idx ?elem)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_faload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_faload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
(&&host/analyse-jvm-faload analyse ?array ?idx)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_dnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_dnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons ?length (&/$Nil)))))
(&&host/analyse-jvm-dnewarray analyse ?length)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_dastore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_dastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
(&&host/analyse-jvm-dastore analyse ?array ?idx ?elem)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_daload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_daload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
(&&host/analyse-jvm-daload analyse ?array ?idx)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_cnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_cnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons ?length (&/$Nil)))))
(&&host/analyse-jvm-cnewarray analyse ?length)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_castore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_castore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
(&&host/analyse-jvm-castore analyse ?array ?idx ?elem)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_caload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_caload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
(&&host/analyse-jvm-caload analyse ?array ?idx)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_anewarray")] (&/$Cons [_ (&/$TextS ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_anewarray")] (&/$Cons [_ (&/$TextS ?class)] (&/$Cons ?length (&/$Nil)))))
(&&host/analyse-jvm-anewarray analyse ?class ?length)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_aastore")] (&/$Cons [_ (&/$TextS ?class)] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil)))))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_aastore")] (&/$Cons [_ (&/$TextS ?class)] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil)))))))
(&&host/analyse-jvm-aastore analyse ?class ?array ?idx ?elem)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_aaload")] (&/$Cons [_ (&/$TextS ?class)] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil))))))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_aaload")] (&/$Cons [_ (&/$TextS ?class)] (&/$Cons ?array (&/$Cons ?idx (&/$Nil))))))
(&&host/analyse-jvm-aaload analyse ?class ?array ?idx)
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_arraylength")] (&/$Cons ?array (&/$Nil))))
@@ -173,6 +173,14 @@
(|do [=supers (&/map% extract-text ?supers)]
(&&host/analyse-jvm-interface analyse compile-token ?name =supers ?methods))
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_anon-class")]
+ (&/$Cons [_ (&/$TextS ?super-class)]
+ (&/$Cons [_ (&/$TupleS ?interfaces)]
+ (&/$Cons [_ (&/$TupleS ?methods)]
+ (&/$Nil))))))
+ (|do [=interfaces (&/map% extract-text ?interfaces)]
+ (&&host/analyse-jvm-anon-class analyse compile-token exo-type ?super-class =interfaces ?methods))
+
;; Programs
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_program")]
(&/$Cons [_ (&/$SymbolS "" ?args)]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index db04a60c0..f6963d8bf 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -12,7 +12,9 @@
[type :as &type]
[host :as &host])
(lux.analyser [base :as &&]
- [env :as &&env])))
+ [lambda :as &&lambda]
+ [env :as &&env])
+ [lux.compiler.base :as &c!base]))
;; [Utils]
(defn ^:private extract-text [ast]
@@ -65,14 +67,6 @@
output)))))
))
-(defn ^:private analyse-1+ [analyse token]
- (&type/with-var
- (fn [$var]
- (|do [=expr (&&/analyse-1 analyse $var token)
- :let [[item type] =expr]
- =type (&type/clean $var type)]
- (return (&/T item =type))))))
-
(defn ^:private ensure-object [token]
"(-> Analysis (Lux (,)))"
(|case token
@@ -215,7 +209,7 @@
(return (&/|list (&/T (&/V &&/$jvm-invokestatic (&/T class method classes =args)) output-type)))))
(defn analyse-jvm-instanceof [analyse exo-type class object]
- (|do [=object (analyse-1+ analyse object)
+ (|do [=object (&&/analyse-1+ analyse object)
_ (ensure-object =object)
:let [output-type &type/Bool]
_ (&type/check exo-type output-type)]
@@ -258,14 +252,14 @@
(return (&/|list (&/T (&/V &&/$jvm-invokespecial (&/T class method classes =object =args)) output-type)))))
(defn analyse-jvm-null? [analyse exo-type object]
- (|do [=object (analyse-1+ analyse object)
+ (|do [=object (&&/analyse-1+ analyse object)
_ (ensure-object =object)
:let [output-type &type/Bool]
_ (&type/check exo-type output-type)]
(return (&/|list (&/T (&/V &&/$jvm-null? =object) output-type)))))
(defn analyse-jvm-null [analyse exo-type]
- (|do [:let [output-type (&type/Data$ "null" &/Nil$)]
+ (|do [:let [output-type (&type/Data$ &host/null-data-tag &/Nil$)]
_ (&type/check exo-type output-type)]
(return (&/|list (&/T (&/V &&/$jvm-null nil) output-type)))))
@@ -280,18 +274,23 @@
(do-template [<class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>]
(let [elem-type (&type/Data$ <class> &/Nil$)
- array-type (&type/Data$ "Array" (&/|list elem-type))]
+ array-type (&type/Data$ &host/array-data-tag (&/|list elem-type))
+ length-type &type/Int
+ idx-type &type/Int]
(defn <new-name> [analyse length]
- (return (&/|list (&/T (&/V <new-tag> length) array-type))))
+ (|do [=length (&&/analyse-1 analyse length-type length)]
+ (return (&/|list (&/T (&/V <new-tag> =length) array-type)))))
(defn <load-name> [analyse array idx]
- (|do [=array (&&/analyse-1 analyse array-type array)]
- (return (&/|list (&/T (&/V <load-tag> (&/T =array idx)) elem-type)))))
+ (|do [=array (&&/analyse-1 analyse array-type array)
+ =idx (&&/analyse-1 analyse idx-type idx)]
+ (return (&/|list (&/T (&/V <load-tag> (&/T =array =idx)) elem-type)))))
(defn <store-name> [analyse array idx elem]
(|do [=array (&&/analyse-1 analyse array-type array)
+ =idx (&&/analyse-1 analyse idx-type idx)
=elem (&&/analyse-1 analyse elem-type elem)]
- (return (&/|list (&/T (&/V <store-tag> (&/T =array idx =elem)) array-type)))))
+ (return (&/|list (&/T (&/V <store-tag> (&/T =array =idx =elem)) array-type)))))
)
"java.lang.Boolean" analyse-jvm-znewarray &&/$jvm-znewarray analyse-jvm-zaload &&/$jvm-zaload analyse-jvm-zastore &&/$jvm-zastore
@@ -304,30 +303,35 @@
"java.lang.Character" analyse-jvm-cnewarray &&/$jvm-cnewarray analyse-jvm-caload &&/$jvm-caload analyse-jvm-castore &&/$jvm-castore
)
-(defn analyse-jvm-anewarray [analyse class length]
- (let [elem-type (&type/Data$ class &/Nil$)
- array-type (&type/Data$ "Array" (&/|list elem-type))]
- (return (&/|list (&/T (&/V &&/$jvm-anewarray (&/T class length)) array-type)))))
-
-(defn analyse-jvm-aaload [analyse class array idx]
- (let [elem-type (&type/Data$ class &/Nil$)
- array-type (&type/Data$ "Array" (&/|list elem-type))]
- (|do [=array (&&/analyse-1 analyse array-type array)]
- (return (&/|list (&/T (&/V &&/$jvm-aaload (&/T class =array idx)) elem-type))))))
+(let [length-type &type/Int
+ idx-type &type/Int]
+ (defn analyse-jvm-anewarray [analyse class length]
+ (let [elem-type (&type/Data$ class &/Nil$)
+ array-type (&type/Data$ &host/array-data-tag (&/|list elem-type))]
+ (|do [=length (&&/analyse-1 analyse length-type length)]
+ (return (&/|list (&/T (&/V &&/$jvm-anewarray (&/T class =length)) array-type))))))
+
+ (defn analyse-jvm-aaload [analyse class array idx]
+ (let [elem-type (&type/Data$ class &/Nil$)
+ array-type (&type/Data$ &host/array-data-tag (&/|list elem-type))]
+ (|do [=array (&&/analyse-1 analyse array-type array)
+ =idx (&&/analyse-1 analyse idx-type idx)]
+ (return (&/|list (&/T (&/V &&/$jvm-aaload (&/T class =array =idx)) elem-type))))))
-(defn analyse-jvm-aastore [analyse class array idx elem]
- (let [elem-type (&type/Data$ class &/Nil$)
- array-type (&type/Data$ "Array" (&/|list elem-type))]
- (|do [=array (&&/analyse-1 analyse array-type array)
- =elem (&&/analyse-1 analyse elem-type elem)]
- (return (&/|list (&/T (&/V &&/$jvm-aastore (&/T class =array idx =elem)) array-type))))))
+ (defn analyse-jvm-aastore [analyse class array idx elem]
+ (let [elem-type (&type/Data$ class &/Nil$)
+ array-type (&type/Data$ &host/array-data-tag (&/|list elem-type))]
+ (|do [=array (&&/analyse-1 analyse array-type array)
+ =idx (&&/analyse-1 analyse idx-type idx)
+ =elem (&&/analyse-1 analyse elem-type elem)]
+ (return (&/|list (&/T (&/V &&/$jvm-aastore (&/T class =array =idx =elem)) array-type)))))))
(let [length-type (&type/Data$ "java.lang.Long" &/Nil$)]
(defn analyse-jvm-arraylength [analyse array]
(&type/with-var
(fn [$var]
(let [elem-type $var
- array-type (&type/Data$ "Array" (&/|list elem-type))]
+ array-type (&type/Data$ &host/array-data-tag (&/|list elem-type))]
(|do [=array (&&/analyse-1 analyse array-type array)]
(return (&/|list (&/T (&/V &&/$jvm-arraylength =array) length-type)))))))))
@@ -367,68 +371,85 @@
:concurrency nil}
modifiers))
-(defn analyse-jvm-class [analyse compile-token ?name ?super-class ?interfaces ?fields ?methods]
- (|do [class-loader &/loader
- abstract-methods (&/flat-map% (partial &host/abstract-methods class-loader) (&/Cons$ ?super-class ?interfaces))
- =fields (&/map% (fn [?field]
- (|case ?field
- [_ (&/$FormS (&/$Cons [_ (&/$TextS ?field-name)]
- (&/$Cons [_ (&/$TextS ?field-type)]
- (&/$Cons [_ (&/$TupleS ?field-modifiers)]
- (&/$Nil)))))]
- (|do [=field-modifiers (analyse-modifiers ?field-modifiers)]
- (return {:name ?field-name
- :modifiers =field-modifiers
- :type ?field-type}))
-
- _
- (fail "[Analyser Error] Wrong syntax for field.")))
- ?fields)
- =methods (&/map% (fn [?method]
- (|case ?method
- [?idx [_ (&/$FormS (&/$Cons [_ (&/$TextS ?method-name)]
- (&/$Cons [_ (&/$TupleS ?method-inputs)]
- (&/$Cons [_ (&/$TextS ?method-output)]
- (&/$Cons [_ (&/$TupleS ?method-modifiers)]
- (&/$Cons ?method-body
- (&/$Nil)))))))]]
- (|do [=method-inputs (&/map% (fn [minput]
- (|case minput
- [_ (&/$FormS (&/$Cons [_ (&/$SymbolS "" ?input-name)]
- (&/$Cons [_ (&/$TextS ?input-type)]
- (&/$Nil))))]
- (return (&/T ?input-name ?input-type))
-
- _
- (fail "[Analyser Error] Wrong syntax for method input.")))
- ?method-inputs)
- =method-modifiers (analyse-modifiers ?method-modifiers)
- =method-body (&/with-scope (str ?name "_" ?idx)
- (&/fold (fn [body* input*]
- (|let [[iname itype] input*]
- (&&env/with-local iname (&type/Data$ (as-otype itype) &/Nil$)
- body*)))
- (if (= "void" ?method-output)
- (analyse-1+ analyse ?method-body)
- (&&/analyse-1 analyse (&type/Data$ (as-otype ?method-output) &/Nil$) ?method-body))
- (&/|reverse (if (:static? =method-modifiers)
- =method-inputs
- (&/Cons$ (&/T "this" ?super-class)
- =method-inputs)))))]
- (return {:name ?method-name
- :modifiers =method-modifiers
- :inputs (&/|map &/|second =method-inputs)
- :output ?method-output
- :body =method-body}))
-
- _
- (fail "[Analyser Error] Wrong syntax for method.")))
- (&/enumerate ?methods))
- ;; Test for method completion
+(defn ^:private analyse-field [field]
+ (|case field
+ [_ (&/$FormS (&/$Cons [_ (&/$TextS ?field-name)]
+ (&/$Cons [_ (&/$TextS ?field-type)]
+ (&/$Cons [_ (&/$TupleS ?field-modifiers)]
+ (&/$Nil)))))]
+ (|do [=field-modifiers (analyse-modifiers ?field-modifiers)]
+ (return {:name ?field-name
+ :modifiers =field-modifiers
+ :type ?field-type}))
+
+ _
+ (fail "[Analyser Error] Wrong syntax for field.")))
+
+(defn ^:private analyse-method [analyse name owner-class method]
+ (|case method
+ [idx [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)]
+ (&/$Cons [_ (&/$TupleS method-inputs)]
+ (&/$Cons [_ (&/$TextS method-output)]
+ (&/$Cons [_ (&/$TupleS method-modifiers)]
+ (&/$Cons method-body
+ (&/$Nil)))))))]]
+ (|do [=method-modifiers (analyse-modifiers method-modifiers)
+ =method-inputs (&/map% (fn [minput]
+ (|case minput
+ [_ (&/$FormS (&/$Cons [_ (&/$SymbolS "" input-name)]
+ (&/$Cons [_ (&/$TextS input-type)]
+ (&/$Nil))))]
+ (return (&/T input-name input-type))
+
+ _
+ (fail "[Analyser Error] Wrong syntax for method input.")))
+ method-inputs)
+ =method-body (&/fold (fn [body* input*]
+ (|let [[iname itype] input*]
+ (&&env/with-local iname (&type/Data$ (as-otype itype) &/Nil$)
+ body*)))
+ (if (= "void" method-output)
+ (&&/analyse-1+ analyse method-body)
+ (&&/analyse-1 analyse (&type/Data$ (as-otype method-output) &/Nil$) method-body))
+ (&/|reverse (&/Cons$ (&/T "this" owner-class)
+ =method-inputs)))]
+ (return {:name method-name
+ :modifiers =method-modifiers
+ :inputs (&/|map &/|second =method-inputs)
+ :output method-output
+ :body =method-body}))
+
+ _
+ (fail "[Analyser Error] Wrong syntax for method.")))
+
+(defn ^:private analyse-method-decl [method]
+ (|case method
+ [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)]
+ (&/$Cons [_ (&/$TupleS inputs)]
+ (&/$Cons [_ (&/$TextS output)]
+ (&/$Cons [_ (&/$TupleS modifiers)]
+ (&/$Nil))))))]
+ (|do [=inputs (&/map% extract-text inputs)
+ =modifiers (analyse-modifiers modifiers)]
+ (return {:name method-name
+ :modifiers =modifiers
+ :inputs =inputs
+ :output output}))
+
+ _
+ (fail (str "[Analyser Error] Invalid method signature: " (&/show-ast method)))))
+
+(defn ^:private mandatory-methods [supers]
+ (|do [class-loader &/loader]
+ (&/flat-map% (partial &host/abstract-methods class-loader) supers)))
+
+(defn ^:private check-method-completion [supers methods]
+ "(-> (List ClassName) (List MethodDesc) (Lux (,)))"
+ (|do [abstract-methods (mandatory-methods supers)
:let [methods-map (&/fold (fn [mmap mentry]
(assoc mmap (:name mentry) mentry))
{}
- =methods)
+ methods)
missing-method (&/fold (fn [missing abs-meth]
(|let [[am-name am-inputs] abs-meth]
(or missing
@@ -442,36 +463,74 @@
am-name))
am-name))))
nil
- abstract-methods)]
- _ (if (nil? missing-method)
- (return nil)
- (fail (str "[Analyser Error] Missing method: " missing-method)))
- _ (compile-token (&/V &&/$jvm-class (&/T ?name ?super-class ?interfaces =fields =methods)))
- ;; :let [_ (prn 'analyse-jvm-class ?name ?super-class)]
- ]
- (return &/Nil$)))
+ abstract-methods)]]
+ (if (nil? missing-method)
+ (return nil)
+ (fail (str "[Analyser Error] Missing method: " missing-method)))))
+
+(defn analyse-jvm-class [analyse compile-token name super-class interfaces fields methods]
+ (&/with-closure
+ (|do [module &/get-module-name
+ ;; :let [_ (prn 'analyse-jvm-class/_0)]
+ =fields (&/map% analyse-field fields)
+ ;; :let [_ (prn 'analyse-jvm-class/_1)]
+ =methods (&/map% (partial analyse-method analyse name super-class) (&/enumerate methods))
+ ;; :let [_ (prn 'analyse-jvm-class/_2)]
+ _ (check-method-completion (&/Cons$ super-class interfaces) =methods)
+ ;; :let [_ (prn 'analyse-jvm-class/_3)]
+ _ (compile-token (&/V &&/$jvm-class (&/T name super-class interfaces =fields =methods nil)))
+ :let [_ (println 'DEF (str module "." name))]]
+ (return &/Nil$))))
(defn analyse-jvm-interface [analyse compile-token name supers methods]
- (|do [=methods (&/map% (fn [method]
- (|case method
- [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)]
- (&/$Cons [_ (&/$TupleS inputs)]
- (&/$Cons [_ (&/$TextS output)]
- (&/$Cons [_ (&/$TupleS modifiers)]
- (&/$Nil))))))]
- (|do [=inputs (&/map% extract-text inputs)
- =modifiers (analyse-modifiers modifiers)]
- (return {:name method-name
- :modifiers =modifiers
- :inputs =inputs
- :output output}))
-
- _
- (fail (str "[Analyser Error] Invalid method signature: " (&/show-ast method)))))
- methods)
- _ (compile-token (&/V &&/$jvm-interface (&/T name supers =methods)))]
+ (|do [module &/get-module-name
+ =methods (&/map% analyse-method-decl methods)
+ _ (compile-token (&/V &&/$jvm-interface (&/T name supers =methods)))
+ :let [_ (println 'DEF (str module "." name))]]
(return &/Nil$)))
+(defn ^:private captured-source [env-entry]
+ (|case env-entry
+ [name [(&&/$captured _ _ source) _]]
+ source))
+
+(let [captured-slot-modifier {:visibility "private"
+ :static? false
+ :final? false
+ :abstract? false
+ :concurrency nil}
+ captured-slot-type "java.lang.Object"]
+ (defn analyse-jvm-anon-class [analyse compile-token exo-type super-class interfaces methods]
+ (&/with-closure
+ (|do [;; :let [_ (prn 'analyse-jvm-anon-class/_0 super-class)]
+ module &/get-module-name
+ scope &/get-scope-name
+ ;; :let [_ (prn 'analyse-jvm-anon-class/_1 super-class)]
+ :let [name (&host/location (&/|tail scope))
+ anon-class (str module "." name)]
+ ;; :let [_ (prn 'analyse-jvm-anon-class/_2 name anon-class)]
+ =methods (&/map% (partial analyse-method analyse name super-class) (&/enumerate methods))
+ ;; :let [_ (prn 'analyse-jvm-anon-class/_3 name anon-class)]
+ _ (check-method-completion (&/Cons$ super-class interfaces) =methods)
+ ;; :let [_ (prn 'analyse-jvm-anon-class/_4 name anon-class)]
+ =captured &&env/captured-vars
+ :let [=fields (&/|map (fn [idx+capt]
+ {:name (str &c!base/closure-prefix (aget idx+capt 0))
+ :modifiers captured-slot-modifier
+ :type captured-slot-type})
+ (&/enumerate =captured))
+ ;; _ (prn '=methods (&/adt->text (&/|map :body =methods)))
+ ;; =methods* (rename-captured-vars)
+ ]
+ :let [sources (&/|map captured-source =captured)]
+ ;; :let [_ (prn 'analyse-jvm-anon-class/_5 name anon-class)]
+ ;; _ (compile-token (&/T (&/V &&/$jvm-anon-class (&/T name super-class interfaces =captured =methods)) exo-type))
+ _ (compile-token (&/V &&/$jvm-class (&/T name super-class interfaces =fields =methods =captured)))
+ :let [_ (println 'DEF anon-class)]]
+ (return (&/|list (&/T (&/V &&/$jvm-new (&/T anon-class (&/|repeat (&/|length sources) captured-slot-type) sources)) (&type/Data$ anon-class (&/|list)))))
+ ;; (analyse-jvm-new analyse exo-type anon-class (&/|repeat (&/|length sources) captured-slot-type) sources)
+ ))))
+
(defn analyse-jvm-try [analyse exo-type ?body ?catches+?finally]
(|do [:let [[?catches ?finally] ?catches+?finally]
=catches (&/map% (fn [[?ex-class ?ex-arg ?catch-body]]
@@ -485,19 +544,17 @@
(&&/analyse-1 analyse exo-type ?body))
=finally (|case ?finally
(&/$None) (return &/None$)
- (&/$Some ?finally*) (|do [=finally (analyse-1+ analyse ?finally*)]
+ (&/$Some ?finally*) (|do [=finally (&&/analyse-1+ analyse ?finally*)]
(return (&/V &/$Some =finally))))]
(return (&/|list (&/T (&/V &&/$jvm-try (&/T =body =catches =finally)) exo-type)))))
(defn analyse-jvm-throw [analyse exo-type ?ex]
- (|do [=ex (analyse-1+ analyse ?ex)
- :let [[_obj _type] =ex]
- _ (&type/check (&type/Data$ "java.lang.Throwable" &/Nil$) _type)]
- (return (&/|list (&/T (&/V &&/$jvm-throw =ex) &type/$Void)))))
+ (|do [=ex (&&/analyse-1 analyse (&type/Data$ "java.lang.Throwable" &/Nil$) ?ex)]
+ (return (&/|list (&/T (&/V &&/$jvm-throw =ex) exo-type)))))
(do-template [<name> <tag>]
(defn <name> [analyse exo-type ?monitor]
- (|do [=monitor (analyse-1+ analyse ?monitor)
+ (|do [=monitor (&&/analyse-1+ analyse ?monitor)
_ (ensure-object =monitor)
:let [output-type &type/Unit]
_ (&type/check exo-type output-type)]
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 4c5d8ae44..0e164f5d2 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -749,10 +749,11 @@
(defn with-writer [writer body]
(fn [state]
- (let [output (body (update$ $host #(set$ $writer (V $Some writer) %) state))]
+ (let [old-writer (->> state (get$ $host) (get$ $writer))
+ output (body (update$ $host #(set$ $writer (V $Some writer) %) state))]
(|case output
($Right ?state ?value)
- (return* (update$ $host #(set$ $writer (->> state (get$ $host) (get$ $writer)) %) ?state)
+ (return* (update$ $host #(set$ $writer old-writer %) ?state)
?value)
_
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index d6bbb17ae..048b9ee1d 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -405,23 +405,6 @@
)
))
-(defn ^:private compile-statement [syntax]
- (|case syntax
- (&a/$def ?name ?body)
- (&&lux/compile-def compile-expression ?name ?body)
-
- (&a/$declare-macro ?module ?name)
- (&&lux/compile-declare-macro compile-expression ?module ?name)
-
- (&a/$jvm-program ?body)
- (&&host/compile-jvm-program compile-expression ?body)
-
- (&a/$jvm-interface ?name ?supers ?methods)
- (&&host/compile-jvm-interface compile-expression ?name ?supers ?methods)
-
- (&a/$jvm-class ?name ?super-class ?interfaces ?fields ?methods)
- (&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?fields ?methods)))
-
(defn ^:private compile-token [syntax]
(|case syntax
(&a/$def ?name ?body)
@@ -436,8 +419,8 @@
(&a/$jvm-interface ?name ?supers ?methods)
(&&host/compile-jvm-interface compile-expression ?name ?supers ?methods)
- (&a/$jvm-class ?name ?super-class ?interfaces ?fields ?methods)
- (&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?fields ?methods)
+ (&a/$jvm-class ?name ?super-class ?interfaces ?fields ?methods ??env)
+ (&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?fields ?methods ??env)
_
(compile-expression syntax)))
@@ -483,7 +466,8 @@
(|do [module-exists? (&a-module/exists? name)]
(if module-exists?
(fail "[Compiler Error] Can't redefine a module!")
- (|do [_ (&a-module/enter-module name)
+ (|do [_ (&&cache/delete name)
+ _ (&a-module/enter-module name)
_ (&/flag-active-module name)
:let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_6 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 83c769b4b..2ca613633 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -76,7 +76,7 @@
(&/$DataT "char" (&/$Nil))
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class char-class) "valueOf" (str "(C)" (&host/->type-signature char-class)))
- (&/$DataT _ (&/$Nil))
+ (&/$DataT _ _)
nil
(&/$NamedT ?name ?type)
@@ -290,16 +290,18 @@
(do-template [<prim-type> <new-name> <load-name> <load-op> <store-name> <store-op> <wrapper> <unwrapper>]
(do (defn <new-name> [compile *type* ?length]
(|do [^MethodVisitor *writer* &/get-writer
- :let [_ (doto *writer*
- (.visitLdcInsn (int ?length))
- (.visitIntInsn Opcodes/NEWARRAY <prim-type>))]]
+ _ (compile ?length)
+ :let [_ (.visitInsn *writer* Opcodes/L2I)]
+ :let [_ (.visitIntInsn *writer* Opcodes/NEWARRAY <prim-type>)]]
(return nil)))
(defn <load-name> [compile *type* ?array ?idx]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?array)
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")]
+ _ (compile ?idx)
+ :let [_ (.visitInsn *writer* Opcodes/L2I)]
:let [_ (doto *writer*
- (.visitLdcInsn (int ?idx))
(.visitInsn <load-op>)
<wrapper>)]]
(return nil)))
@@ -307,9 +309,10 @@
(defn <store-name> [compile *type* ?array ?idx ?elem]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?array)
- :let [_ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int ?idx)))]
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")]
+ :let [_ (.visitInsn *writer* Opcodes/DUP)]
+ _ (compile ?idx)
+ :let [_ (.visitInsn *writer* Opcodes/L2I)]
_ (compile ?elem)
:let [_ (doto *writer*
<unwrapper>
@@ -329,25 +332,27 @@
(defn compile-jvm-anewarray [compile *type* ?class ?length]
(|do [^MethodVisitor *writer* &/get-writer
- :let [_ (doto *writer*
- (.visitLdcInsn (int ?length))
- (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class ?class)))]]
+ _ (compile ?length)
+ :let [_ (.visitInsn *writer* Opcodes/L2I)]
+ :let [_ (.visitTypeInsn *writer* Opcodes/ANEWARRAY (&host/->class ?class))]]
(return nil)))
(defn compile-jvm-aaload [compile *type* ?class ?array ?idx]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?array)
- :let [_ (doto *writer*
- (.visitLdcInsn (int ?idx))
- (.visitInsn Opcodes/AALOAD))]]
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")]
+ _ (compile ?idx)
+ :let [_ (.visitInsn *writer* Opcodes/L2I)]
+ :let [_ (.visitInsn *writer* Opcodes/AALOAD)]]
(return nil)))
(defn compile-jvm-aastore [compile *type* ?class ?array ?idx ?elem]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?array)
- :let [_ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int ?idx)))]
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")]
+ :let [_ (.visitInsn *writer* Opcodes/DUP)]
+ _ (compile ?idx)
+ :let [_ (.visitInsn *writer* Opcodes/L2I)]
_ (compile ?elem)
:let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
(return nil)))
@@ -355,6 +360,7 @@
(defn compile-jvm-arraylength [compile *type* ?array]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?array)
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")]
:let [_ (doto *writer*
(.visitInsn Opcodes/ARRAYLENGTH)
(.visitInsn Opcodes/I2L)
@@ -417,33 +423,75 @@
(&&/wrap-boolean))]]
(return nil)))
-(defn compile-jvm-class [compile ?name ?super-class ?interfaces ?fields ?methods]
- (|do [module &/get-module-name]
- (let [super-class* (&host/->class ?super-class)
- =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
- (str module "/" ?name) nil super-class* (->> ?interfaces (&/|map &host/->class) &/->seq (into-array String))))
- _ (&/|map (fn [field]
- (doto (.visitField =class (modifiers->int (:modifiers field)) (:name field)
- (&host/->type-signature (:type field)) nil nil)
- (.visitEnd)))
- ?fields)]
- (|do [_ (&/map% (fn [method]
- (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")"
- (&host/->type-signature (:output method)))]
- (&/with-writer (.visitMethod =class (modifiers->int (:modifiers method))
- (:name method)
- signature nil nil)
- (|do [^MethodVisitor =method &/get-writer
- :let [_ (.visitCode =method)]
- _ (compile (:body method))
- :let [_ (doto =method
- (.visitInsn (if (= "void" (:output method)) Opcodes/RETURN Opcodes/ARETURN))
- (.visitMaxs 0 0)
- (.visitEnd))]]
- (return nil)))))
- ?methods)]
- (&&/save-class! ?name (.toByteArray (doto =class .visitEnd)))))))
+(defn ^:private compile-method [compile class-writer method]
+ ;; (prn 'compile-method/_0 (dissoc method :inputs :output :body))
+ ;; (prn 'compile-method/_1 (&/adt->text (:inputs method)))
+ ;; (prn 'compile-method/_2 (&/adt->text (:output method)))
+ ;; (prn 'compile-method/_3 (&/adt->text (:body method)))
+ (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")"
+ (&host/->type-signature (:output method)))]
+ (&/with-writer (.visitMethod class-writer (modifiers->int (:modifiers method))
+ (:name method)
+ signature nil nil)
+ (|do [^MethodVisitor =method &/get-writer
+ :let [_ (.visitCode =method)]
+ _ (compile (:body method))
+ :let [_ (doto =method
+ (.visitInsn (if (= "void" (:output method)) Opcodes/RETURN Opcodes/ARETURN))
+ (.visitMaxs 0 0)
+ (.visitEnd))]]
+ (return nil)))))
+
+(defn ^:private compile-method-decl [class-writer method]
+ (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")"
+ (&host/->type-signature (:output method)))]
+ (.visitMethod class-writer (modifiers->int (:modifiers method)) (:name method) signature nil nil)))
+
+(let [clo-field-sig (&host/->type-signature "java.lang.Object")
+ <init>-return "V"]
+ (defn ^:private anon-class-<init>-signature [env]
+ (str "(" (&/fold str "" (&/|repeat (&/|length env) clo-field-sig)) ")"
+ <init>-return))
+
+ (defn ^:private add-anon-class-<init> [class-writer class-name env]
+ (doto (.visitMethod ^ClassWriter class-writer Opcodes/ACC_PUBLIC "<init>" (anon-class-<init>-signature env) nil nil)
+ (.visitCode)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V")
+ (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitVarInsn Opcodes/ALOAD (inc ?captured-id))
+ (.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig))
+ (->> (let [captured-name (str &&/closure-prefix ?captured-id)])
+ (|case ?name+?captured
+ [?name [(&a/$captured _ ?captured-id ?source) _]])
+ (doseq [?name+?captured (&/->seq env)])))
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ )
+
+(defn compile-jvm-class [compile ?name ?super-class ?interfaces ?fields ?methods env]
+ (|do [;; :let [_ (prn 'compile-jvm-class/_0)]
+ module &/get-module-name
+ ;; :let [_ (prn 'compile-jvm-class/_1)]
+ :let [full-name (str module "/" ?name)
+ super-class* (&host/->class ?super-class)
+ =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+ (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+ full-name nil super-class* (->> ?interfaces (&/|map &host/->class) &/->seq (into-array String))))
+ _ (&/|map (fn [field]
+ (doto (.visitField =class (modifiers->int (:modifiers field)) (:name field)
+ (&host/->type-signature (:type field)) nil nil)
+ (.visitEnd)))
+ ?fields)]
+ ;; :let [_ (prn 'compile-jvm-class/_2)]
+ _ (&/map% (partial compile-method compile =class) ?methods)
+ ;; :let [_ (prn 'compile-jvm-class/_3)]
+ :let [_ (when env
+ (add-anon-class-<init> =class full-name env))]
+ ;; :let [_ (prn 'compile-jvm-class/_4)]
+ ]
+ (&&/save-class! ?name (.toByteArray (doto =class .visitEnd)))))
(defn compile-jvm-interface [compile ?name ?supers ?methods]
;; (prn 'compile-jvm-interface (->> ?supers &/->seq pr-str))
@@ -451,11 +499,7 @@
(let [=interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_INTERFACE)
(str module "/" ?name) nil "java/lang/Object" (->> ?supers (&/|map &host/->class) &/->seq (into-array String))))
- _ (do (&/|map (fn [method]
- (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")"
- (&host/->type-signature (:output method)))]
- (.visitMethod =interface (modifiers->int (:modifiers method)) (:name method) signature nil nil)))
- ?methods)
+ _ (do (&/|map (partial compile-method-decl =interface) ?methods)
(.visitEnd =interface))]
(&&/save-class! ?name (.toByteArray =interface)))))
@@ -467,14 +511,14 @@
$catch-finally (new Label)
compile-finally (|case ?finally
(&/$Some ?finally*) (|do [_ (return nil)
- _ (compile ?finally*)
- :let [_ (doto *writer*
- (.visitInsn Opcodes/POP)
- (.visitJumpInsn Opcodes/GOTO $end))]]
- (return nil))
+ _ (compile ?finally*)
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/POP)
+ (.visitJumpInsn Opcodes/GOTO $end))]]
+ (return nil))
(&/$None) (|do [_ (return nil)
- :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]]
- (return nil)))
+ :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]]
+ (return nil)))
catch-boundaries (&/|map (fn [[?ex-class ?ex-idx ?catch-body]] [?ex-class (new Label) (new Label)])
?catches)
_ (doseq [[?ex-class $handler-start $handler-end] (&/->seq catch-boundaries)
@@ -501,12 +545,12 @@
:let [_ (.visitLabel *writer* $catch-finally)]
_ (|case ?finally
(&/$Some ?finally*) (|do [_ (compile ?finally*)
- :let [_ (.visitInsn *writer* Opcodes/POP)]
- :let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
- (return nil))
+ :let [_ (.visitInsn *writer* Opcodes/POP)]
+ :let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
+ (return nil))
(&/$None) (|do [_ (return nil)
- :let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
- (return nil)))
+ :let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
+ (return nil)))
:let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]
:let [_ (.visitLabel *writer* $end)]]
(return nil)))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 9137f3874..eafd6a1ac 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -19,21 +19,45 @@
(def module-separator "/")
(def class-name-separator ".")
(def class-separator "/")
+(def array-data-tag "#Array")
+(def null-data-tag "#Null")
;; [Utils]
+(def class-name-re #"((\[+)L([\.a-zA-Z0-9]+);|([\.a-zA-Z0-9]+))")
+
+(comment
+ (let [class (class (to-array []))]
+ (str (if-let [pkg (.getPackage class)]
+ (str (.getName pkg) ".")
+ "")
+ (.getSimpleName class)))
+
+ (.getName String) "java.lang.String"
+
+ (.getName (class (to-array []))) "[Ljava.lang.Object;"
+
+ (re-find class-name-re "java.lang.String")
+ ["java.lang.String" "java.lang.String" nil nil "java.lang.String"]
+
+ (re-find class-name-re "[Ljava.lang.Object;")
+ ["[Ljava.lang.Object;" "[Ljava.lang.Object;" "[" "java.lang.Object" nil]
+ )
+
(defn ^:private class->type [^Class class]
"(-> Class Type)"
- (if-let [[_ base arr-level] (re-find #"^([^\[]+)(\[\])*$"
- (str (if-let [pkg (.getPackage class)]
- (str (.getName pkg) ".")
- "")
- (.getSimpleName class)))]
- (if (.equals "void" base)
- &type/Unit
- (&type/Data$ (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "["))
- base)
- &/Nil$)
- )))
+ (do ;; (prn 'class->type/_0 class (.getSimpleName class) (.getName class))
+ (if-let [[_ _ arr-brackets arr-base simple-base] (re-find class-name-re (.getName class))]
+ (let [base (or arr-base simple-base)]
+ ;; (prn 'class->type/_1 class base arr-brackets)
+ (let [output-type (if (.equals "void" base)
+ &type/Unit
+ (reduce (fn [inner _] (&type/Data$ array-data-tag (&/|list inner)))
+ (&type/Data$ base &/Nil$)
+ (range (count (or arr-brackets ""))))
+ )]
+ ;; (prn 'class->type/_2 class (&type/show-type output-type))
+ output-type)
+ ))))
(defn ^:private method->type [^Method method]
"(-> Method Type)"
@@ -70,11 +94,31 @@
(str "L" class* ";")))
))
+(defn unfold-array [type]
+ "(-> Type (, Int Type))"
+ (|case type
+ (&/$DataT "#Array" (&/$Cons param (&/$Nil)))
+ (|let [[count inner] (unfold-array param)]
+ (&/T (inc count) inner))
+
+ _
+ (&/T 0 type)))
+
(defn ->java-sig [^objects type]
"(-> Type Text)"
(|case type
(&/$DataT ?name params)
- (->type-signature ?name)
+ (cond (= array-data-tag ?name) (|let [[level base] (unfold-array type)
+ base-sig (|case base
+ (&/$DataT base-class _)
+ (->class base-class)
+
+ _
+ (->java-sig base))]
+ (str (->> (&/|repeat level "[") (&/fold str ""))
+ "L" base-sig ";"))
+ (= null-data-tag ?name) (->type-signature "java.lang.Object")
+ :else (->type-signature ?name))
(&/$LambdaT _ _)
(->type-signature function-class)
@@ -123,6 +167,7 @@
)
(defn lookup-constructor [class-loader target args]
+ ;; (prn 'lookup-constructor class-loader target (&type/as-obj target))
(if-let [ctor (first (for [^Constructor =method (.getDeclaredConstructors (Class/forName (&type/as-obj target) true class-loader))
:when (let [param-types (&/->list (seq (.getParameterTypes =method)))]
(and (= (&/|length args) (&/|length param-types))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 8a1e11bed..baf834ee6 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -862,7 +862,7 @@
(|do [actual* (apply-type actual $arg)]
(check* class-loader fixpoints invariant?? expected actual*))))
- [(&/$DataT e!name e!params) (&/$DataT "null" (&/$Nil))]
+ [(&/$DataT e!name e!params) (&/$DataT "#Null" (&/$Nil))]
(if (contains? primitive-types e!name)
(fail (str "[Type Error] Can't use \"null\" with primitive types."))
(return (&/T fixpoints nil)))
@@ -880,7 +880,9 @@
;; [(str "(" (->> e!params (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")
;; (str "(" (->> a!params (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")])
;; true)
- (.isAssignableFrom (Class/forName e!name true class-loader) (Class/forName a!name true class-loader)))
+ (try (.isAssignableFrom (Class/forName e!name true class-loader) (Class/forName a!name true class-loader))
+ (catch Exception e
+ (prn 'FAILED_HERE e!name a!name))))
(return (&/T fixpoints nil))
:else