diff options
Diffstat (limited to '')
-rw-r--r-- | luxc/src/lux/analyser/base.clj | 3 | ||||
-rw-r--r-- | luxc/src/lux/analyser/proc/jvm.clj | 280 | ||||
-rw-r--r-- | luxc/src/lux/type.clj | 2 | ||||
-rw-r--r-- | luxc/src/lux/type/host.clj | 6 | ||||
-rw-r--r-- | stdlib/source/lux/compiler/default/phase/analysis/macro.lux | 12 | ||||
-rw-r--r-- | stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux | 160 | ||||
-rw-r--r-- | stdlib/source/lux/concurrency/atom.lux | 6 | ||||
-rw-r--r-- | stdlib/source/lux/concurrency/process.lux | 11 | ||||
-rw-r--r-- | stdlib/source/lux/data/collection/stack.lux | 6 | ||||
-rw-r--r-- | stdlib/source/lux/host.jvm.lux | 233 | ||||
-rw-r--r-- | stdlib/source/lux/macro/syntax.lux | 16 | ||||
-rw-r--r-- | stdlib/source/lux/macro/syntax/common/reader.lux | 4 | ||||
-rw-r--r-- | stdlib/source/lux/type.lux | 2 | ||||
-rw-r--r-- | stdlib/source/lux/world/binary.lux | 6 | ||||
-rw-r--r-- | stdlib/source/lux/world/file.lux | 40 | ||||
-rw-r--r-- | stdlib/source/lux/world/net/tcp.jvm.lux | 24 | ||||
-rw-r--r-- | stdlib/source/lux/world/net/udp.jvm.lux | 20 | ||||
-rw-r--r-- | stdlib/test/test/lux/compiler/default/syntax.lux | 37 | ||||
-rw-r--r-- | stdlib/test/test/lux/host.jvm.lux | 2 |
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)) |