aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/ffi.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/library/lux/ffi.jvm.lux')
-rw-r--r--stdlib/source/library/lux/ffi.jvm.lux350
1 files changed, 175 insertions, 175 deletions
diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux
index 6b0c04c63..5b5e96a9c 100644
--- a/stdlib/source/library/lux/ffi.jvm.lux
+++ b/stdlib/source/library/lux/ffi.jvm.lux
@@ -1,6 +1,6 @@
(.using
[library
- [lux {"-" Primitive Type type int char as}
+ [lux {"-" Primitive Type type int char is as}
["[0]" meta]
[abstract
["[0]" monad {"+" do}]]
@@ -115,9 +115,9 @@
(-> (Type Value) Text Code Code)
(let [unboxed (..reflection unboxed)]
(` (|> (~ raw)
- (is (.Primitive (~ (code.text <pre>))))
+ (.is (.Primitive (~ (code.text <pre>))))
"jvm object cast"
- (is (.Primitive (~ (code.text <post>))))))))]
+ (.is (.Primitive (~ (code.text <post>))))))))]
[unbox boxed unboxed]
[box unboxed boxed]
@@ -126,11 +126,11 @@
(template [<name> <op> <from> <to>]
[(template: .public (<name> value)
[(|> value
- (is <from>)
+ (.is <from>)
"jvm object cast"
<op>
"jvm object cast"
- (is <to>))])]
+ (.is <to>))])]
[byte_to_long "jvm conversion byte-to-long" ..Byte ..Long]
@@ -424,8 +424,8 @@
(-> Text Text Text (Parser Code))
(do <>.monad
[.let [dotted_name (format "::" field_name)]
- [_ _ value] (is (Parser [Any Any Code])
- (<code>.form ($_ <>.and (<code>.this (' :=)) (<code>.this (code.symbol ["" dotted_name])) <code>.any)))]
+ [_ _ value] (.is (Parser [Any Any Code])
+ (<code>.form ($_ <>.and (<code>.this (' :=)) (<code>.this (code.symbol ["" dotted_name])) <code>.any)))]
(in (`' ("jvm member put virtual"
(~ (code.text class_name))
(~ (code.text field_name))
@@ -472,9 +472,9 @@
(def: (constructor_parser class_name arguments)
(-> Text (List Argument) (Parser Code))
(do <>.monad
- [args (is (Parser (List Code))
- (<code>.form (<>.after (<code>.this (' ::new!))
- (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))]
+ [args (.is (Parser (List Code))
+ (<code>.form (<>.after (<code>.this (' ::new!))
+ (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))]
(in (` ("jvm member invoke constructor" (~ (code.text class_name))
(~+ (|> args
(list.zipped/2 (list#each product.right arguments))
@@ -484,9 +484,9 @@
(-> Text Text (List Argument) (Parser Code))
(do <>.monad
[.let [dotted_name (format "::" method_name "!")]
- args (is (Parser (List Code))
- (<code>.form (<>.after (<code>.this (code.symbol ["" dotted_name]))
- (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))]
+ args (.is (Parser (List Code))
+ (<code>.form (<>.after (<code>.this (code.symbol ["" dotted_name]))
+ (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))]
(in (` ("jvm member invoke static" (~ (code.text class_name)) (~ (code.text method_name))
(~+ (|> args
(list.zipped/2 (list#each product.right arguments))
@@ -497,9 +497,9 @@
(-> (List (Type Var)) Text (List (Type Var)) Text (List Argument) Text (Parser Code))
(do <>.monad
[.let [dotted_name (format "::" method_name "!")]
- args (is (Parser (List Code))
- (<code>.form (<>.after (<code>.this (code.symbol ["" dotted_name]))
- (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))]
+ args (.is (Parser (List Code))
+ (<code>.form (<>.after (<code>.this (code.symbol ["" dotted_name]))
+ (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))]
(in (` (<jvm_op> [(~+ (list#each (|>> ..signature code.text) class_vars))]
(~ (code.text class_name)) (~ (code.text method_name))
[(~+ (list#each (|>> ..signature code.text) type_vars))]
@@ -582,10 +582,10 @@
(-> (List (Type Var)) (Parser (Type Class))))
(do <>.monad
[.let [class_name^ (..valid_class_name type_vars)]
- [name parameters] (is (Parser [External (List (Type Parameter))])
- ($_ <>.either
- (<>.and class_name^ (<>#in (list)))
- (<code>.form (<>.and class_name^ (<>.some (parameter^ type_vars))))))]
+ [name parameters] (.is (Parser [External (List (Type Parameter))])
+ ($_ <>.either
+ (<>.and class_name^ (<>#in (list)))
+ (<code>.form (<>.and class_name^ (<>.some (parameter^ type_vars))))))]
(in (jvm.class (name.safe name) parameters))))
(exception: .public (unknown_type_variable [name Text
@@ -691,12 +691,12 @@
(def: declaration^
(Parser (Type Declaration))
(do <>.monad
- [[name variables] (is (Parser [External (List (Type Var))])
- (<>.either (<>.and (..valid_class_name (list))
- (<>#in (list)))
- (<code>.form (<>.and (..valid_class_name (list))
- (<>.some var^)))
- ))]
+ [[name variables] (.is (Parser [External (List (Type Var))])
+ (<>.either (<>.and (..valid_class_name (list))
+ (<>#in (list)))
+ (<code>.form (<>.and (..valid_class_name (list))
+ (<>.some var^)))
+ ))]
(in (jvm.declaration name variables))))
(def: (class^ type_vars)
@@ -964,9 +964,9 @@
[]]})
))
(<code>.form (do <>.monad
- [kind (is (Parser ImportMethodKind)
- (<>.or (<code>.this (' "static"))
- (in [])))
+ [kind (.is (Parser ImportMethodKind)
+ (<>.or (<code>.this (' "static"))
+ (in [])))
tvars (<>.else (list) ..vars^)
name <code>.local
?alias import_member_alias^
@@ -1209,10 +1209,10 @@
methods (<>.some (..method_def^ class_vars))])
(do meta.monad
[.let [fully_qualified_class_name full_class_name
- method_parser (is (Parser Code)
- (|> methods
- (list#each (method->parser class_vars fully_qualified_class_name))
- (list#mix <>.either (<>.failure ""))))]]
+ method_parser (.is (Parser Code)
+ (|> methods
+ (list#each (method->parser class_vars fully_qualified_class_name))
+ (list#mix <>.either (<>.failure ""))))]]
(in (list (` ("jvm class"
(~ (declaration$ (jvm.declaration full_class_name class_vars)))
(~ (class$ super))
@@ -1271,8 +1271,8 @@
{.#None}
("jvm object null")))))))
-(syntax: .public (check [class (..type^ (list))
- unchecked (<>.maybe <code>.any)])
+(syntax: .public (as [class (..type^ (list))
+ unchecked (<>.maybe <code>.any)])
(with_symbols [g!_ g!unchecked]
(let [class_name (..reflection class)
class_type (` (.Primitive (~ (code.text class_name))))
@@ -1283,14 +1283,14 @@
{.#None}))]
(case unchecked
{.#Some unchecked}
- (in (list (` (is (~ check_type)
- (let [(~ g!unchecked) (~ unchecked)]
- (~ check_code))))))
+ (in (list (` (.is (~ check_type)
+ (let [(~ g!unchecked) (~ unchecked)]
+ (~ check_code))))))
{.#None}
- (in (list (` (is (-> (.Primitive "java.lang.Object") (~ check_type))
- (function ((~ g!_) (~ g!unchecked))
- (~ check_code))))))
+ (in (list (` (.is (-> (.Primitive "java.lang.Object") (~ check_type))
+ (function ((~ g!_) (~ g!unchecked))
+ (~ check_code))))))
))))
(syntax: .public (synchronized [lock <code>.any
@@ -1340,18 +1340,18 @@
(let [(open "[0]") commons]
(do [! meta.monad]
[arg_inputs (monad.each !
- (is (-> [Bit (Type Value)] (Meta [Bit Code]))
- (function (_ [maybe? _])
- (with_symbols [arg_name]
- (in [maybe? arg_name]))))
+ (.is (-> [Bit (Type Value)] (Meta [Bit Code]))
+ (function (_ [maybe? _])
+ (with_symbols [arg_name]
+ (in [maybe? arg_name]))))
#import_member_args)
.let [input_jvm_types (list#each product.right #import_member_args)
- arg_types (list#each (is (-> [Bit (Type Value)] Code)
- (function (_ [maybe? arg])
- (let [arg_type (value_type (the #import_member_mode commons) arg)]
- (if maybe?
- (` (Maybe (~ arg_type)))
- arg_type))))
+ arg_types (list#each (.is (-> [Bit (Type Value)] Code)
+ (function (_ [maybe? arg])
+ (let [arg_type (value_type (the #import_member_mode commons) arg)]
+ (if maybe?
+ (` (Maybe (~ arg_type)))
+ arg_type))))
#import_member_args)]]
(in [arg_inputs input_jvm_types arg_types])))
@@ -1399,28 +1399,28 @@
(template [<input?> <name> <unbox/box> <special+>]
[(def: (<name> mode [unboxed raw])
(-> Primitive_Mode [(Type Value) Code] Code)
- (let [[unboxed refined post] (is [(Type Value) Code (List Code)]
- (case mode
- {#ManualPrM}
- [unboxed raw (list)]
-
- {#AutoPrM}
- (with_expansions [<special+>' (template.spliced <special+>)
- <cond_cases> (template [<primitive> <pre> <post>]
- [(# jvm.equivalence = <primitive> unboxed)
- (with_expansions [<post>' (template.spliced <post>)]
- [<primitive>
- (` (.|> (~ raw) (~+ <pre>)))
- (list <post>')])]
-
- <special+>')]
- (cond <cond_cases>
- ... else
- [unboxed
- (if <input?>
- (` ("jvm object cast" (~ raw)))
- raw)
- (list)]))))
+ (let [[unboxed refined post] (.is [(Type Value) Code (List Code)]
+ (case mode
+ {#ManualPrM}
+ [unboxed raw (list)]
+
+ {#AutoPrM}
+ (with_expansions [<special+>' (template.spliced <special+>)
+ <cond_cases> (template [<primitive> <pre> <post>]
+ [(# jvm.equivalence = <primitive> unboxed)
+ (with_expansions [<post>' (template.spliced <post>)]
+ [<primitive>
+ (` (.|> (~ raw) (~+ <pre>)))
+ (list <post>')])]
+
+ <special+>')]
+ (cond <cond_cases>
+ ... else
+ [unboxed
+ (if <input?>
+ (` ("jvm object cast" (~ raw)))
+ raw)
+ (list)]))))
unboxed/boxed (case (dictionary.value unboxed ..boxes)
{.#Some boxed}
(<unbox/box> unboxed boxed refined)
@@ -1464,8 +1464,8 @@
(list.zipped/2 classes)
(list#each (function (_ [class [maybe? input]])
(|> (if maybe?
- (` (is (.Primitive (~ (code.text (..reflection class))))
- ((~! !!!) (~ (..un_quoted input)))))
+ (` (.is (.Primitive (~ (code.text (..reflection class))))
+ ((~! !!!) (~ (..un_quoted input)))))
(..un_quoted input))
[class]
(with_automatic_input_conversion mode))))))
@@ -1489,21 +1489,21 @@
{#EnumDecl enum_members}
(with_symbols [g!_]
(do meta.monad
- [.let [enum_type (is Code
- (case class_tvars
- {.#End}
- (` (.Primitive (~ (code.text full_name))))
-
- _
- (let [=class_tvars (list#each ..var$' class_tvars)]
- (` (All ((~ g!_) (~+ =class_tvars))
- (.Primitive (~ (code.text full_name)) [(~+ =class_tvars)]))))))
- getter_interop (is (-> Text Code)
- (function (_ name)
- (let [getter_name (code.symbol ["" (..import_name import_format method_prefix name)])]
- (` (def: (~ getter_name)
- (~ enum_type)
- (~ (get_static_field full_name name)))))))]]
+ [.let [enum_type (.is Code
+ (case class_tvars
+ {.#End}
+ (` (.Primitive (~ (code.text full_name))))
+
+ _
+ (let [=class_tvars (list#each ..var$' class_tvars)]
+ (` (All ((~ g!_) (~+ =class_tvars))
+ (.Primitive (~ (code.text full_name)) [(~+ =class_tvars)]))))))
+ getter_interop (.is (-> Text Code)
+ (function (_ name)
+ (let [getter_name (code.symbol ["" (..import_name import_format method_prefix name)])]
+ (` (def: (~ getter_name)
+ (~ enum_type)
+ (~ (get_static_field full_name name)))))))]]
(in (list#each getter_interop enum_members))))
{#ConstructorDecl [commons _]}
@@ -1531,51 +1531,51 @@
[.let [def_name (code.symbol ["" (..import_name import_format method_prefix (the #import_member_alias commons))])
(open "[0]") commons
(open "[0]") method
- [jvm_op object_ast] (is [Text (List Code)]
- (case #import_member_kind
- {#StaticIMK}
- ["jvm member invoke static"
- (list)]
-
- {#VirtualIMK}
- (case kind
- {#Class}
- ["jvm member invoke virtual"
- (list g!obj)]
-
- {#Interface}
- ["jvm member invoke interface"
- (list g!obj)]
- )))
+ [jvm_op object_ast] (.is [Text (List Code)]
+ (case #import_member_kind
+ {#StaticIMK}
+ ["jvm member invoke static"
+ (list)]
+
+ {#VirtualIMK}
+ (case kind
+ {#Class}
+ ["jvm member invoke virtual"
+ (list g!obj)]
+
+ {#Interface}
+ ["jvm member invoke interface"
+ (list g!obj)]
+ )))
method_return (the #import_method_return method)
- callC (is Code
- (` ((~ (code.text jvm_op))
- [(~+ (list#each ..var$ class_tvars))]
- (~ (code.text full_name))
- (~ (code.text #import_method_name))
- [(~+ (list#each ..var$ (the #import_member_tvars commons)))]
- (~+ (|> object_ast
- (list#each ..un_quoted)
- (list.zipped/2 (list (jvm.class full_name (list))))
- (list#each (with_automatic_input_conversion (the #import_member_mode commons)))))
- (~+ (|> (jvm_invoke_inputs (the #import_member_mode commons) input_jvm_types arg_function_inputs)
- (list.zipped/2 input_jvm_types)
- (list#each ..decorate_input))))))
- jvm_interop (is Code
- (case (jvm.void? method_return)
- {.#Left method_return}
- (|> [method_return
- callC]
- (with_automatic_output_conversion (the #import_member_mode commons))
- (with_return_maybe member false method_return)
- (with_return_try member)
- (with_return_io member))
-
-
- {.#Right method_return}
- (|> callC
- (with_return_try member)
- (with_return_io member))))]]
+ callC (.is Code
+ (` ((~ (code.text jvm_op))
+ [(~+ (list#each ..var$ class_tvars))]
+ (~ (code.text full_name))
+ (~ (code.text #import_method_name))
+ [(~+ (list#each ..var$ (the #import_member_tvars commons)))]
+ (~+ (|> object_ast
+ (list#each ..un_quoted)
+ (list.zipped/2 (list (jvm.class full_name (list))))
+ (list#each (with_automatic_input_conversion (the #import_member_mode commons)))))
+ (~+ (|> (jvm_invoke_inputs (the #import_member_mode commons) input_jvm_types arg_function_inputs)
+ (list.zipped/2 input_jvm_types)
+ (list#each ..decorate_input))))))
+ jvm_interop (.is Code
+ (case (jvm.void? method_return)
+ {.#Left method_return}
+ (|> [method_return
+ callC]
+ (with_automatic_output_conversion (the #import_member_mode commons))
+ (with_return_maybe member false method_return)
+ (with_return_try member)
+ (with_return_io member))
+
+
+ {.#Right method_return}
+ (|> callC
+ (with_return_try member)
+ (with_return_io member))))]]
(in (list (` ((~! syntax:) ((~ def_name) [(~+ (syntax_inputs (list#each product.right arg_function_inputs)))
(~+ (syntax_inputs object_ast))])
((~' in) (.list (.` (~ jvm_interop))))))))))
@@ -1602,27 +1602,27 @@
getter_body)]
(in (` ((~! syntax:) (~ getter_call)
((~' in) (.list (.` (~ getter_body)))))))))
- setter_interop (is (Meta (List Code))
- (if _#import_field_setter?
- (with_symbols [g!obj g!value]
- (let [setter_call (if _#import_field_static?
- (` ((~ setter_name) [(~ g!value) (~! <code>.any)]))
- (` ((~ setter_name) [(~ g!value) (~! <code>.any)
- (~ g!obj) (~! <code>.any)])))
- setter_value (|> [_#import_field_type (..un_quoted g!value)]
- (with_automatic_input_conversion _#import_field_mode))
- setter_value (if _#import_field_maybe?
- (` ((~! !!!) (~ setter_value)))
- setter_value)
- setter_command (format (if _#import_field_static? "jvm putstatic" "jvm putfield")
- ":" full_name ":" _#import_field_name)
- g!obj+ (is (List Code)
- (if _#import_field_static?
- (list)
- (list (..un_quoted g!obj))))]
- (in (list (` ((~! syntax:) (~ setter_call)
- ((~' in) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value))))))))))))
- (in (list))))]
+ setter_interop (.is (Meta (List Code))
+ (if _#import_field_setter?
+ (with_symbols [g!obj g!value]
+ (let [setter_call (if _#import_field_static?
+ (` ((~ setter_name) [(~ g!value) (~! <code>.any)]))
+ (` ((~ setter_name) [(~ g!value) (~! <code>.any)
+ (~ g!obj) (~! <code>.any)])))
+ setter_value (|> [_#import_field_type (..un_quoted g!value)]
+ (with_automatic_input_conversion _#import_field_mode))
+ setter_value (if _#import_field_maybe?
+ (` ((~! !!!) (~ setter_value)))
+ setter_value)
+ setter_command (format (if _#import_field_static? "jvm putstatic" "jvm putfield")
+ ":" full_name ":" _#import_field_name)
+ g!obj+ (.is (List Code)
+ (if _#import_field_static?
+ (list)
+ (list (..un_quoted g!obj))))]
+ (in (list (` ((~! syntax:) (~ setter_call)
+ ((~' in) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value))))))))))))
+ (in (list))))]
(in (list& getter_interop setter_interop)))
)))
@@ -1638,7 +1638,7 @@
(All (_ a) (-> (.Primitive "java.lang.Class" [a]) Bit))
(|>> ("jvm member invoke virtual" [] "java.lang.Class" "isInterface" [])
"jvm object cast"
- (is ..Boolean)
+ (.is ..Boolean)
(.as Bit)))
(def: load_class
@@ -1691,8 +1691,8 @@
[jvm.double "jvm array new double"]
[jvm.char "jvm array new char"]))
... else
- (in (list (` (is (~ (value_type {#ManualPrM} (jvm.array type)))
- ("jvm array new object" (~ g!size))))))))))
+ (in (list (` (.is (~ (value_type {#ManualPrM} (jvm.array type)))
+ ("jvm array new object" (~ g!size))))))))))
(exception: .public (cannot_convert_to_jvm_type [type .Type])
(exception.report
@@ -1762,18 +1762,18 @@
... else
(# meta.monad each (jvm.class name)
- (is (Meta (List (Type Parameter)))
- (monad.each meta.monad
- (function (_ paramLT)
- (do meta.monad
- [paramJT (lux_type->jvm_type context paramLT)]
- (case (parser.parameter? paramJT)
- {.#Some paramJT}
- (in paramJT)
-
- {.#None}
- <failure>)))
- params)))))
+ (.is (Meta (List (Type Parameter)))
+ (monad.each meta.monad
+ (function (_ paramLT)
+ (do meta.monad
+ [paramJT (lux_type->jvm_type context paramLT)]
+ (case (parser.parameter? paramJT)
+ {.#Some paramJT}
+ (in paramJT)
+
+ {.#None}
+ <failure>)))
+ params)))))
{.#Apply A F}
(case (type.applied (list A) F)
@@ -1921,7 +1921,7 @@
"Signature" (..signature type)
"Reflection" (..reflection type)))
-(syntax: .public (as [type (..type^ (list))
+(syntax: .public (is [type (..type^ (list))
object <code>.any])
(case [(parser.array? type)
(parser.class? type)]
@@ -1934,10 +1934,10 @@
(template [<forward> <from> <to> <backward>]
[(template: .public (<forward> it)
- [(|> it (is <from>) (as <to>))])
+ [(|> it (.is <from>) (.as <to>))])
(template: .public (<backward> it)
- [(|> it (is <to>) (as <from>))])]
+ [(|> it (.is <to>) (.as <from>))])]
[as_boolean .Bit ..Boolean of_boolean]
[as_long .Int ..Long of_long]
@@ -1947,10 +1947,10 @@
(template [<forward> <from> <$> <mid> <$'> <to> <backward>]
[(template: .public (<forward> it)
- [(|> it (is <from>) (as <mid>) <$> (is <to>))])
+ [(|> it (.is <from>) (.as <mid>) <$> (.is <to>))])
(template: .public (<backward> it)
- [(|> it (is <to>) <$'> (is <mid>) (as <from>))])]
+ [(|> it (.is <to>) <$'> (.is <mid>) (.as <from>))])]
[as_byte .Int ..long_to_byte ..Long ..byte_to_long ..Byte of_byte]
[as_short .Int ..long_to_short ..Long ..short_to_long ..Short of_short]
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-04 23:35:21 +0000