aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/library/lux/debug.lux6
-rw-r--r--stdlib/source/library/lux/ffi.jvm.lux350
-rw-r--r--stdlib/source/library/lux/ffi.old.lux220
-rw-r--r--stdlib/source/library/lux/target/jvm/reflection.lux22
-rw-r--r--stdlib/source/test/lux/ffi.jvm.lux16
-rw-r--r--stdlib/source/test/lux/ffi.old.lux10
6 files changed, 312 insertions, 312 deletions
diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux
index ddc343061..14399ccad 100644
--- a/stdlib/source/library/lux/debug.lux
+++ b/stdlib/source/library/lux/debug.lux
@@ -147,7 +147,7 @@
Inspector
(with_expansions [<jvm> (let [object (as java/lang/Object value)]
(`` (<| (~~ (template [<class> <processing>]
- [(case (ffi.check <class> object)
+ [(case (ffi.as <class> object)
{.#Some value}
(`` (|> value (~~ (template.spliced <processing>))))
@@ -158,12 +158,12 @@
[java/lang/Number [java/lang/Number::doubleValue ffi.of_double %.frac]]
[java/lang/String [ffi.of_string %.text]]
))
- (case (ffi.check [java/lang/Object] object)
+ (case (ffi.as [java/lang/Object] object)
{.#Some value}
(let [value (as (array.Array java/lang/Object) value)]
(case (array.read! 0 value)
(^.multi {.#Some tag}
- [(ffi.check java/lang/Integer tag)
+ [(ffi.as java/lang/Integer tag)
{.#Some tag}]
[[(array.read! 1 value) (array.read! 2 value)]
[last? {.#Some choice}]])
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]
diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux
index f6822f72a..0479558f9 100644
--- a/stdlib/source/library/lux/ffi.old.lux
+++ b/stdlib/source/library/lux/ffi.old.lux
@@ -1,6 +1,6 @@
(.using
[library
- [lux {"-" as type}
+ [lux {"-" is as type}
["[0]" type ("[1]#[0]" equivalence)]
[abstract
["[0]" monad {"+" Monad do}]
@@ -65,10 +65,10 @@
(template [<forward> <from> <to> <backward>]
[(template: .public (<forward> it)
- [(|> it (is <from>) (.as (Primitive <to>)))])
+ [(|> it (.is <from>) (.as (Primitive <to>)))])
(template: .public (<backward> it)
- [(|> it (is (Primitive <to>)) (.as <from>))])]
+ [(|> it (.is (Primitive <to>)) (.as <from>))])]
[as_boolean .Bit "java.lang.Boolean" of_boolean]
[as_long .Int "java.lang.Long" of_long]
@@ -78,10 +78,10 @@
(template [<forward> <from> <$> <mid> <$'> <to> <backward>]
[(template: .public (<forward> it)
- [(|> it (is <from>) (.as (Primitive <mid>)) <$> (is (Primitive <to>)))])
+ [(|> it (.is <from>) (.as (Primitive <mid>)) <$> (.is (Primitive <to>)))])
(template: .public (<backward> it)
- [(|> it (is (Primitive <to>)) <$'> (is (Primitive <mid>)) (.as <from>))])]
+ [(|> it (.is (Primitive <to>)) <$'> (.is (Primitive <mid>)) (.as <from>))])]
[as_byte .Int ..long_to_byte "java.lang.Long" ..byte_to_long "java.lang.Byte" of_byte]
[as_short .Int ..long_to_short "java.lang.Long" ..short_to_long "java.lang.Short" of_short]
@@ -380,14 +380,14 @@
(def: (class_decl_type$ (open "[0]"))
(-> Class_Declaration Code)
- (let [=params (list#each (is (-> Type_Parameter Code)
- (function (_ [pname pbounds])
- (case pbounds
- {.#End}
- (code.symbol ["" pname])
-
- {.#Item bound1 _}
- (class_type {#ManualPrM} #class_params bound1))))
+ (let [=params (list#each (.is (-> Type_Parameter Code)
+ (function (_ [pname pbounds])
+ (case pbounds
+ {.#End}
+ (code.symbol ["" pname])
+
+ {.#Item bound1 _}
+ (class_type {#ManualPrM} #class_params bound1))))
#class_params)]
(` (Primitive (~ (code.text (safe #class_name)))
[(~+ =params)]))))
@@ -457,8 +457,8 @@
(-> 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 (`' ((~ (code.text (format "jvm putfield" ":" class_name ":" field_name))) _jvm_this (~ value))))))
(def: (pre_walk_replace f input)
@@ -497,10 +497,10 @@
(def: (constructor_parser params class_name arg_decls)
(-> (List Type_Parameter) Text (List ArgDecl) (Parser Code))
(do <>.monad
- [args (is (Parser (List Code))
- (<code>.form (<>.after (<code>.this (' ::new!))
- (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any)))))
- .let [arg_decls' (is (List Text) (list#each (|>> product.right (simple_class$ params)) arg_decls))]]
+ [args (.is (Parser (List Code))
+ (<code>.form (<>.after (<code>.this (' ::new!))
+ (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any)))))
+ .let [arg_decls' (.is (List Text) (list#each (|>> product.right (simple_class$ params)) arg_decls))]]
(in (` ((~ (code.text (format "jvm new" ":" class_name ":" (text.interposed "," arg_decls'))))
(~+ args))))))
@@ -508,10 +508,10 @@
(-> (List Type_Parameter) Text Text (List ArgDecl) (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 arg_decls) <code>.any)))))
- .let [arg_decls' (is (List Text) (list#each (|>> product.right (simple_class$ params)) arg_decls))]]
+ args (.is (Parser (List Code))
+ (<code>.form (<>.after (<code>.this (code.symbol ["" dotted_name]))
+ (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any)))))
+ .let [arg_decls' (.is (List Text) (list#each (|>> product.right (simple_class$ params)) arg_decls))]]
(in (`' ((~ (code.text (format "jvm invokestatic" ":" class_name ":" method_name ":" (text.interposed "," arg_decls'))))
(~+ args))))))
@@ -520,10 +520,10 @@
(-> (List Type_Parameter) Text Text (List ArgDecl) (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 arg_decls) <code>.any)))))
- .let [arg_decls' (is (List Text) (list#each (|>> product.right (simple_class$ params)) arg_decls))]]
+ args (.is (Parser (List Code))
+ (<code>.form (<>.after (<code>.this (code.symbol ["" dotted_name]))
+ (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any)))))
+ .let [arg_decls' (.is (List Text) (list#each (|>> product.right (simple_class$ params)) arg_decls))]]
(in (`' ((~ (code.text (format <jvm_op> ":" class_name ":" method_name ":" (text.interposed "," arg_decls'))))
(~' _jvm_this) (~+ args))))))]
@@ -933,9 +933,9 @@
#import_member_io? io?]
[]]})))
(<code>.form (do <>.monad
- [kind (is (Parser ImportMethodKind)
- (<>.or (<code>.this (' "static"))
- (in [])))
+ [kind (.is (Parser ImportMethodKind)
+ (<>.or (<code>.this (' "static"))
+ (in [])))
tvars ..type_params^
name <code>.local
?alias import_member_alias^
@@ -1128,8 +1128,8 @@
(let [super_replacer (parser_replacer (<code>.form (do <>.monad
[_ (<code>.this (' ::super!))
args (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any))
- .let [arg_decls' (is (List Text) (list#each (|>> product.right (simple_class$ (list)))
- arg_decls))]]
+ .let [arg_decls' (.is (List Text) (list#each (|>> product.right (simple_class$ (list)))
+ arg_decls))]]
(in (`' ((~ (code.text (format "jvm invokespecial"
":" (the #super_class_name super_class)
":" name
@@ -1277,8 +1277,8 @@
{.#None}
("jvm object null")))))))
-(syntax: .public (check [class (..generic_type^ (list))
- unchecked (<>.maybe <code>.any)])
+(syntax: .public (as [class (..generic_type^ (list))
+ unchecked (<>.maybe <code>.any)])
(with_symbols [g!_ g!unchecked]
(let [class_name (simple_class$ (list) class)
class_type (` (.Primitive (~ (code.text class_name))))
@@ -1289,14 +1289,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
@@ -1344,20 +1344,20 @@
(let [(open "[0]") commons]
(do [! meta.monad]
[arg_inputs (monad.each !
- (is (-> [Bit GenericType] (Meta [Bit Code]))
- (function (_ [maybe? _])
- (with_symbols [arg_name]
- (in [maybe? arg_name]))))
+ (.is (-> [Bit GenericType] (Meta [Bit Code]))
+ (function (_ [maybe? _])
+ (with_symbols [arg_name]
+ (in [maybe? arg_name]))))
#import_member_args)
- .let [arg_classes (is (List Text)
- (list#each (|>> product.right (simple_class$ (list#composite type_params #import_member_tvars)))
- #import_member_args))
- arg_types (list#each (is (-> [Bit GenericType] Code)
- (function (_ [maybe? arg])
- (let [arg_type (class_type (the #import_member_mode commons) type_params arg)]
- (if maybe?
- (` (Maybe (~ arg_type)))
- arg_type))))
+ .let [arg_classes (.is (List Text)
+ (list#each (|>> product.right (simple_class$ (list#composite type_params #import_member_tvars)))
+ #import_member_args))
+ arg_types (list#each (.is (-> [Bit GenericType] Code)
+ (function (_ [maybe? arg])
+ (let [arg_type (class_type (the #import_member_mode commons) type_params arg)]
+ (if maybe?
+ (` (Maybe (~ arg_type)))
+ arg_type))))
#import_member_args)]]
(in [arg_inputs arg_classes arg_types])))
@@ -1459,22 +1459,22 @@
{#EnumDecl enum_members}
(macro.with_symbols [g!_]
(do [! meta.monad]
- [.let [enum_type (is Code
- (case class_tvars
- {.#End}
- (` (Primitive (~ (code.text full_name))))
-
- _
- (let [=class_tvars (|> class_tvars
- (list.only free_type_param?)
- (list#each lux_type_parameter))]
- (` (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)
- ((~ (code.text (format "jvm getstatic" ":" full_name ":" name)))))))))]]
+ [.let [enum_type (.is Code
+ (case class_tvars
+ {.#End}
+ (` (Primitive (~ (code.text full_name))))
+
+ _
+ (let [=class_tvars (|> class_tvars
+ (list.only free_type_param?)
+ (list#each lux_type_parameter))]
+ (` (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)
+ ((~ (code.text (format "jvm getstatic" ":" full_name ":" name)))))))))]]
(in (list#each getter_interop enum_members))))
{#ConstructorDecl [commons _]}
@@ -1495,22 +1495,22 @@
[.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}
- ["invokestatic"
- (list)]
-
- {#VirtualIMK}
- (case kind
- {#Class}
- ["invokevirtual"
- (list g!obj)]
-
- {#Interface}
- ["invokeinterface"
- (list g!obj)]
- )))
+ [jvm_op object_ast] (.is [Text (List Code)]
+ (case #import_member_kind
+ {#StaticIMK}
+ ["invokestatic"
+ (list)]
+
+ {#VirtualIMK}
+ (case kind
+ {#Class}
+ ["invokevirtual"
+ (list g!obj)]
+
+ {#Interface}
+ ["invokeinterface"
+ (list g!obj)]
+ )))
jvm_extension (code.text (format "jvm " jvm_op ":" full_name ":" #import_method_name ":" (text.interposed "," arg_classes)))
jvm_interop (|> [(simple_class$ (list) (the #import_method_return method))
(` ((~ jvm_extension) (~+ (list#each un_quote object_ast))
@@ -1531,10 +1531,10 @@
typeC (if #import_field_maybe?
(` (Maybe (~ base_gtype)))
base_gtype)
- tvar_asts (is (List Code)
- (|> class_tvars
- (list.only free_type_param?)
- (list#each lux_type_parameter)))
+ tvar_asts (.is (List Code)
+ (|> class_tvars
+ (list.only free_type_param?)
+ (list#each lux_type_parameter)))
getter_name (code.symbol ["" (..import_name import_format method_prefix #import_field_name)])
setter_name (code.symbol ["" (..import_name import_format method_prefix (format #import_field_name "!"))])]
getter_interop (with_symbols [g!obj]
@@ -1556,27 +1556,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 (auto_convert_input #import_field_mode
- [(simple_class$ (list) #import_field_type) (un_quote g!value)])
- 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_quote 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 (auto_convert_input #import_field_mode
+ [(simple_class$ (list) #import_field_type) (un_quote g!value)])
+ 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_quote 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)))
)))
diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux
index 94ca109a2..44c4bda89 100644
--- a/stdlib/source/library/lux/target/jvm/reflection.lux
+++ b/stdlib/source/library/lux/target/jvm/reflection.lux
@@ -130,7 +130,7 @@
(-> (-> java/lang/reflect/Type (Try (/.Type Parameter)))
java/lang/reflect/Type
(Try (/.Type Class)))
- (<| (case (ffi.check java/lang/Class reflection)
+ (<| (case (ffi.as java/lang/Class reflection)
{.#Some class}
(let [class_name (|> class
(as (java/lang/Class java/lang/Object))
@@ -151,10 +151,10 @@
(exception.except ..not_a_class [reflection])
{try.#Success (/.class class_name (list))})))
_)
- (case (ffi.check java/lang/reflect/ParameterizedType reflection)
+ (case (ffi.as java/lang/reflect/ParameterizedType reflection)
{.#Some reflection}
(let [raw (java/lang/reflect/ParameterizedType::getRawType reflection)]
- (case (ffi.check java/lang/Class raw)
+ (case (ffi.as java/lang/Class raw)
{.#Some raw'}
(let [! try.monad]
(|> reflection
@@ -175,11 +175,11 @@
(def: .public (parameter type reflection)
(-> (-> java/lang/reflect/Type (Try (/.Type Value)))
(-> java/lang/reflect/Type (Try (/.Type Parameter))))
- (<| (case (ffi.check java/lang/reflect/TypeVariable reflection)
+ (<| (case (ffi.as java/lang/reflect/TypeVariable reflection)
{.#Some reflection}
{try.#Success (/.var (java/lang/reflect/TypeVariable::getName reflection))}
_)
- (case (ffi.check java/lang/reflect/WildcardType reflection)
+ (case (ffi.as java/lang/reflect/WildcardType reflection)
{.#Some reflection}
... TODO: Instead of having single lower/upper bounds, should
... allow for multiple ones.
@@ -187,7 +187,7 @@
(array.read! 0 (java/lang/reflect/WildcardType::getUpperBounds reflection))]
(^.template [<pattern> <kind>]
[<pattern>
- (case (ffi.check java/lang/reflect/GenericArrayType bound)
+ (case (ffi.as java/lang/reflect/GenericArrayType bound)
{.#Some it}
... TODO: Array bounds should not be "erased" as they
... are right now.
@@ -201,14 +201,14 @@
_
{try.#Success /.wildcard})
_)
- (case (ffi.check java/lang/reflect/GenericArrayType reflection)
+ (case (ffi.as java/lang/reflect/GenericArrayType reflection)
{.#Some reflection}
(|> reflection
java/lang/reflect/GenericArrayType::getGenericComponentType
type
(# try.monad each /.array))
_)
- (case (ffi.check java/lang/Class reflection)
+ (case (ffi.as java/lang/Class reflection)
{.#Some class}
(if (java/lang/Class::isArray class)
(|> class
@@ -221,7 +221,7 @@
(def: .public (type reflection)
(-> java/lang/reflect/Type (Try (/.Type Value)))
- (<| (case (ffi.check java/lang/Class reflection)
+ (<| (case (ffi.as java/lang/Class reflection)
{.#Some reflection}
(let [class_name (|> reflection
(as (java/lang/Class java/lang/Object))
@@ -254,7 +254,7 @@
(def: .public (return reflection)
(-> java/lang/reflect/Type (Try (/.Type Return)))
(with_expansions [<else> (these (..type reflection))]
- (case (ffi.check java/lang/Class reflection)
+ (case (ffi.as java/lang/Class reflection)
{.#Some class}
(let [class_name (|> reflection
(as (java/lang/Class java/lang/Object))
@@ -362,7 +362,7 @@
(def: .public deprecated?
(-> (array.Array java/lang/annotation/Annotation) Bit)
(|>> (array.list {.#None})
- (list.all (|>> (ffi.check java/lang/Deprecated)))
+ (list.all (|>> (ffi.as java/lang/Deprecated)))
list.empty?
not))
diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux
index abdc297c7..2db7c0bc3 100644
--- a/stdlib/source/test/lux/ffi.jvm.lux
+++ b/stdlib/source/test/lux/ffi.jvm.lux
@@ -165,11 +165,11 @@
bit/0 random.bit]
($_ _.and
- (_.cover [/.check]
- (and (case (/.check java/lang/String sample) {.#Some _} true {.#None} false)
- (case (/.check java/lang/Long sample) {.#Some _} false {.#None} true)
- (case (/.check java/lang/Object sample) {.#Some _} true {.#None} false)
- (case (/.check java/lang/Object (/.null)) {.#Some _} false {.#None} true)))
+ (_.cover [/.as]
+ (and (case (/.as java/lang/String sample) {.#Some _} true {.#None} false)
+ (case (/.as java/lang/Long sample) {.#Some _} false {.#None} true)
+ (case (/.as java/lang/Object sample) {.#Some _} true {.#None} false)
+ (case (/.as java/lang/Object (/.null)) {.#Some _} false {.#None} true)))
(_.cover [/.synchronized]
(/.synchronized sample #1))
(_.cover [/.class_for]
@@ -237,10 +237,10 @@
(text#= it))))
(_.cover [/.cannot_cast_to_non_object]
(text.contains? (the exception.#label /.cannot_cast_to_non_object)
- (macro_error (/.as boolean (is /.Boolean boolean)))))
- (_.cover [/.as]
+ (macro_error (/.is boolean (is /.Boolean boolean)))))
+ (_.cover [/.is]
(|> string
- (/.as java/lang/Object)
+ (/.is java/lang/Object)
(same? (as java/lang/Object string))))
(_.cover [/.type]
(and (and (type#= /.Boolean (/.type java/lang/Boolean))
diff --git a/stdlib/source/test/lux/ffi.old.lux b/stdlib/source/test/lux/ffi.old.lux
index f452cf5a1..2b50f700c 100644
--- a/stdlib/source/test/lux/ffi.old.lux
+++ b/stdlib/source/test/lux/ffi.old.lux
@@ -201,11 +201,11 @@
counter random.int
increase random.int]
($_ _.and
- (_.cover [/.check]
- (and (case (/.check java/lang/String sample) {.#Some _} true {.#None} false)
- (case (/.check java/lang/Long sample) {.#Some _} false {.#None} true)
- (case (/.check java/lang/Object sample) {.#Some _} true {.#None} false)
- (case (/.check java/lang/Object (/.null)) {.#Some _} false {.#None} true)))
+ (_.cover [/.as]
+ (and (case (/.as java/lang/String sample) {.#Some _} true {.#None} false)
+ (case (/.as java/lang/Long sample) {.#Some _} false {.#None} true)
+ (case (/.as java/lang/Object sample) {.#Some _} true {.#None} false)
+ (case (/.as java/lang/Object (/.null)) {.#Some _} false {.#None} true)))
(_.cover [/.synchronized]
(/.synchronized sample #1))
(_.cover [/.class_for /.import:]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 17:34:36 +0000