diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/library/lux/debug.lux | 6 | ||||
-rw-r--r-- | stdlib/source/library/lux/ffi.jvm.lux | 350 | ||||
-rw-r--r-- | stdlib/source/library/lux/ffi.old.lux | 220 | ||||
-rw-r--r-- | stdlib/source/library/lux/target/jvm/reflection.lux | 22 |
4 files changed, 299 insertions, 299 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)) |