aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--luxc/src/lux/analyser/base.clj3
-rw-r--r--luxc/src/lux/analyser/proc/jvm.clj280
-rw-r--r--luxc/src/lux/type.clj2
-rw-r--r--luxc/src/lux/type/host.clj6
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/macro.lux12
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux160
-rw-r--r--stdlib/source/lux/concurrency/atom.lux6
-rw-r--r--stdlib/source/lux/concurrency/process.lux11
-rw-r--r--stdlib/source/lux/data/collection/stack.lux6
-rw-r--r--stdlib/source/lux/host.jvm.lux233
-rw-r--r--stdlib/source/lux/macro/syntax.lux16
-rw-r--r--stdlib/source/lux/macro/syntax/common/reader.lux4
-rw-r--r--stdlib/source/lux/type.lux2
-rw-r--r--stdlib/source/lux/world/binary.lux6
-rw-r--r--stdlib/source/lux/world/file.lux40
-rw-r--r--stdlib/source/lux/world/net/tcp.jvm.lux24
-rw-r--r--stdlib/source/lux/world/net/udp.jvm.lux20
-rw-r--r--stdlib/test/test/lux/compiler/default/syntax.lux37
-rw-r--r--stdlib/test/test/lux/host.jvm.lux2
19 files changed, 418 insertions, 452 deletions
diff --git a/luxc/src/lux/analyser/base.clj b/luxc/src/lux/analyser/base.clj
index 7874b0bd2..b6328c788 100644
--- a/luxc/src/lux/analyser/base.clj
+++ b/luxc/src/lux/analyser/base.clj
@@ -41,8 +41,9 @@
(|let [[[type cursor] adt] analysis]
(&/T [(&/T [new-type cursor]) adt])))
-(defn clean-analysis [$var an]
+(defn clean-analysis
"(-> Type Analysis (Lux Analysis))"
+ [$var an]
(|do [=an-type (&type/clean $var (expr-type* an))]
(return (with-type =an-type an))))
diff --git a/luxc/src/lux/analyser/proc/jvm.clj b/luxc/src/lux/analyser/proc/jvm.clj
index 9bcb9f616..74cf772be 100644
--- a/luxc/src/lux/analyser/proc/jvm.clj
+++ b/luxc/src/lux/analyser/proc/jvm.clj
@@ -18,8 +18,9 @@
(:import (java.lang.reflect Type TypeVariable)))
;; [Utils]
-(defn ^:private ensure-object [type]
+(defn- ensure-object
"(-> Type (Lux (, Text (List Type))))"
+ [type]
(|case type
(&/$Primitive payload)
(return payload)
@@ -46,8 +47,9 @@
_
(&/fail-with-loc (str "[Analyser Error] Was expecting object type. Instead got: " (&type/show-type type)))))
-(defn ^:private as-object [type]
+(defn- as-object
"(-> Type Type)"
+ [type]
(|case type
(&/$Primitive class params)
(&/$Primitive (&host-type/as-obj class) params)
@@ -55,7 +57,7 @@
_
type))
-(defn ^:private as-otype [tname]
+(defn- as-otype [tname]
(case tname
"boolean" "java.lang.Boolean"
"byte" "java.lang.Byte"
@@ -69,8 +71,9 @@
tname
))
-(defn ^:private as-otype+ [type]
+(defn- as-otype+
"(-> Type Type)"
+ [type]
(|case type
(&/$Primitive name params)
(&/$Primitive (as-otype name) params)
@@ -78,7 +81,7 @@
_
type))
-(defn ^:private clean-gtype-var [idx gtype-var]
+(defn- clean-gtype-var [idx gtype-var]
(|let [(&/$Var id) gtype-var]
(|do [? (&type/bound? id)]
(if ?
@@ -86,7 +89,7 @@
(return (&/T [idx real-type])))
(return (&/T [(+ 2 idx) (&/$Parameter idx)]))))))
-(defn ^:private clean-gtype-vars [gtype-vars]
+(defn- clean-gtype-vars [gtype-vars]
(|do [[_ clean-types] (&/fold% (fn [idx+types gtype-var]
(|do [:let [[idx types] idx+types]
[idx* real-type] (clean-gtype-var idx gtype-var)]
@@ -95,8 +98,9 @@
gtype-vars)]
(return clean-types)))
-(defn ^:private make-gtype [class-name type-args]
+(defn- make-gtype
"(-> Text (List Type) Type)"
+ [class-name type-args]
(&/fold (fn [base-type type-arg]
(|case type-arg
(&/$Parameter _)
@@ -108,8 +112,9 @@
type-args))
;; [Resources]
-(defn ^:private analyse-field-access-helper [obj-type gvars gtype]
+(defn- analyse-field-access-helper
"(-> Type (List (^ java.lang.reflect.Type)) (^ java.lang.reflect.Type) (Lux Type))"
+ [obj-type gvars gtype]
(|case obj-type
(&/$Primitive class targs)
(if (= (&/|length targs) (&/|length gvars))
@@ -207,8 +212,9 @@
(return (&/$ExQ &/$Nil (&/$Parameter 1)))
))
-(defn gen-super-env [class-env supers class-decl]
+(defn gen-super-env
"(-> (List (, TypeVar Type)) (List SuperClassDecl) ClassDecl (Lux (List (, Text Type))))"
+ [class-env supers class-decl]
(|let [[class-name class-vars] class-decl]
(|case (&/|some (fn [super]
(|let [[super-name super-params] super]
@@ -227,15 +233,16 @@
vars+gtypes)
)))
-(defn ^:private make-type-env [type-params]
+(defn- make-type-env
"(-> (List TypeParam) (Lux (List [Text Type])))"
+ [type-params]
(&/map% (fn [gvar]
(|do [:let [[gvar-name _] gvar]
ex &type/existential]
(return (&/T [gvar-name ex]))))
type-params))
-(defn ^:private double-register-gclass? [gclass]
+(defn- double-register-gclass? [gclass]
(|case gclass
(&/$GenericClass name _)
(|case name
@@ -246,7 +253,7 @@
_
false))
-(defn ^:private method-input-folder [full-env]
+(defn- method-input-folder [full-env]
(fn [body* input*]
(|do [:let [[iname itype*] input*]
itype (generic-class->type full-env itype*)]
@@ -257,8 +264,9 @@
(&&env/with-local iname itype
body*)))))
-(defn ^:private analyse-method [analyse class-decl class-env all-supers method]
+(defn- analyse-method
"(-> Analyser ClassDecl (List (, TypeVar Type)) (List SuperClassDecl) MethodSyntax (Lux MethodAnalysis))"
+ [analyse class-decl class-env all-supers method]
(|let [[?cname ?cparams] class-decl
class-type (&/$Primitive ?cname (&/|map &/|second class-env))]
(|case method
@@ -319,12 +327,13 @@
(return (&/$NativeMethodAnalysis (&/T [?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output])))
)))
-(defn ^:private mandatory-methods [supers]
+(defn- mandatory-methods [supers]
(|do [class-loader &/loader]
(&/flat-map% (partial &host/abstract-methods class-loader) supers)))
-(defn ^:private check-method-completion [supers methods]
+(defn- check-method-completion
"(-> (List SuperClassDecl) (List (, MethodDecl Analysis)) (Lux Null))"
+ [supers methods]
(|do [abstract-methods (mandatory-methods supers)
:let [methods-map (&/fold (fn [mmap mentry]
(|case mentry
@@ -370,8 +379,9 @@
(|let [[am-name am-inputs] missing-method]
(&/fail-with-loc (str "[Analyser Error] Missing method: " am-name " " "(" (->> am-inputs (&/|interpose " ") (&/fold str "")) ")"))))))
-(defn ^:private analyse-field [analyse gtype-env field]
+(defn- analyse-field
"(-> Analyser GTypeEnv FieldSyntax (Lux FieldAnalysis))"
+ [analyse gtype-env field]
(|case field
(&/$ConstantFieldSyntax ?name ?anns ?gclass ?value)
(|do [=gtype (&host-type/instance-gtype &type/existential gtype-env ?gclass)
@@ -384,47 +394,47 @@
(do-template [<name> <proc> <from-class> <to-class>]
(let [output-type (&/$Primitive <to-class> &/$Nil)]
- (defn <name> [analyse exo-type _?value]
+ (defn- <name> [analyse exo-type _?value]
(|do [:let [(&/$Cons ?value (&/$Nil)) _?value]
=value (&&/analyse-1 analyse (&/$Primitive <from-class> &/$Nil) ?value)
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta output-type _cursor (&&/$proc (&/T ["jvm" <proc>]) (&/|list =value) (&/|list))))))))
- ^:private analyse-jvm-double-to-float "double-to-float" "java.lang.Double" "java.lang.Float"
- ^:private analyse-jvm-double-to-int "double-to-int" "java.lang.Double" "java.lang.Integer"
- ^:private analyse-jvm-double-to-long "double-to-long" "java.lang.Double" "java.lang.Long"
+ analyse-jvm-double-to-float "double-to-float" "java.lang.Double" "java.lang.Float"
+ analyse-jvm-double-to-int "double-to-int" "java.lang.Double" "java.lang.Integer"
+ analyse-jvm-double-to-long "double-to-long" "java.lang.Double" "java.lang.Long"
- ^:private analyse-jvm-float-to-double "float-to-double" "java.lang.Float" "java.lang.Double"
- ^:private analyse-jvm-float-to-int "float-to-int" "java.lang.Float" "java.lang.Integer"
- ^:private analyse-jvm-float-to-long "float-to-long" "java.lang.Float" "java.lang.Long"
+ analyse-jvm-float-to-double "float-to-double" "java.lang.Float" "java.lang.Double"
+ analyse-jvm-float-to-int "float-to-int" "java.lang.Float" "java.lang.Integer"
+ analyse-jvm-float-to-long "float-to-long" "java.lang.Float" "java.lang.Long"
- ^:private analyse-jvm-int-to-byte "int-to-byte" "java.lang.Integer" "java.lang.Byte"
- ^:private analyse-jvm-int-to-char "int-to-char" "java.lang.Integer" "java.lang.Character"
- ^:private analyse-jvm-int-to-double "int-to-double" "java.lang.Integer" "java.lang.Double"
- ^:private analyse-jvm-int-to-float "int-to-float" "java.lang.Integer" "java.lang.Float"
- ^:private analyse-jvm-int-to-long "int-to-long" "java.lang.Integer" "java.lang.Long"
- ^:private analyse-jvm-int-to-short "int-to-short" "java.lang.Integer" "java.lang.Short"
+ analyse-jvm-int-to-byte "int-to-byte" "java.lang.Integer" "java.lang.Byte"
+ analyse-jvm-int-to-char "int-to-char" "java.lang.Integer" "java.lang.Character"
+ analyse-jvm-int-to-double "int-to-double" "java.lang.Integer" "java.lang.Double"
+ analyse-jvm-int-to-float "int-to-float" "java.lang.Integer" "java.lang.Float"
+ analyse-jvm-int-to-long "int-to-long" "java.lang.Integer" "java.lang.Long"
+ analyse-jvm-int-to-short "int-to-short" "java.lang.Integer" "java.lang.Short"
- ^:private analyse-jvm-long-to-double "long-to-double" "java.lang.Long" "java.lang.Double"
- ^:private analyse-jvm-long-to-float "long-to-float" "java.lang.Long" "java.lang.Float"
- ^:private analyse-jvm-long-to-int "long-to-int" "java.lang.Long" "java.lang.Integer"
- ^:private analyse-jvm-long-to-short "long-to-short" "java.lang.Long" "java.lang.Short"
- ^:private analyse-jvm-long-to-byte "long-to-byte" "java.lang.Long" "java.lang.Byte"
+ analyse-jvm-long-to-double "long-to-double" "java.lang.Long" "java.lang.Double"
+ analyse-jvm-long-to-float "long-to-float" "java.lang.Long" "java.lang.Float"
+ analyse-jvm-long-to-int "long-to-int" "java.lang.Long" "java.lang.Integer"
+ analyse-jvm-long-to-short "long-to-short" "java.lang.Long" "java.lang.Short"
+ analyse-jvm-long-to-byte "long-to-byte" "java.lang.Long" "java.lang.Byte"
- ^:private analyse-jvm-char-to-byte "char-to-byte" "java.lang.Character" "java.lang.Byte"
- ^:private analyse-jvm-char-to-short "char-to-short" "java.lang.Character" "java.lang.Short"
- ^:private analyse-jvm-char-to-int "char-to-int" "java.lang.Character" "java.lang.Integer"
- ^:private analyse-jvm-char-to-long "char-to-long" "java.lang.Character" "java.lang.Long"
+ analyse-jvm-char-to-byte "char-to-byte" "java.lang.Character" "java.lang.Byte"
+ analyse-jvm-char-to-short "char-to-short" "java.lang.Character" "java.lang.Short"
+ analyse-jvm-char-to-int "char-to-int" "java.lang.Character" "java.lang.Integer"
+ analyse-jvm-char-to-long "char-to-long" "java.lang.Character" "java.lang.Long"
- ^:private analyse-jvm-short-to-long "short-to-long" "java.lang.Short" "java.lang.Long"
+ analyse-jvm-short-to-long "short-to-long" "java.lang.Short" "java.lang.Long"
- ^:private analyse-jvm-byte-to-long "byte-to-long" "java.lang.Byte" "java.lang.Long"
+ analyse-jvm-byte-to-long "byte-to-long" "java.lang.Byte" "java.lang.Long"
)
(do-template [<name> <proc> <v1-class> <v2-class> <to-class>]
(let [output-type (&/$Primitive <to-class> &/$Nil)]
- (defn <name> [analyse exo-type ?values]
+ (defn- <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons ?value1 (&/$Cons ?value2 (&/$Nil))) ?values]
=value1 (&&/analyse-1 analyse (&/$Primitive <v1-class> &/$Nil) ?value1)
=value2 (&&/analyse-1 analyse (&/$Primitive <v2-class> &/$Nil) ?value2)
@@ -432,25 +442,25 @@
_cursor &/cursor]
(return (&/|list (&&/|meta output-type _cursor (&&/$proc (&/T ["jvm" <proc>]) (&/|list =value1 =value2) (&/|list))))))))
- ^:private analyse-jvm-iand "iand" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
- ^:private analyse-jvm-ior "ior" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
- ^:private analyse-jvm-ixor "ixor" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
- ^:private analyse-jvm-ishl "ishl" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
- ^:private analyse-jvm-ishr "ishr" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
- ^:private analyse-jvm-iushr "iushr" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
-
- ^:private analyse-jvm-land "land" "java.lang.Long" "java.lang.Long" "java.lang.Long"
- ^:private analyse-jvm-lor "lor" "java.lang.Long" "java.lang.Long" "java.lang.Long"
- ^:private analyse-jvm-lxor "lxor" "java.lang.Long" "java.lang.Long" "java.lang.Long"
- ^:private analyse-jvm-lshl "lshl" "java.lang.Long" "java.lang.Integer" "java.lang.Long"
- ^:private analyse-jvm-lshr "lshr" "java.lang.Long" "java.lang.Integer" "java.lang.Long"
- ^:private analyse-jvm-lushr "lushr" "java.lang.Long" "java.lang.Integer" "java.lang.Long"
+ analyse-jvm-iand "iand" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
+ analyse-jvm-ior "ior" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
+ analyse-jvm-ixor "ixor" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
+ analyse-jvm-ishl "ishl" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
+ analyse-jvm-ishr "ishr" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
+ analyse-jvm-iushr "iushr" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
+
+ analyse-jvm-land "land" "java.lang.Long" "java.lang.Long" "java.lang.Long"
+ analyse-jvm-lor "lor" "java.lang.Long" "java.lang.Long" "java.lang.Long"
+ analyse-jvm-lxor "lxor" "java.lang.Long" "java.lang.Long" "java.lang.Long"
+ analyse-jvm-lshl "lshl" "java.lang.Long" "java.lang.Integer" "java.lang.Long"
+ analyse-jvm-lshr "lshr" "java.lang.Long" "java.lang.Integer" "java.lang.Long"
+ analyse-jvm-lushr "lushr" "java.lang.Long" "java.lang.Integer" "java.lang.Long"
)
(do-template [<name> <proc> <input-class> <output-class>]
(let [input-type (&/$Primitive <input-class> &/$Nil)
output-type (&/$Primitive <output-class> &/$Nil)]
- (defn <name> [analyse exo-type ?values]
+ (defn- <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values]
=x (&&/analyse-1 analyse input-type x)
=y (&&/analyse-1 analyse input-type y)
@@ -459,45 +469,45 @@
(return (&/|list (&&/|meta output-type _cursor
(&&/$proc (&/T ["jvm" <proc>]) (&/|list =x =y) (&/|list))))))))
- ^:private analyse-jvm-iadd "iadd" "java.lang.Integer" "java.lang.Integer"
- ^:private analyse-jvm-isub "isub" "java.lang.Integer" "java.lang.Integer"
- ^:private analyse-jvm-imul "imul" "java.lang.Integer" "java.lang.Integer"
- ^:private analyse-jvm-idiv "idiv" "java.lang.Integer" "java.lang.Integer"
- ^:private analyse-jvm-irem "irem" "java.lang.Integer" "java.lang.Integer"
- ^:private analyse-jvm-ieq "ieq" "java.lang.Integer" "#Bit"
- ^:private analyse-jvm-ilt "ilt" "java.lang.Integer" "#Bit"
- ^:private analyse-jvm-igt "igt" "java.lang.Integer" "#Bit"
-
- ^:private analyse-jvm-ceq "ceq" "java.lang.Character" "#Bit"
- ^:private analyse-jvm-clt "clt" "java.lang.Character" "#Bit"
- ^:private analyse-jvm-cgt "cgt" "java.lang.Character" "#Bit"
-
- ^:private analyse-jvm-ladd "ladd" "java.lang.Long" "java.lang.Long"
- ^:private analyse-jvm-lsub "lsub" "java.lang.Long" "java.lang.Long"
- ^:private analyse-jvm-lmul "lmul" "java.lang.Long" "java.lang.Long"
- ^:private analyse-jvm-ldiv "ldiv" "java.lang.Long" "java.lang.Long"
- ^:private analyse-jvm-lrem "lrem" "java.lang.Long" "java.lang.Long"
- ^:private analyse-jvm-leq "leq" "java.lang.Long" "#Bit"
- ^:private analyse-jvm-llt "llt" "java.lang.Long" "#Bit"
- ^:private analyse-jvm-lgt "lgt" "java.lang.Long" "#Bit"
-
- ^:private analyse-jvm-fadd "fadd" "java.lang.Float" "java.lang.Float"
- ^:private analyse-jvm-fsub "fsub" "java.lang.Float" "java.lang.Float"
- ^:private analyse-jvm-fmul "fmul" "java.lang.Float" "java.lang.Float"
- ^:private analyse-jvm-fdiv "fdiv" "java.lang.Float" "java.lang.Float"
- ^:private analyse-jvm-frem "frem" "java.lang.Float" "java.lang.Float"
- ^:private analyse-jvm-feq "feq" "java.lang.Float" "#Bit"
- ^:private analyse-jvm-flt "flt" "java.lang.Float" "#Bit"
- ^:private analyse-jvm-fgt "fgt" "java.lang.Float" "#Bit"
-
- ^:private analyse-jvm-dadd "dadd" "java.lang.Double" "java.lang.Double"
- ^:private analyse-jvm-dsub "dsub" "java.lang.Double" "java.lang.Double"
- ^:private analyse-jvm-dmul "dmul" "java.lang.Double" "java.lang.Double"
- ^:private analyse-jvm-ddiv "ddiv" "java.lang.Double" "java.lang.Double"
- ^:private analyse-jvm-drem "drem" "java.lang.Double" "java.lang.Double"
- ^:private analyse-jvm-deq "deq" "java.lang.Double" "#Bit"
- ^:private analyse-jvm-dlt "dlt" "java.lang.Double" "#Bit"
- ^:private analyse-jvm-dgt "dgt" "java.lang.Double" "#Bit"
+ analyse-jvm-iadd "iadd" "java.lang.Integer" "java.lang.Integer"
+ analyse-jvm-isub "isub" "java.lang.Integer" "java.lang.Integer"
+ analyse-jvm-imul "imul" "java.lang.Integer" "java.lang.Integer"
+ analyse-jvm-idiv "idiv" "java.lang.Integer" "java.lang.Integer"
+ analyse-jvm-irem "irem" "java.lang.Integer" "java.lang.Integer"
+ analyse-jvm-ieq "ieq" "java.lang.Integer" "#Bit"
+ analyse-jvm-ilt "ilt" "java.lang.Integer" "#Bit"
+ analyse-jvm-igt "igt" "java.lang.Integer" "#Bit"
+
+ analyse-jvm-ceq "ceq" "java.lang.Character" "#Bit"
+ analyse-jvm-clt "clt" "java.lang.Character" "#Bit"
+ analyse-jvm-cgt "cgt" "java.lang.Character" "#Bit"
+
+ analyse-jvm-ladd "ladd" "java.lang.Long" "java.lang.Long"
+ analyse-jvm-lsub "lsub" "java.lang.Long" "java.lang.Long"
+ analyse-jvm-lmul "lmul" "java.lang.Long" "java.lang.Long"
+ analyse-jvm-ldiv "ldiv" "java.lang.Long" "java.lang.Long"
+ analyse-jvm-lrem "lrem" "java.lang.Long" "java.lang.Long"
+ analyse-jvm-leq "leq" "java.lang.Long" "#Bit"
+ analyse-jvm-llt "llt" "java.lang.Long" "#Bit"
+ analyse-jvm-lgt "lgt" "java.lang.Long" "#Bit"
+
+ analyse-jvm-fadd "fadd" "java.lang.Float" "java.lang.Float"
+ analyse-jvm-fsub "fsub" "java.lang.Float" "java.lang.Float"
+ analyse-jvm-fmul "fmul" "java.lang.Float" "java.lang.Float"
+ analyse-jvm-fdiv "fdiv" "java.lang.Float" "java.lang.Float"
+ analyse-jvm-frem "frem" "java.lang.Float" "java.lang.Float"
+ analyse-jvm-feq "feq" "java.lang.Float" "#Bit"
+ analyse-jvm-flt "flt" "java.lang.Float" "#Bit"
+ analyse-jvm-fgt "fgt" "java.lang.Float" "#Bit"
+
+ analyse-jvm-dadd "dadd" "java.lang.Double" "java.lang.Double"
+ analyse-jvm-dsub "dsub" "java.lang.Double" "java.lang.Double"
+ analyse-jvm-dmul "dmul" "java.lang.Double" "java.lang.Double"
+ analyse-jvm-ddiv "ddiv" "java.lang.Double" "java.lang.Double"
+ analyse-jvm-drem "drem" "java.lang.Double" "java.lang.Double"
+ analyse-jvm-deq "deq" "java.lang.Double" "#Bit"
+ analyse-jvm-dlt "dlt" "java.lang.Double" "#Bit"
+ analyse-jvm-dgt "dgt" "java.lang.Double" "#Bit"
)
(let [length-type &type/Nat
@@ -505,7 +515,7 @@
(do-template [<elem-class> <array-class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>]
(let [elem-type (&/$Primitive <elem-class> &/$Nil)
array-type (&/$Primitive <array-class> &/$Nil)]
- (defn <new-name> [analyse exo-type ?values]
+ (defn- <new-name> [analyse exo-type ?values]
(|do [:let [(&/$Cons length (&/$Nil)) ?values]
=length (&&/analyse-1 analyse length-type length)
_ (&type/check exo-type array-type)
@@ -513,7 +523,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" <new-tag>]) (&/|list =length) (&/|list)))))))
- (defn <load-name> [analyse exo-type ?values]
+ (defn- <load-name> [analyse exo-type ?values]
(|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values]
=array (&&/analyse-1 analyse array-type array)
=idx (&&/analyse-1 analyse idx-type idx)
@@ -522,7 +532,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" <load-tag>]) (&/|list =array =idx) (&/|list)))))))
- (defn <store-name> [analyse exo-type ?values]
+ (defn- <store-name> [analyse exo-type ?values]
(|do [:let [(&/$Cons array (&/$Cons idx (&/$Cons elem (&/$Nil)))) ?values]
=array (&&/analyse-1 analyse array-type array)
=idx (&&/analyse-1 analyse idx-type idx)
@@ -533,17 +543,17 @@
(&&/$proc (&/T ["jvm" <store-tag>]) (&/|list =array =idx =elem) (&/|list)))))))
)
- "java.lang.Boolean" "[Z" ^:private analyse-jvm-znewarray "znewarray" analyse-jvm-zaload "zaload" analyse-jvm-zastore "zastore"
- "java.lang.Byte" "[B" ^:private analyse-jvm-bnewarray "bnewarray" analyse-jvm-baload "baload" analyse-jvm-bastore "bastore"
- "java.lang.Short" "[S" ^:private analyse-jvm-snewarray "snewarray" analyse-jvm-saload "saload" analyse-jvm-sastore "sastore"
- "java.lang.Integer" "[I" ^:private analyse-jvm-inewarray "inewarray" analyse-jvm-iaload "iaload" analyse-jvm-iastore "iastore"
- "java.lang.Long" "[J" ^:private analyse-jvm-lnewarray "lnewarray" analyse-jvm-laload "laload" analyse-jvm-lastore "lastore"
- "java.lang.Float" "[F" ^:private analyse-jvm-fnewarray "fnewarray" analyse-jvm-faload "faload" analyse-jvm-fastore "fastore"
- "java.lang.Double" "[D" ^:private analyse-jvm-dnewarray "dnewarray" analyse-jvm-daload "daload" analyse-jvm-dastore "dastore"
- "java.lang.Character" "[C" ^:private analyse-jvm-cnewarray "cnewarray" analyse-jvm-caload "caload" analyse-jvm-castore "castore"
+ "java.lang.Boolean" "[Z" analyse-jvm-znewarray "znewarray" analyse-jvm-zaload "zaload" analyse-jvm-zastore "zastore"
+ "java.lang.Byte" "[B" analyse-jvm-bnewarray "bnewarray" analyse-jvm-baload "baload" analyse-jvm-bastore "bastore"
+ "java.lang.Short" "[S" analyse-jvm-snewarray "snewarray" analyse-jvm-saload "saload" analyse-jvm-sastore "sastore"
+ "java.lang.Integer" "[I" analyse-jvm-inewarray "inewarray" analyse-jvm-iaload "iaload" analyse-jvm-iastore "iastore"
+ "java.lang.Long" "[J" analyse-jvm-lnewarray "lnewarray" analyse-jvm-laload "laload" analyse-jvm-lastore "lastore"
+ "java.lang.Float" "[F" analyse-jvm-fnewarray "fnewarray" analyse-jvm-faload "faload" analyse-jvm-fastore "fastore"
+ "java.lang.Double" "[D" analyse-jvm-dnewarray "dnewarray" analyse-jvm-daload "daload" analyse-jvm-dastore "dastore"
+ "java.lang.Character" "[C" analyse-jvm-cnewarray "cnewarray" analyse-jvm-caload "caload" analyse-jvm-castore "castore"
))
-(defn ^:private array-class? [class-name]
+(defn- array-class? [class-name]
(or (= &host-type/array-data-tag class-name)
(case class-name
("[Z" "[B" "[S" "[I" "[J" "[F" "[D" "[C") true
@@ -552,7 +562,7 @@
(let [length-type &type/Nat
idx-type &type/Nat]
- (defn ^:private analyse-jvm-anewarray [analyse exo-type ?values]
+ (defn- analyse-jvm-anewarray [analyse exo-type ?values]
(|do [:let [(&/$Cons [_ (&/$Text _gclass)] (&/$Cons length (&/$Nil))) ?values]
gclass (&reader/with-source "jvm-anewarray" _gclass
&&a-parser/parse-gclass)
@@ -565,7 +575,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "anewarray"]) (&/|list =length) (&/|list gclass gtype-env)))))))
- (defn ^:private analyse-jvm-aaload [analyse exo-type ?values]
+ (defn- analyse-jvm-aaload [analyse exo-type ?values]
(|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values]
=array (&&/analyse-1+ analyse array)
[arr-class arr-params] (ensure-object (&&/expr-type* =array))
@@ -577,7 +587,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "aaload"]) (&/|list =array =idx) (&/|list)))))))
- (defn ^:private analyse-jvm-aastore [analyse exo-type ?values]
+ (defn- analyse-jvm-aastore [analyse exo-type ?values]
(|do [:let [(&/$Cons array (&/$Cons idx (&/$Cons elem (&/$Nil)))) ?values]
=array (&&/analyse-1+ analyse array)
:let [array-type (&&/expr-type* =array)]
@@ -591,7 +601,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "aastore"]) (&/|list =array =idx =elem) (&/|list))))))))
-(defn ^:private analyse-jvm-arraylength [analyse exo-type ?values]
+(defn- analyse-jvm-arraylength [analyse exo-type ?values]
(|do [:let [(&/$Cons array (&/$Nil)) ?values]
=array (&&/analyse-1+ analyse array)
[arr-class arr-params] (ensure-object (&&/expr-type* =array))
@@ -602,7 +612,7 @@
(&&/$proc (&/T ["jvm" "arraylength"]) (&/|list =array) (&/|list))
)))))
-(defn ^:private analyse-jvm-object-null? [analyse exo-type ?values]
+(defn- analyse-jvm-object-null? [analyse exo-type ?values]
(|do [:let [(&/$Cons object (&/$Nil)) ?values]
=object (&&/analyse-1+ analyse object)
_ (ensure-object (&&/expr-type* =object))
@@ -612,7 +622,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "object null?"]) (&/|list =object) (&/|list)))))))
-(defn ^:private analyse-jvm-object-null [analyse exo-type ?values]
+(defn- analyse-jvm-object-null [analyse exo-type ?values]
(|do [:let [(&/$Nil) ?values]
:let [output-type (&/$Primitive &host-type/null-data-tag &/$Nil)]
_ (&type/check exo-type output-type)
@@ -629,7 +639,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "object synchronized"]) (&/|list =monitor =expr) (&/|list)))))))
-(defn ^:private analyse-jvm-throw [analyse exo-type ?values]
+(defn- analyse-jvm-throw [analyse exo-type ?values]
(|do [:let [(&/$Cons ?ex (&/$Nil)) ?values]
=ex (&&/analyse-1+ analyse ?ex)
_ (&type/check (&/$Primitive "java.lang.Throwable" &/$Nil) (&&/expr-type* =ex))
@@ -639,7 +649,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "throw"]) (&/|list =ex) (&/|list)))))))
-(defn ^:private analyse-jvm-getstatic [analyse exo-type class field ?values]
+(defn- analyse-jvm-getstatic [analyse exo-type class field ?values]
(|do [!class! (&/de-alias-class class)
:let [(&/$Nil) ?values]
class-loader &/loader
@@ -651,7 +661,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "getstatic"]) (&/|list) (&/|list class field output-type)))))))
-(defn ^:private analyse-jvm-getfield [analyse exo-type class field ?values]
+(defn- analyse-jvm-getfield [analyse exo-type class field ?values]
(|do [!class! (&/de-alias-class class)
:let [(&/$Cons object (&/$Nil)) ?values]
class-loader &/loader
@@ -665,7 +675,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "getfield"]) (&/|list =object) (&/|list class field output-type)))))))
-(defn ^:private analyse-jvm-putstatic [analyse exo-type class field ?values]
+(defn- analyse-jvm-putstatic [analyse exo-type class field ?values]
(|do [!class! (&/de-alias-class class)
:let [(&/$Cons value (&/$Nil)) ?values]
class-loader &/loader
@@ -679,7 +689,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "putstatic"]) (&/|list =value) (&/|list class field gclass)))))))
-(defn ^:private analyse-jvm-putfield [analyse exo-type class field ?values]
+(defn- analyse-jvm-putfield [analyse exo-type class field ?values]
(|do [!class! (&/de-alias-class class)
:let [(&/$Cons object (&/$Cons value (&/$Nil))) ?values]
class-loader &/loader
@@ -696,7 +706,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "putfield"]) (&/|list =object =value) (&/|list class field gclass =type)))))))
-(defn ^:private analyse-method-call-helper [analyse exo-type gret gtype-env gtype-vars gtype-args args]
+(defn- analyse-method-call-helper [analyse exo-type gret gtype-env gtype-vars gtype-args args]
(|case gtype-vars
(&/$Nil)
(|do [arg-types (&/map% (partial &host-type/instance-param &type/existential gtype-env) gtype-args)
@@ -717,7 +727,7 @@
(return (&/T [==gret ==args])))))
))
-(defn ^:private up-cast [class parent-gvars class-loader !class! object-type]
+(defn- up-cast [class parent-gvars class-loader !class! object-type]
(|do [[sub-class sub-params] (ensure-object object-type)
(&/$Primitive super-class* super-params*) (&host-type/->super-type &type/existential class-loader !class! (if (= sub-class class)
!class!
@@ -728,7 +738,7 @@
parent-gvars
super-params*))))
-(defn ^:private check-method! [only-interface? class method]
+(defn- check-method! [only-interface? class method]
(|do [!class!* (&/de-alias-class class)
:let [!class! (string/replace !class!* "/" ".")]
class-loader &/loader
@@ -743,7 +753,7 @@
(let [dummy-type-param (&/$Primitive "java.lang.Object" &/$Nil)]
(do-template [<name> <tag> <only-interface?>]
- (defn <name> [analyse exo-type class method classes ?values]
+ (defn- <name> [analyse exo-type class method classes ?values]
(|do [:let [(&/$Cons object args) ?values]
[!class! class-loader] (check-method! <only-interface?> class method)
[gret exceptions parent-gvars gvars gargs] (if (= "<init>" method)
@@ -756,12 +766,12 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" <tag>]) (&/$Cons =object =args) (&/|list class method classes output-type gret)))))))
- ^:private analyse-jvm-invokevirtual "invokevirtual" false
- ^:private analyse-jvm-invokespecial "invokespecial" false
- ^:private analyse-jvm-invokeinterface "invokeinterface" true
+ analyse-jvm-invokevirtual "invokevirtual" false
+ analyse-jvm-invokespecial "invokespecial" false
+ analyse-jvm-invokeinterface "invokeinterface" true
))
-(defn ^:private analyse-jvm-invokestatic [analyse exo-type class method classes ?values]
+(defn- analyse-jvm-invokestatic [analyse exo-type class method classes ?values]
(|do [!class! (&/de-alias-class class)
:let [args ?values]
class-loader &/loader
@@ -772,7 +782,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "invokestatic"]) =args (&/|list class method classes output-type gret)))))))
-(defn ^:private analyse-jvm-new-helper [analyse gtype gtype-env gtype-vars gtype-args args]
+(defn- analyse-jvm-new-helper [analyse gtype gtype-env gtype-vars gtype-args args]
(|case gtype-vars
(&/$Nil)
(|do [arg-types (&/map% (partial &host-type/instance-param &type/existential gtype-env) gtype-args)
@@ -791,7 +801,7 @@
(return (&/T [==gret ==args])))))
))
-(defn ^:private analyse-jvm-new [analyse exo-type class classes ?values]
+(defn- analyse-jvm-new [analyse exo-type class classes ?values]
(|do [!class! (&/de-alias-class class)
:let [args ?values]
class-loader &/loader
@@ -802,7 +812,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "new"]) =args (&/|list class classes)))))))
-(defn ^:private analyse-jvm-instanceof [analyse exo-type class ?values]
+(defn- analyse-jvm-instanceof [analyse exo-type class ?values]
(|do [:let [(&/$Cons object (&/$Nil)) ?values]
=object (&&/analyse-1+ analyse object)
_ (ensure-object (&&/expr-type* =object))
@@ -812,7 +822,7 @@
(return (&/|list (&&/|meta output-type _cursor
(&&/$proc (&/T ["jvm" "instanceof"]) (&/|list =object) (&/|list class)))))))
-(defn ^:private analyse-jvm-object-class [analyse exo-type ?values]
+(defn- analyse-jvm-object-class [analyse exo-type ?values]
(|do [:let [(&/$Cons [_ (&/$Text _class-name)] (&/$Nil)) ?values]
^ClassLoader class-loader &/loader
_ (try (do (.loadClass class-loader _class-name)
@@ -825,7 +835,7 @@
(return (&/|list (&&/|meta output-type _cursor
(&&/$proc (&/T ["jvm" "object class"]) (&/|list) (&/|list _class-name output-type)))))))
-(defn ^:private analyse-jvm-interface [analyse compile-interface interface-decl supers =anns =methods]
+(defn- analyse-jvm-interface [analyse compile-interface interface-decl supers =anns =methods]
(|do [module &/get-module-name
_ (compile-interface interface-decl supers =anns =methods)
:let [_ (println 'INTERFACE (str module "." (&/|first interface-decl)))]
@@ -833,7 +843,7 @@
(return (&/|list (&&/|meta &type/Any _cursor
(&&/$tuple (&/|list)))))))
-(defn ^:private analyse-jvm-class [analyse compile-class class-decl super-class interfaces =inheritance-modifier =anns ?fields methods]
+(defn- analyse-jvm-class [analyse compile-class class-decl super-class interfaces =inheritance-modifier =anns ?fields methods]
(&/with-closure
(|do [module &/get-module-name
:let [[?name ?params] class-decl
@@ -852,18 +862,18 @@
(return (&/|list (&&/|meta &type/Any _cursor
(&&/$tuple (&/|list))))))))
-(defn ^:private captured-source [env-entry]
+(defn- captured-source [env-entry]
(|case env-entry
[name [_ (&&/$captured _ _ source)]]
source))
-(defn ^:private analyse-methods [analyse class-decl all-supers methods]
+(defn- analyse-methods [analyse class-decl all-supers methods]
(|do [=methods (&/map% (partial analyse-method analyse class-decl &/$Nil all-supers) methods)
_ (check-method-completion all-supers =methods)
=captured &&env/captured-vars]
(return (&/T [=methods =captured]))))
-(defn ^:private get-names []
+(defn- get-names []
(|do [module &/get-module-name
scope &/get-scope-name]
(return (&/T [module scope]))))
@@ -878,7 +888,7 @@
(&/$Tuple &/$Nil)]))
captured-slot-class "java.lang.Object"
captured-slot-type (&/$GenericClass captured-slot-class &/$Nil)]
- (defn ^:private analyse-jvm-anon-class [analyse compile-class exo-type super-class interfaces ctor-args methods]
+ (defn- analyse-jvm-anon-class [analyse compile-class exo-type super-class interfaces ctor-args methods]
(&/with-closure
(|do [[module scope] (get-names)
:let [name (->> scope &/|reverse &/|tail &host/location)
diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj
index 6fe47dbf9..9a1e12e18 100644
--- a/luxc/src/lux/type.clj
+++ b/luxc/src/lux/type.clj
@@ -315,7 +315,7 @@
_
(|do [_ (reset-var ?id ==type)]
- (return type))))
+ (return ==type))))
(return type)))
)
diff --git a/luxc/src/lux/type/host.clj b/luxc/src/lux/type/host.clj
index e0eafdd73..3b9017d6d 100644
--- a/luxc/src/lux/type/host.clj
+++ b/luxc/src/lux/type/host.clj
@@ -277,13 +277,15 @@
:else
(assert false (prn-str super* (class super*) [sub super])))))))
-(defn ^:private raise [existential lineage class params]
+(defn- raise
"(-> (List Class) Class (List Type) (Lux (, Class (List Type))))"
+ [existential lineage class params]
(&/fold% (partial raise* existential) (&/T [class params]) lineage))
;; [Exports]
-(defn ->super-type [existential class-loader super-class sub-class sub-params]
+(defn ->super-type
"(-> Text Text (List Type) (Lux Type))"
+ [existential class-loader super-class sub-class sub-params]
(let [super-class+ (Class/forName super-class true class-loader)
sub-class+ (Class/forName sub-class true class-loader)]
(if (.isAssignableFrom super-class+ sub-class+)
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/macro.lux b/stdlib/source/lux/compiler/default/phase/analysis/macro.lux
index a674dde07..7aa9a01a4 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/macro.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/macro.lux
@@ -33,12 +33,12 @@
(do error.Monad<Error>
[apply-method (|> macro
(:coerce Object)
- (Object::getClass [])
- (Class::getMethod ["apply" _apply-args]))
- output (Method::invoke [(:coerce Object macro)
- (|> (host.array Object 2)
- (host.array-write 0 (:coerce Object inputs))
- (host.array-write 1 (:coerce Object state)))]
+ (Object::getClass)
+ (Class::getMethod "apply" _apply-args))
+ output (Method::invoke (:coerce Object macro)
+ (|> (host.array Object 2)
+ (host.array-write 0 (:coerce Object inputs))
+ (host.array-write 1 (:coerce Object state)))
apply-method)]
(:coerce (Error [Lux (List Code)])
output))))
diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux
index 5fac5b1d0..a494b0e44 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux
@@ -19,7 +19,7 @@
["." check]]
["." macro
["s" syntax]]
- ["." host]]
+ ["." host (#+ import:)]]
[//
["." common]
["/." //
@@ -34,12 +34,12 @@
{#method Type
#exceptions (List Type)})
-(host.import: #long java/lang/reflect/Type
+(import: #long java/lang/reflect/Type
(getTypeName [] String))
(do-template [<name>]
[(exception: #export (<name> {jvm-type java/lang/reflect/Type})
- (ex.report ["JVM Type" (java/lang/reflect/Type::getTypeName [] jvm-type)]))]
+ (ex.report ["JVM Type" (java/lang/reflect/Type::getTypeName jvm-type)]))]
[jvm-type-is-not-a-class]
[cannot-convert-to-a-class]
@@ -421,38 +421,38 @@
_
(////.throw ///.incorrect-arity [extension-name 2 (list.size args)]))))
-(host.import: java/lang/Object
+(import: java/lang/Object
(equals [Object] boolean))
-(host.import: java/lang/ClassLoader)
+(import: java/lang/ClassLoader)
-(host.import: java/lang/reflect/GenericArrayType
+(import: java/lang/reflect/GenericArrayType
(getGenericComponentType [] java/lang/reflect/Type))
-(host.import: java/lang/reflect/ParameterizedType
+(import: java/lang/reflect/ParameterizedType
(getRawType [] java/lang/reflect/Type)
(getActualTypeArguments [] (Array java/lang/reflect/Type)))
-(host.import: (java/lang/reflect/TypeVariable d)
+(import: (java/lang/reflect/TypeVariable d)
(getName [] String)
(getBounds [] (Array java/lang/reflect/Type)))
-(host.import: (java/lang/reflect/WildcardType d)
+(import: (java/lang/reflect/WildcardType d)
(getLowerBounds [] (Array java/lang/reflect/Type))
(getUpperBounds [] (Array java/lang/reflect/Type)))
-(host.import: java/lang/reflect/Modifier
+(import: java/lang/reflect/Modifier
(#static isStatic [int] boolean)
(#static isFinal [int] boolean)
(#static isInterface [int] boolean)
(#static isAbstract [int] boolean))
-(host.import: java/lang/reflect/Field
+(import: java/lang/reflect/Field
(getDeclaringClass [] (java/lang/Class Object))
(getModifiers [] int)
(getGenericType [] java/lang/reflect/Type))
-(host.import: java/lang/reflect/Method
+(import: java/lang/reflect/Method
(getName [] String)
(getModifiers [] int)
(getDeclaringClass [] (Class Object))
@@ -461,14 +461,14 @@
(getGenericReturnType [] java/lang/reflect/Type)
(getGenericExceptionTypes [] (Array java/lang/reflect/Type)))
-(host.import: (java/lang/reflect/Constructor c)
+(import: (java/lang/reflect/Constructor c)
(getModifiers [] int)
(getDeclaringClass [] (Class c))
(getTypeParameters [] (Array (TypeVariable (Constructor c))))
(getGenericParameterTypes [] (Array java/lang/reflect/Type))
(getGenericExceptionTypes [] (Array java/lang/reflect/Type)))
-(host.import: (java/lang/Class c)
+(import: (java/lang/Class c)
(getName [] String)
(getModifiers [] int)
(#static forName [String] #try (Class Object))
@@ -484,7 +484,7 @@
(-> Text (Operation (Class Object)))
(do ////.Monad<Operation>
[]
- (case (Class::forName [name])
+ (case (Class::forName name)
(#e.Success [class])
(wrap class)
@@ -496,7 +496,7 @@
(do ////.Monad<Operation>
[super (load-class super)
sub (load-class sub)]
- (wrap (Class::isAssignableFrom [sub] super))))
+ (wrap (Class::isAssignableFrom sub super))))
(def: object::throw
Handler
@@ -562,10 +562,10 @@
(def: (java-type-to-class jvm-type)
(-> java/lang/reflect/Type (Operation Text))
(cond (host.instance? Class jvm-type)
- (operation/wrap (Class::getName [] (:coerce Class jvm-type)))
+ (operation/wrap (Class::getName (:coerce Class jvm-type)))
(host.instance? ParameterizedType jvm-type)
- (java-type-to-class (ParameterizedType::getRawType [] (:coerce ParameterizedType jvm-type)))
+ (java-type-to-class (ParameterizedType::getRawType (:coerce ParameterizedType jvm-type)))
## else
(////.throw cannot-convert-to-a-class jvm-type)))
@@ -578,7 +578,7 @@
(def: (java-type-to-lux-type mappings java-type)
(-> Mappings java/lang/reflect/Type (Operation Type))
(cond (host.instance? TypeVariable java-type)
- (let [var-name (TypeVariable::getName [] (:coerce TypeVariable java-type))]
+ (let [var-name (TypeVariable::getName (:coerce TypeVariable java-type))]
(case (dictionary.get var-name mappings)
(#.Some var-type)
(operation/wrap var-type)
@@ -588,8 +588,8 @@
(host.instance? WildcardType java-type)
(let [java-type (:coerce WildcardType java-type)]
- (case [(array.read 0 (WildcardType::getUpperBounds [] java-type))
- (array.read 0 (WildcardType::getLowerBounds [] java-type))]
+ (case [(array.read 0 (WildcardType::getUpperBounds java-type))
+ (array.read 0 (WildcardType::getLowerBounds java-type))]
(^or [(#.Some bound) _] [_ (#.Some bound)])
(java-type-to-lux-type mappings bound)
@@ -598,8 +598,8 @@
(host.instance? Class java-type)
(let [java-type (:coerce (Class Object) java-type)
- class-name (Class::getName [] java-type)]
- (operation/wrap (case (array.size (Class::getTypeParameters [] java-type))
+ class-name (Class::getName java-type)]
+ (operation/wrap (case (array.size (Class::getTypeParameters java-type))
0
(#.Primitive class-name (list))
@@ -612,21 +612,21 @@
(host.instance? ParameterizedType java-type)
(let [java-type (:coerce ParameterizedType java-type)
- raw (ParameterizedType::getRawType [] java-type)]
+ raw (ParameterizedType::getRawType java-type)]
(if (host.instance? Class raw)
(do ////.Monad<Operation>
[paramsT (|> java-type
- (ParameterizedType::getActualTypeArguments [])
+ ParameterizedType::getActualTypeArguments
array.to-list
(monad.map @ (java-type-to-lux-type mappings)))]
- (operation/wrap (#.Primitive (Class::getName [] (:coerce (Class Object) raw))
+ (operation/wrap (#.Primitive (Class::getName (:coerce (Class Object) raw))
paramsT)))
(////.throw jvm-type-is-not-a-class raw)))
(host.instance? GenericArrayType java-type)
(do ////.Monad<Operation>
[innerT (|> (:coerce GenericArrayType java-type)
- (GenericArrayType::getGenericComponentType [])
+ GenericArrayType::getGenericComponentType
(java-type-to-lux-type mappings))]
(wrap (#.Primitive "#Array" (list innerT))))
@@ -637,8 +637,8 @@
(-> (Class Object) Type (Operation Mappings))
(case type
(#.Primitive name params)
- (let [class-name (Class::getName [] class)
- class-params (array.to-list (Class::getTypeParameters [] class))
+ (let [class-name (Class::getName class)
+ class-params (array.to-list (Class::getTypeParameters class))
num-class-params (list.size class-params)
num-type-params (list.size params)]
(cond (not (text/= class-name name))
@@ -655,7 +655,7 @@
## else
(operation/wrap (|> params
- (list.zip2 (list/map (TypeVariable::getName []) class-params))
+ (list.zip2 (list/map (|>> TypeVariable::getName) class-params))
(dictionary.from-list text.Hash<Text>)))
))
@@ -707,15 +707,15 @@
_ (////.assert cannot-cast (format "From class/primitive: " current-name text.new-line
" To class/primitive: " to-name text.new-line
" For value: " (%code valueC) text.new-line)
- (Class::isAssignableFrom [current-class] to-class))
+ (Class::isAssignableFrom current-class to-class))
candiate-parents (monad.map @
(function (_ java-type)
(do @
[class-name (java-type-to-class java-type)
class (load-class class-name)]
- (wrap [[class-name java-type] (Class::isAssignableFrom [class] to-class)])))
- (list& (Class::getGenericSuperclass [] current-class)
- (array.to-list (Class::getGenericInterfaces [] current-class))))]
+ (wrap [[class-name java-type] (Class::isAssignableFrom class to-class)])))
+ (list& (Class::getGenericSuperclass current-class)
+ (array.to-list (Class::getGenericInterfaces current-class))))]
(case (|> candiate-parents
(list.filter product.right)
(list/map product.left))
@@ -758,14 +758,14 @@
(-> Text Text (Operation [(Class Object) Field]))
(do ////.Monad<Operation>
[class (load-class class-name)]
- (case (Class::getDeclaredField [field-name] class)
+ (case (Class::getDeclaredField field-name class)
(#e.Success field)
- (let [owner (Field::getDeclaringClass [] field)]
+ (let [owner (Field::getDeclaringClass field)]
(if (is? owner class)
(wrap [class field])
(////.throw mistaken-field-owner
(format " Field: " field-name text.new-line
- " Owner Class: " (Class::getName [] owner) text.new-line
+ " Owner Class: " (Class::getName owner) text.new-line
"Target Class: " class-name text.new-line))))
(#e.Error _)
@@ -775,26 +775,26 @@
(-> Text Text (Operation [Type Bit]))
(do ////.Monad<Operation>
[[class fieldJ] (find-field class-name field-name)
- #let [modifiers (Field::getModifiers [] fieldJ)]]
- (if (Modifier::isStatic [modifiers])
- (let [fieldJT (Field::getGenericType [] fieldJ)]
+ #let [modifiers (Field::getModifiers fieldJ)]]
+ (if (Modifier::isStatic modifiers)
+ (let [fieldJT (Field::getGenericType fieldJ)]
(do @
[fieldT (java-type-to-lux-type fresh-mappings fieldJT)]
- (wrap [fieldT (Modifier::isFinal [modifiers])])))
+ (wrap [fieldT (Modifier::isFinal modifiers)])))
(////.throw not-a-static-field (format class-name "#" field-name)))))
(def: (virtual-field class-name field-name objectT)
(-> Text Text Type (Operation [Type Bit]))
(do ////.Monad<Operation>
[[class fieldJ] (find-field class-name field-name)
- #let [modifiers (Field::getModifiers [] fieldJ)]]
- (if (not (Modifier::isStatic [modifiers]))
+ #let [modifiers (Field::getModifiers fieldJ)]]
+ (if (not (Modifier::isStatic modifiers))
(do @
- [#let [fieldJT (Field::getGenericType [] fieldJ)
+ [#let [fieldJT (Field::getGenericType fieldJ)
var-names (|> class
- (Class::getTypeParameters [])
+ Class::getTypeParameters
array.to-list
- (list/map (TypeVariable::getName [])))]
+ (list/map (|>> TypeVariable::getName)))]
mappings (: (Operation Mappings)
(case objectT
(#.Primitive _class-name _class-params)
@@ -813,7 +813,7 @@
_
(////.throw non-object objectT)))
fieldT (java-type-to-lux-type mappings fieldJT)]
- (wrap [fieldT (Modifier::isFinal [modifiers])]))
+ (wrap [fieldT (Modifier::isFinal modifiers)]))
(////.throw not-a-virtual-field (format class-name "#" field-name)))))
(def: static::get
@@ -901,10 +901,10 @@
(def: (java-type-to-parameter type)
(-> java/lang/reflect/Type (Operation Text))
(cond (host.instance? Class type)
- (operation/wrap (Class::getName [] (:coerce Class type)))
+ (operation/wrap (Class::getName (:coerce Class type)))
(host.instance? ParameterizedType type)
- (java-type-to-parameter (ParameterizedType::getRawType [] (:coerce ParameterizedType type)))
+ (java-type-to-parameter (ParameterizedType::getRawType (:coerce ParameterizedType type)))
(or (host.instance? TypeVariable type)
(host.instance? WildcardType type))
@@ -912,7 +912,7 @@
(host.instance? GenericArrayType type)
(do ////.Monad<Operation>
- [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType [] (:coerce GenericArrayType type)))]
+ [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType (:coerce GenericArrayType type)))]
(wrap (format componentP "[]")))
## else
@@ -928,22 +928,22 @@
(def: (check-method class method-name method-style arg-classes method)
(-> (Class Object) Text Method-Style (List Text) Method (Operation Bit))
(do ////.Monad<Operation>
- [parameters (|> (Method::getGenericParameterTypes [] method)
+ [parameters (|> (Method::getGenericParameterTypes method)
array.to-list
(monad.map @ java-type-to-parameter))
- #let [modifiers (Method::getModifiers [] method)]]
- (wrap (and (Object::equals [class] (Method::getDeclaringClass [] method))
- (text/= method-name (Method::getName [] method))
+ #let [modifiers (Method::getModifiers method)]]
+ (wrap (and (Object::equals class (Method::getDeclaringClass method))
+ (text/= method-name (Method::getName method))
(case #Static
#Special
- (Modifier::isStatic [modifiers])
+ (Modifier::isStatic modifiers)
_
#1)
(case method-style
#Special
- (not (or (Modifier::isInterface [(Class::getModifiers [] class)])
- (Modifier::isAbstract [modifiers])))
+ (not (or (Modifier::isInterface (Class::getModifiers class))
+ (Modifier::isAbstract modifiers)))
_
#1)
@@ -957,10 +957,10 @@
(def: (check-constructor class arg-classes constructor)
(-> (Class Object) (List Text) (Constructor Object) (Operation Bit))
(do ////.Monad<Operation>
- [parameters (|> (Constructor::getGenericParameterTypes [] constructor)
+ [parameters (|> (Constructor::getGenericParameterTypes constructor)
array.to-list
(monad.map @ java-type-to-parameter))]
- (wrap (and (Object::equals [class] (Constructor::getDeclaringClass [] constructor))
+ (wrap (and (Object::equals class (Constructor::getDeclaringClass constructor))
(n/= (list.size arg-classes) (list.size parameters))
(list/fold (function (_ [expectedJC actualJC] prev)
(and prev
@@ -981,19 +981,19 @@
(def: (method-signature method-style method)
(-> Method-Style Method (Operation Method-Signature))
- (let [owner (Method::getDeclaringClass [] method)
- owner-name (Class::getName [] owner)
+ (let [owner (Method::getDeclaringClass method)
+ owner-name (Class::getName owner)
owner-tvars (case method-style
#Static
(list)
_
- (|> (Class::getTypeParameters [] owner)
+ (|> (Class::getTypeParameters owner)
array.to-list
- (list/map (TypeVariable::getName []))))
- method-tvars (|> (Method::getTypeParameters [] method)
+ (list/map (|>> TypeVariable::getName))))
+ method-tvars (|> (Method::getTypeParameters method)
array.to-list
- (list/map (TypeVariable::getName [])))
+ (list/map (|>> TypeVariable::getName)))
num-owner-tvars (list.size owner-tvars)
num-method-tvars (list.size method-tvars)
all-tvars (list/compose owner-tvars method-tvars)
@@ -1008,11 +1008,11 @@
(list.zip2 all-tvars)
(dictionary.from-list text.Hash<Text>))))]
(do ////.Monad<Operation>
- [inputsT (|> (Method::getGenericParameterTypes [] method)
+ [inputsT (|> (Method::getGenericParameterTypes method)
array.to-list
(monad.map @ (java-type-to-lux-type mappings)))
- outputT (java-type-to-lux-type mappings (Method::getGenericReturnType [] method))
- exceptionsT (|> (Method::getGenericExceptionTypes [] method)
+ outputT (java-type-to-lux-type mappings (Method::getGenericReturnType method))
+ exceptionsT (|> (Method::getGenericExceptionTypes method)
array.to-list
(monad.map @ (java-type-to-lux-type mappings)))
#let [methodT (<| (type.univ-q num-all-tvars)
@@ -1049,7 +1049,7 @@
(do ////.Monad<Operation>
[class (load-class class-name)
candidates (|> class
- (Class::getDeclaredMethods [])
+ Class::getDeclaredMethods
array.to-list
(monad.map @ (: (-> Method (Operation Evaluation))
(function (_ method)
@@ -1058,7 +1058,7 @@
(cond passes?
(:: @ map (|>> #Pass) (method-signature method-style method))
- (text/= method-name (Method::getName [] method))
+ (text/= method-name (Method::getName method))
(:: @ map (|>> #Hint) (method-signature method-style method))
## else
@@ -1075,14 +1075,14 @@
(def: (constructor-signature constructor)
(-> (Constructor Object) (Operation Method-Signature))
- (let [owner (Constructor::getDeclaringClass [] constructor)
- owner-name (Class::getName [] owner)
- owner-tvars (|> (Class::getTypeParameters [] owner)
+ (let [owner (Constructor::getDeclaringClass constructor)
+ owner-name (Class::getName owner)
+ owner-tvars (|> (Class::getTypeParameters owner)
array.to-list
- (list/map (TypeVariable::getName [])))
- constructor-tvars (|> (Constructor::getTypeParameters [] constructor)
+ (list/map (|>> TypeVariable::getName)))
+ constructor-tvars (|> (Constructor::getTypeParameters constructor)
array.to-list
- (list/map (TypeVariable::getName [])))
+ (list/map (|>> TypeVariable::getName)))
num-owner-tvars (list.size owner-tvars)
all-tvars (list/compose owner-tvars constructor-tvars)
num-all-tvars (list.size all-tvars)
@@ -1096,10 +1096,10 @@
(list.zip2 all-tvars)
(dictionary.from-list text.Hash<Text>))))]
(do ////.Monad<Operation>
- [inputsT (|> (Constructor::getGenericParameterTypes [] constructor)
+ [inputsT (|> (Constructor::getGenericParameterTypes constructor)
array.to-list
(monad.map @ (java-type-to-lux-type mappings)))
- exceptionsT (|> (Constructor::getGenericExceptionTypes [] constructor)
+ exceptionsT (|> (Constructor::getGenericExceptionTypes constructor)
array.to-list
(monad.map @ (java-type-to-lux-type mappings)))
#let [objectT (#.Primitive owner-name (list.reverse owner-tvarsT))
@@ -1115,7 +1115,7 @@
(do ////.Monad<Operation>
[class (load-class class-name)
candidates (|> class
- (Class::getConstructors [])
+ Class::getConstructors
array.to-list
(monad.map @ (function (_ constructor)
(do @
@@ -1207,7 +1207,7 @@
[#let [argsT (list/map product.left argsTC)]
class (load-class class-name)
_ (////.assert non-interface class-name
- (Modifier::isInterface [(Class::getModifiers [] class)]))
+ (Modifier::isInterface (Class::getModifiers class)))
[methodT exceptionsT] (method-candidate class-name method #Interface argsT)
[outputT argsA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC)))
outputJC (check-jvm outputT)]
diff --git a/stdlib/source/lux/concurrency/atom.lux b/stdlib/source/lux/concurrency/atom.lux
index c04930171..2df357124 100644
--- a/stdlib/source/lux/concurrency/atom.lux
+++ b/stdlib/source/lux/concurrency/atom.lux
@@ -25,18 +25,18 @@
(def: #export (atom value)
(All [a] (-> a (Atom a)))
(:abstraction (for {(~~ (static host.jvm))
- (AtomicReference::new [value])})))
+ (AtomicReference::new value)})))
(def: #export (read atom)
(All [a] (-> (Atom a) (IO a)))
(io (for {(~~ (static host.jvm))
- (AtomicReference::get [] (:representation atom))})))
+ (AtomicReference::get (:representation atom))})))
(def: #export (compare-and-swap current new atom)
{#.doc (doc "Only mutates an atom if you can present it's current value."
"That guarantees that atom was not updated since you last read from it.")}
(All [a] (-> a a (Atom a) (IO Bit)))
- (io (AtomicReference::compareAndSet [current new] (:representation atom))))
+ (io (AtomicReference::compareAndSet current new (:representation atom))))
))
(def: #export (update f atom)
diff --git a/stdlib/source/lux/concurrency/process.lux b/stdlib/source/lux/concurrency/process.lux
index 2ff56c395..8cb364380 100644
--- a/stdlib/source/lux/concurrency/process.lux
+++ b/stdlib/source/lux/concurrency/process.lux
@@ -43,14 +43,14 @@
(def: #export parallelism
Nat
(`` (for {(~~ (static host.jvm))
- (|> (Runtime::getRuntime [])
- (Runtime::availableProcessors [])
+ (|> (Runtime::getRuntime)
+ (Runtime::availableProcessors)
.nat)}
1)))
(def: runner
(`` (for {(~~ (static host.jvm))
- (ScheduledThreadPoolExecutor::new [(.int ..parallelism)])}
+ (ScheduledThreadPoolExecutor::new (.int ..parallelism))}
(: (Atom (List Process))
(atom.atom (list))))))
@@ -63,9 +63,8 @@
(Runnable [] (run) void
(io.run action)))]
(case milli-seconds
- 0 (Executor::execute [runnable]
- runner)
- _ (ScheduledThreadPoolExecutor::schedule [runnable (.int milli-seconds) TimeUnit::MILLISECONDS]
+ 0 (Executor::execute runnable runner)
+ _ (ScheduledThreadPoolExecutor::schedule runnable (.int milli-seconds) TimeUnit::MILLISECONDS
runner)))}
(atom.update (|>> (#.Cons {#creation ("lux io current-time")
#delay milli-seconds
diff --git a/stdlib/source/lux/data/collection/stack.lux b/stdlib/source/lux/data/collection/stack.lux
index eec2aae23..6a7e5a215 100644
--- a/stdlib/source/lux/data/collection/stack.lux
+++ b/stdlib/source/lux/data/collection/stack.lux
@@ -31,13 +31,13 @@
(#.Some value)))
(def: #export (pop stack)
- (All [a] (-> (Stack a) (Stack a)))
+ (All [a] (-> (Stack a) (Maybe (Stack a))))
(case stack
#.Nil
- #.Nil
+ #.None
(#.Cons _ stack')
- stack'))
+ (#.Some stack')))
(def: #export (push value stack)
(All [a] (-> a (Stack a) (Stack a)))
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index b5a2454e1..a91ef498c 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1547,50 +1547,36 @@
_
(:: Monad<Meta> wrap [(list) (list) (list) (list)])))
-(def: (member-def-return mode type-params class member)
- (-> Primitive-Mode (List Type-Paramameter) Class-Declaration Import-Member-Declaration (Meta Code))
- (case member
- (#ConstructorDecl _)
- (:: Monad<Meta> wrap (class-decl-type$ class))
-
- (#MethodDecl [_ method])
- (:: Monad<Meta> wrap (class->type mode type-params (get@ #import-method-return method)))
-
- _
- (macro.fail "Only methods have return values.")))
-
-(def: (decorate-return-maybe member [return-type return-term])
- (-> Import-Member-Declaration [Code Code] [Code Code])
+(def: (decorate-return-maybe member return-term)
+ (-> Import-Member-Declaration Code Code)
(case member
(^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
(if (get@ #import-member-maybe? commons)
- [(` (Maybe (~ return-type)))
- (` (??? (~ return-term)))]
- [return-type
- (let [g!temp (code.identifier ["" " Ω "])]
- (` (let [(~ g!temp) (~ return-term)]
- (if (not (null? (:coerce (primitive "java.lang.Object")
- (~ g!temp))))
- (~ g!temp)
- (error! "Cannot produce null references from method calls.")))))])
+ (` (??? (~ return-term)))
+ (let [g!temp (` ((~' ~') (~ (code.identifier ["" " Ω "]))))]
+ (` (let [(~ g!temp) (~ return-term)]
+ (if (not (null? (:coerce (primitive "java.lang.Object")
+ (~ g!temp))))
+ (~ g!temp)
+ (error! "Cannot produce null references from method calls."))))))
_
- [return-type return-term]))
+ return-term))
-(do-template [<name> <tag> <type-trans> <term-trans>]
- [(def: (<name> member [return-type return-term])
- (-> Import-Member-Declaration [Code Code] [Code Code])
+(do-template [<name> <tag> <term-trans>]
+ [(def: (<name> member return-term)
+ (-> Import-Member-Declaration Code Code)
(case member
(^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
(if (get@ <tag> commons)
- [<type-trans> <term-trans>]
- [return-type return-term])
+ <term-trans>
+ return-term)
_
- [return-type return-term]))]
+ return-term))]
- [decorate-return-try #import-member-try? (` ((~! error.Error) (~ return-type))) (` (..try (~ return-term)))]
- [decorate-return-io #import-member-io? (` ((~! io.IO) (~ return-type))) (` ((~! io.io) (~ return-term)))]
+ [decorate-return-try #import-member-try? (` (..try (~ return-term)))]
+ [decorate-return-io #import-member-io? (` ((~! io.io) (~ return-term)))]
)
(def: (free-type-param? [name bounds])
@@ -1603,58 +1589,24 @@
(-> Type-Paramameter Code)
(code.identifier ["" name]))
-(def: (with-mode-output mode output-type body)
- (-> Primitive-Mode GenericType Code Code)
- (case mode
- #ManualPrM
- body
-
- #AutoPrM
- (case output-type
- (#GenericClass ["byte" _])
- (` (byte-to-long (~ body)))
-
- (#GenericClass ["short" _])
- (` (short-to-long (~ body)))
-
- (#GenericClass ["int" _])
- (` (int-to-long (~ body)))
-
- (#GenericClass ["float" _])
- (` (float-to-double (~ body)))
-
- _
- body)))
-
-(def: (auto-conv-class? class)
- (-> Text Bit)
- (case class
- (^or "byte" "short" "int" "float")
- #1
-
- _
- #0))
-
-(def: (auto-conv [class var])
- (-> [Text Code] (List Code))
- (case class
- "byte" (list var (` (long-to-byte (~ var))))
- "short" (list var (` (long-to-short (~ var))))
- "int" (list var (` (long-to-int (~ var))))
- "float" (list var (` (double-to-float (~ var))))
- _ (list)))
-
-(def: (with-mode-inputs mode inputs body)
- (-> Primitive-Mode (List [Text Code]) Code Code)
- (case mode
- #ManualPrM
- body
-
- #AutoPrM
- (` (let [(~+ (|> inputs
- (list/map auto-conv)
- list/join))]
- (~ body)))))
+(do-template [<name> <byte> <short> <int> <float>]
+ [(def: (<name> mode [class expression])
+ (-> Primitive-Mode [Text Code] Code)
+ (case mode
+ #ManualPrM
+ expression
+
+ #AutoPrM
+ (case class
+ "byte" (` (<byte> (~ expression)))
+ "short" (` (<short> (~ expression)))
+ "int" (` (<int> (~ expression)))
+ "float" (` (<float> (~ expression)))
+ _ expression)))]
+
+ [auto-convert-input long-to-byte long-to-short long-to-int double-to-float]
+ [auto-convert-output byte-to-long short-to-long int-to-long float-to-double]
+ )
(def: (with-mode-field-get mode class output)
(-> Primitive-Mode GenericType Code Code)
@@ -1684,6 +1636,17 @@
"float" (` (double-to-float (~ g!input)))
_ g!input)))
+(def: (un-quote quoted)
+ (-> Code Code)
+ (` ((~' ~) (~ quoted))))
+
+(def: (jvm-extension-inputs mode classes inputs)
+ (-> Primitive-Mode (List Text) (List Code) (List Code))
+ (|> inputs
+ (list/map un-quote)
+ (list.zip2 classes)
+ (list/map (auto-convert-input mode))))
+
(def: (member-def-interop type-params kind class [arg-function-inputs arg-method-inputs arg-classes arg-types] member method-prefix)
(-> (List Type-Paramameter) Class-Kind Class-Declaration [(List Code) (List Code) (List Text) (List Code)] Import-Member-Declaration Text (Meta (List Code)))
(let [[full-name class-tvars] class
@@ -1714,63 +1677,51 @@
(#ConstructorDecl [commons _])
(do Monad<Meta>
- [return-type (member-def-return (get@ #import-member-mode commons) type-params class member)
- #let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))])
- def-params (list (code.tuple arg-function-inputs))
- jvm-interop (|> (` ((~ (code.text (format "jvm new" ":" full-name ":" (text.join-with "," arg-classes))))
- (~+ arg-method-inputs)))
- (with-mode-inputs (get@ #import-member-mode commons)
- (list.zip2 arg-classes arg-function-inputs)))
- [return-type jvm-interop] (|> [return-type jvm-interop]
- (decorate-return-maybe member)
- (decorate-return-try member)
- (decorate-return-io member))]]
- (wrap (list (` (def: ((~ def-name) (~+ def-params))
- (All [(~+ all-params)] (-> [(~+ arg-types)] (~ return-type)))
- (~ jvm-interop))))))
+ [#let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))])
+ jvm-extension (code.text (format "jvm new" ":" full-name ":" (text.join-with "," arg-classes)))
+ jvm-interop (|> (` ((~ jvm-extension)
+ (~+ (jvm-extension-inputs (get@ #import-member-mode commons) arg-classes arg-function-inputs))))
+ (decorate-return-maybe member)
+ (decorate-return-try member)
+ (decorate-return-io member))]]
+ (wrap (list (` ((~! syntax:) ((~ def-name) (~+ arg-function-inputs))
+ ((~' wrap) (.list (.` (~ jvm-interop)))))))))
(#MethodDecl [commons method])
(with-gensyms [g!obj]
(do @
- [return-type (member-def-return (get@ #import-member-mode commons) type-params class member)
- #let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))])
+ [#let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))])
(^slots [#import-member-kind]) commons
(^slots [#import-method-name]) method
- [jvm-op obj-ast class-ast] (: [Text (List Code) (List Code)]
- (case import-member-kind
- #StaticIMK
- ["invokestatic"
- (list)
- (list)]
-
- #VirtualIMK
- (case kind
- #Class
- ["invokevirtual"
- (list g!obj)
- (list (class-decl-type$ class))]
-
- #Interface
- ["invokeinterface"
- (list g!obj)
- (list (class-decl-type$ class))]
- )))
- def-params (#.Cons (code.tuple arg-function-inputs) obj-ast)
- def-param-types (#.Cons (` [(~+ arg-types)]) class-ast)
- jvm-interop (|> (` ((~ (code.text (format "jvm " jvm-op ":" full-name ":" import-method-name
- ":" (text.join-with "," arg-classes))))
- (~+ obj-ast) (~+ arg-method-inputs)))
- (with-mode-output (get@ #import-member-mode commons)
- (get@ #import-method-return method))
- (with-mode-inputs (get@ #import-member-mode commons)
- (list.zip2 arg-classes arg-function-inputs)))
- [return-type jvm-interop] (|> [return-type jvm-interop]
- (decorate-return-maybe member)
- (decorate-return-try member)
- (decorate-return-io member))]]
- (wrap (list (` (def: ((~ def-name) (~+ def-params))
- (All [(~+ all-params)] (-> (~+ def-param-types) (~ return-type)))
- (~ jvm-interop)))))))
+ [jvm-op object-ast class-ast] (: [Text (List Code) (List Code)]
+ (case import-member-kind
+ #StaticIMK
+ ["invokestatic"
+ (list)
+ (list)]
+
+ #VirtualIMK
+ (case kind
+ #Class
+ ["invokevirtual"
+ (list g!obj)
+ (list (class-decl-type$ class))]
+
+ #Interface
+ ["invokeinterface"
+ (list g!obj)
+ (list (class-decl-type$ class))]
+ )))
+ jvm-extension (code.text (format "jvm " jvm-op ":" full-name ":" import-method-name ":" (text.join-with "," arg-classes)))
+ jvm-interop (|> [(simple-class$ (list) (get@ #import-method-return method))
+ (` ((~ jvm-extension) (~+ (list/map un-quote object-ast))
+ (~+ (jvm-extension-inputs (get@ #import-member-mode commons) arg-classes arg-function-inputs))))]
+ (auto-convert-output (get@ #import-member-mode commons))
+ (decorate-return-maybe member)
+ (decorate-return-try member)
+ (decorate-return-io member))]]
+ (wrap (list (` ((~! syntax:) ((~ def-name) (~+ arg-function-inputs) (~+ object-ast))
+ ((~' wrap) (.list (.` (~ jvm-interop))))))))))
(#FieldAccessDecl fad)
(do Monad<Meta>
@@ -1874,11 +1825,11 @@
{#.doc (doc "Allows importing JVM classes, and using them as types."
"Their methods, fields and enum options can also be imported."
"Also, classes which get imported into a module can also be referred-to with their short names in other macros that require JVM classes."
- "Examples:"
(import: java/lang/Object
(new [])
(equals [Object] boolean)
(wait [int] #io #try void))
+
"Special options can also be given for the return values."
"#? means that the values will be returned inside a Maybe type. That way, null becomes #.None."
"#try means that the computation might throw an exception, and the return value will be wrapped by the Error type."
@@ -1895,23 +1846,23 @@
(import: (java/util/ArrayList a)
([T] toArray [(Array T)] (Array T)))
+
"#long makes it so the class-type that is generated is of the fully-qualified name."
"In this case, it avoids a clash between the java.util.List type, and Lux's own List type."
+ "All enum options to be imported must be specified."
(import: java/lang/Character$UnicodeScript
(#enum ARABIC CYRILLIC LATIN))
- "All enum options to be imported must be specified."
+ "It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-parameters."
+ "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)."
(import: #long (lux/concurrency/promise/JvmPromise A)
(resolve [A] boolean)
(poll [] A)
(wasResolved [] boolean)
(waitOn [lux/Function] void)
(#static [A] make [A] (JvmPromise A)))
- "It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-parameters."
- "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)."
- "Also, the names of the imported members will look like ClassName.MemberName."
- "E.g.:"
+ "Also, the names of the imported members will look like Class::member"
(Object::new [])
(Object::equals [other-object] my-object)
(java/util/List::size [] my-list)
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index 83137cef0..07b0a4b9e 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -244,7 +244,7 @@
(wrap [var parser])
[_ (#.Identifier var-name)]
- (wrap [(code.identifier var-name) (` any)])
+ (wrap [(code.identifier var-name) (` (~! any))])
_
(//.fail "Syntax pattern expects records or identifiers."))))
@@ -262,13 +262,13 @@
(#error.Error (~ g!error))
(#error.Error ((~! text.join-with) ": " (list (~ error-msg) (~ g!error))))}
- (..run (~ g!tokens)
- (: (..Syntax (Meta (List Code)))
- ((~! do) (~! p.Monad<Parser>)
- [(~+ (join-pairs vars+parsers))]
- ((~' wrap) ((~! do) (~! //.Monad<Meta>)
- []
- (~ body)))))))))))))
+ ((~! ..run) (~ g!tokens)
+ (: ((~! ..Syntax) (Meta (List Code)))
+ ((~! do) (~! p.Monad<Parser>)
+ [(~+ (join-pairs vars+parsers))]
+ ((~' wrap) ((~! do) (~! //.Monad<Meta>)
+ []
+ (~ body)))))))))))))
_
(//.fail "Wrong syntax for syntax:"))))
diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux
index 0d172fa88..af3b584b8 100644
--- a/stdlib/source/lux/macro/syntax/common/reader.lux
+++ b/stdlib/source/lux/macro/syntax/common/reader.lux
@@ -90,6 +90,7 @@
(def: (find-definition-args meta-data)
(-> (List [Name Code]) (List Text))
(<| (maybe.default (list))
+ (: (Maybe (List Text)))
(case (list.find (|>> product.left (name/= ["lux" "func-args"])) meta-data)
(^multi (#.Some [_ value])
[(p.run (list value) tuple-meta^)
@@ -99,8 +100,7 @@
(#.Some args)
_
- #.None)
- ))
+ #.None)))
(def: #export (definition compiler)
{#.doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."}
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
index ff614a328..e010c2a98 100644
--- a/stdlib/source/lux/type.lux
+++ b/stdlib/source/lux/type.lux
@@ -347,7 +347,7 @@
#let [_ (log! ($_ text/compose
":log!" " @ " (.cursor-description cursor) text.new-line
(name/encode valueN) " : " (..to-text valueT) text.new-line))]]
- (wrap (list (' []))))
+ (wrap (list (code.identifier valueN))))
(#.Right valueC)
(macro.with-gensyms [g!value]
diff --git a/stdlib/source/lux/world/binary.lux b/stdlib/source/lux/world/binary.lux
index 1821c61b9..f3ee40042 100644
--- a/stdlib/source/lux/world/binary.lux
+++ b/stdlib/source/lux/world/binary.lux
@@ -143,7 +143,7 @@
(ex.throw index-out-of-bounds <description>)
## else
- (#error.Success (Arrays::copyOfRange [binary (:coerce Int from) (:coerce Int (inc to))]))))))
+ (#error.Success (Arrays::copyOfRange binary (:coerce Int from) (:coerce Int (inc to))))))))
(def: #export (slice' from binary)
(-> Nat Binary (Error Binary))
@@ -151,10 +151,10 @@
(structure: #export _ (eq.Equivalence Binary)
(def: (= reference sample)
- (Arrays::equals [reference sample])))
+ (Arrays::equals reference sample)))
(def: #export (copy bytes source-offset source target-offset target)
(-> Nat Nat Binary Nat Binary (Error Binary))
(do error.Monad<Error>
- [_ (System::arraycopy [source (.int source-offset) target (.int target-offset) (.int bytes)])]
+ [_ (System::arraycopy source (.int source-offset) target (.int target-offset) (.int bytes))]
(wrap target)))
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 76f03a835..1f1d9eabd 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -150,10 +150,10 @@
(do-template [<name> <flag>]
[(def: (<name> data file)
(do io.Monad<Process>
- [stream (FileOutputStream::new [(java/io/File::new file) <flag>])
- _ (OutputStream::write [data] stream)
- _ (OutputStream::flush [] stream)]
- (AutoCloseable::close [] stream)))]
+ [stream (FileOutputStream::new (java/io/File::new file) <flag>)
+ _ (OutputStream::write data stream)
+ _ (OutputStream::flush stream)]
+ (AutoCloseable::close stream)))]
[append #1]
[write #0]
@@ -162,33 +162,33 @@
(def: (read file)
(do io.Monad<Process>
[#let [file' (java/io/File::new file)]
- size (java/io/File::length [] file')
+ size (java/io/File::length file')
#let [data (binary.create (.nat size))]
- stream (FileInputStream::new [file'])
- bytes-read (InputStream::read [data] stream)
- _ (AutoCloseable::close [] stream)]
+ stream (FileInputStream::new file')
+ bytes-read (InputStream::read data stream)
+ _ (AutoCloseable::close stream)]
(if (i/= size bytes-read)
(wrap data)
(io.io (ex.throw cannot-read-all-data file)))))
(def: size
- (|>> [] java/io/File::new
- (java/io/File::length [])
+ (|>> java/io/File::new
+ java/io/File::length
(:: io.Monad<Process> map .nat)))
(def: (files dir)
(do io.Monad<Process>
- [?files (java/io/File::listFiles [] (java/io/File::new dir))]
+ [?files (java/io/File::listFiles (java/io/File::new dir))]
(case ?files
(#.Some files)
- (monad.map @ (java/io/File::getAbsolutePath [])
+ (monad.map @ (|>> java/io/File::getAbsolutePath)
(array.to-list files))
#.None
(io.throw not-a-directory dir))))
(do-template [<name> <method>]
- [(def: <name> (|>> [] java/io/File::new (<method> [])))]
+ [(def: <name> (|>> java/io/File::new <method>))]
[file? java/io/File::isFile]
[directory? java/io/File::isDirectory]
@@ -197,19 +197,19 @@
(def: (can? permission file)
(let [jvm-file (java/io/File::new file)]
(case permission
- #Read (java/io/File::canRead [] jvm-file)
- #Write (java/io/File::canWrite [] jvm-file)
- #Execute (java/io/File::canExecute [] jvm-file))))
+ #Read (java/io/File::canRead jvm-file)
+ #Write (java/io/File::canWrite jvm-file)
+ #Execute (java/io/File::canExecute jvm-file))))
(def: last-modified
- (|>> [] java/io/File::new
- (java/io/File::lastModified [])
+ (|>> java/io/File::new
+ (java/io/File::lastModified)
(:: io.Monad<Process> map (|>> duration.from-millis instant.absolute))))
(do-template [<name> <exception> <method>]
[(def: (<name> subject)
(do io.Monad<IO>
- [outcome (<method> [] (java/io/File::new subject))]
+ [outcome (<method> (java/io/File::new subject))]
(case outcome
(#error.Success #1)
(wrap (#error.Success []))
@@ -224,7 +224,7 @@
(do-template [<name> <exception> <method> <parameter-pre>]
[(def: (<name> parameter subject)
(do io.Monad<IO>
- [outcome (<method> [(|> parameter <parameter-pre>)]
+ [outcome (<method> (|> parameter <parameter-pre>)
(java/io/File::new subject))]
(case outcome
(#error.Success #1)
diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux
index ee866203e..50191c407 100644
--- a/stdlib/source/lux/world/net/tcp.jvm.lux
+++ b/stdlib/source/lux/world/net/tcp.jvm.lux
@@ -50,7 +50,7 @@
(-> Binary Nat Nat TCP (Task Nat))
(promise.future
(do io.Monad<Process>
- [bytes-read (InputStream::read [data (.int offset) (.int length)]
+ [bytes-read (InputStream::read data (.int offset) (.int length)
(get@ #in (:representation self)))]
(wrap (.nat bytes-read)))))
@@ -59,24 +59,24 @@
(let [out (get@ #out (:representation self))]
(promise.future
(do io.Monad<Process>
- [_ (OutputStream::write [data (.int offset) (.int length)]
+ [_ (OutputStream::write data (.int offset) (.int length)
out)]
- (Flushable::flush [] out)))))
+ (Flushable::flush out)))))
(def: #export (close self)
(-> TCP (Task Any))
(let [(^open ".") (:representation self)]
(promise.future
(do io.Monad<Process>
- [_ (AutoCloseable::close [] in)
- _ (AutoCloseable::close [] out)]
- (AutoCloseable::close [] socket)))))
+ [_ (AutoCloseable::close in)
+ _ (AutoCloseable::close out)]
+ (AutoCloseable::close socket)))))
(def: (tcp-client socket)
(-> Socket (Process TCP))
(do io.Monad<Process>
- [input (Socket::getInputStream [] socket)
- output (Socket::getOutputStream [] socket)]
+ [input (Socket::getInputStream socket)
+ output (Socket::getOutputStream socket)]
(wrap (:abstraction {#socket socket
#in input
#out output}))))
@@ -86,7 +86,7 @@
(-> //.Address //.Port (Task TCP))
(promise.future
(do io.Monad<Process>
- [socket (Socket::new [address (.int port)])]
+ [socket (Socket::new address (.int port))]
(tcp-client socket))))
(def: #export (server port)
@@ -94,11 +94,11 @@
(frp.Channel TCP)]))
(promise.future
(do (e.ErrorT io.Monad<IO>)
- [server (ServerSocket::new [(.int port)])
+ [server (ServerSocket::new (.int port))
#let [signal (: (Promise Any)
(promise #.None))
_ (promise.await (function (_ _)
- (AutoCloseable::close [] server))
+ (AutoCloseable::close server))
signal)
output (: (frp.Channel TCP)
(frp.channel []))
@@ -107,7 +107,7 @@
(loop [_ []]
(do io.Monad<IO>
[?client (do (e.ErrorT io.Monad<IO>)
- [socket (ServerSocket::accept [] server)]
+ [socket (ServerSocket::accept server)]
(tcp-client socket))]
(case ?client
(#e.Error error)
diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux
index e8eeb1b1b..8b785eb98 100644
--- a/stdlib/source/lux/world/net/udp.jvm.lux
+++ b/stdlib/source/lux/world/net/udp.jvm.lux
@@ -55,7 +55,7 @@
(def: (resolve address)
(-> //.Address (io.IO (e.Error InetAddress)))
(do (e.ErrorT io.Monad<IO>)
- [addresses (InetAddress::getAllByName [address])]
+ [addresses (InetAddress::getAllByName address)]
(: (io.IO (e.Error InetAddress))
(case (array.size addresses)
0 (io.io (ex.throw cannot-resolve-address address))
@@ -68,14 +68,14 @@
(def: #export (read data offset length self)
(-> Binary Nat Nat UDP (T.Task [Nat //.Address //.Port]))
(let [(^open ".") (:representation self)
- packet (DatagramPacket::new|receive [data (.int offset) (.int length)])]
+ packet (DatagramPacket::new|receive data (.int offset) (.int length))]
(P.future
(do (e.ErrorT io.Monad<IO>)
- [_ (DatagramSocket::receive [packet] socket)
- #let [bytes-read (.nat (DatagramPacket::getLength [] packet))]]
+ [_ (DatagramSocket::receive packet socket)
+ #let [bytes-read (.nat (DatagramPacket::getLength packet))]]
(wrap [bytes-read
- (|> packet (DatagramPacket::getAddress []) (InetAddress::getHostAddress []))
- (.nat (DatagramPacket::getPort [] packet))])))))
+ (|> packet DatagramPacket::getAddress InetAddress::getHostAddress)
+ (.nat (DatagramPacket::getPort packet))])))))
(def: #export (write address port data offset length self)
(-> //.Address //.Port Binary Nat Nat UDP (T.Task Any))
@@ -83,26 +83,26 @@
(do (e.ErrorT io.Monad<IO>)
[address (resolve address)
#let [(^open ".") (:representation self)]]
- (DatagramSocket::send (DatagramPacket::new|send [data (.int offset) (.int length) address (.int port)])
+ (DatagramSocket::send (DatagramPacket::new|send data (.int offset) (.int length) address (.int port))
socket))))
(def: #export (close self)
(-> UDP (T.Task Any))
(let [(^open ".") (:representation self)]
(P.future
- (AutoCloseable::close [] socket))))
+ (AutoCloseable::close socket))))
(def: #export (client _)
(-> Any (T.Task UDP))
(P.future
(do (e.ErrorT io.Monad<IO>)
- [socket (DatagramSocket::new|client [])]
+ [socket (DatagramSocket::new|client)]
(wrap (:abstraction (#socket socket))))))
(def: #export (server port)
(-> //.Port (T.Task UDP))
(P.future
(do (e.ErrorT io.Monad<IO>)
- [socket (DatagramSocket::new|server [(.int port)])]
+ [socket (DatagramSocket::new|server (.int port))]
(wrap (:abstraction (#socket socket))))))
)
diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux
index 887765cbd..165a224e5 100644
--- a/stdlib/test/test/lux/compiler/default/syntax.lux
+++ b/stdlib/test/test/lux/compiler/default/syntax.lux
@@ -87,29 +87,31 @@
other code^]
($_ seq
(test "Can parse Lux code."
- (case (&.parse "" (dict.new text.Hash<Text>)
- [default-cursor 0 (code.to-text sample)])
+ (case (let [source-code (%code sample)]
+ (&.parse "" (dict.new text.Hash<Text>) (text.size source-code)
+ [default-cursor 0 source-code]))
(#e.Error error)
#0
(#e.Success [_ parsed])
(:: code.Equivalence<Code> = parsed sample)))
(test "Can parse Lux multiple code nodes."
- (case (&.parse "" (dict.new text.Hash<Text>)
- [default-cursor 0 (format (code.to-text sample) " "
- (code.to-text other))])
- (#e.Error error)
- #0
-
- (#e.Success [remaining =sample])
- (case (&.parse "" (dict.new text.Hash<Text>)
- remaining)
+ (let [source-code (format (%code sample) " " (%code other))
+ source-code//size (text.size source-code)]
+ (case (&.parse "" (dict.new text.Hash<Text>) source-code//size
+ [default-cursor 0 source-code])
(#e.Error error)
#0
- (#e.Success [_ =other])
- (and (:: code.Equivalence<Code> = sample =sample)
- (:: code.Equivalence<Code> = other =other)))))
+ (#e.Success [remaining =sample])
+ (case (&.parse "" (dict.new text.Hash<Text>) source-code//size
+ remaining)
+ (#e.Error error)
+ #0
+
+ (#e.Success [_ =other])
+ (and (:: code.Equivalence<Code> = sample =sample)
+ (:: code.Equivalence<Code> = other =other))))))
))))
(def: comment-text^
@@ -133,9 +135,10 @@
comment comment^]
($_ seq
(test "Can handle comments."
- (case (&.parse "" (dict.new text.Hash<Text>)
- [default-cursor 0
- (format comment (code.to-text sample))])
+ (case (let [source-code (format comment (%code sample))
+ source-code//size (text.size source-code)]
+ (&.parse "" (dict.new text.Hash<Text>) source-code//size
+ [default-cursor 0 source-code]))
(#e.Error error)
#0
diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux
index 835bdd719..2444de871 100644
--- a/stdlib/test/test/lux/host.jvm.lux
+++ b/stdlib/test/test/lux/host.jvm.lux
@@ -92,7 +92,7 @@
(&.synchronized "" #1))
(test "Can access Class instances."
- (text/= "java.lang.Class" (Class::getName [] (&.class-for java/lang/Class))))
+ (text/= "java.lang.Class" (Class::getName (&.class-for java/lang/Class))))
(test "Can check if a value is null."
(and (&.null? (&.null))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 16:27:40 +0000