diff options
Diffstat (limited to 'stdlib/source/library/lux/ffi.jvm.lux')
| -rw-r--r-- | stdlib/source/library/lux/ffi.jvm.lux | 256 |
1 files changed, 128 insertions, 128 deletions
diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 9fc79a2d9..49042f104 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -39,23 +39,23 @@ ["[0]" type (.open: "[1]#[0]" equivalence) ["[0]" check]]]]) -(def: internal +(def internal (-> External Text) (|>> name.internal name.read)) -(def: signature +(def signature (All (_ category) (-> (Type category) Text)) (|>> jvm.signature signature.signature)) -(def: reflection +(def reflection (All (_ category) (-> (Type (<| Return' Value' category)) Text)) (|>> jvm.reflection reflection.reflection)) (with_template [<name> <class>] - [(`` (def: .public <name> + [(`` (def .public <name> .Type {.#Primitive <class> {.#End}}))] @@ -71,7 +71,7 @@ ) (with_template [<name> <class>] - [(`` (def: .public <name> + [(`` (def .public <name> .Type {.#Primitive (reflection.reflection <class>) {.#End}}))] @@ -86,20 +86,20 @@ [char reflection.char] ) -(def: (get_static_field class field) +(def (get_static_field class field) (-> Text Text Code) (` ("jvm member get static" (~ (code.text class)) (~ (code.text field))))) -(def: (get_virtual_field class field object) +(def (get_virtual_field class field object) (-> Text Text Code Code) (` ("jvm member get virtual" (~ (code.text class)) (~ (code.text field)) (~ object)))) -(def: boxes +(def boxes (Dictionary (Type Value) Text) (|> (list [jvm.boolean box.boolean] [jvm.byte box.byte] @@ -112,7 +112,7 @@ (dictionary.of_list jvm.hash))) (with_template [<name> <pre> <post>] - [(def: (<name> unboxed boxed raw) + [(def (<name> unboxed boxed raw) (-> (Type Value) Text Code Code) (let [unboxed (..reflection unboxed)] (` (|> (~ raw) @@ -125,7 +125,7 @@ ) (with_template [<name> <op> <from> <to>] - [(def: .public <name> + [(def .public <name> (template (<name> value) [(|> value (.is <from>) @@ -166,7 +166,7 @@ ) (with_template [<name> <from> <to> <0> <1>] - [(def: .public <name> + [(def .public <name> (template (<name> value) [(|> value <0> <1>)]))] @@ -177,7 +177,7 @@ [short_to_char ..Short ..Character ..short_to_int ..int_to_char] ) -(def: constructor_method_name +(def constructor_method_name "<init>") (type: Primitive_Mode @@ -327,7 +327,7 @@ {#MethodDecl [ImportMethodCommons ImportMethodDecl]} {#FieldAccessDecl ImportFieldDecl})) -(def: (primitive_type mode type) +(def (primitive_type mode type) (-> Primitive_Mode (Type Primitive) Code) (case mode {#ManualPrM} @@ -362,7 +362,7 @@ ... else (undefined)))) -(def: (parameter_type value_type type) +(def (parameter_type value_type type) (-> (-> (Type Value) Code) (-> (Type Parameter) Code)) (`` (<| (~~ (with_template [<when> <binding> <then>] @@ -390,7 +390,7 @@ (undefined) ))) -(def: (value_type mode type) +(def (value_type mode type) (-> Primitive_Mode (Type Value) Code) (`` (<| (~~ (with_template [<when> <binding> <then>] [(case (<when> type) @@ -404,25 +404,25 @@ (undefined) ))) -(def: declaration_type$ +(def declaration_type$ (-> (Type Declaration) Code) (|>> ..signature code.text)) -(def: (get_const_parser class_name field_name) +(def (get_const_parser class_name field_name) (-> Text Text (Parser Code)) (do <>.monad [.let [dotted_name (format "::" field_name)] _ (<code>.this (code.symbol ["" dotted_name]))] (in (get_static_field class_name field_name)))) -(def: (get_var_parser class_name field_name self_name) +(def (get_var_parser class_name field_name self_name) (-> Text Text Text (Parser Code)) (do <>.monad [.let [dotted_name (format "::" field_name)] _ (<code>.this (code.symbol ["" dotted_name]))] (in (get_virtual_field class_name field_name (code.local self_name))))) -(def: (put_var_parser class_name field_name self_name) +(def (put_var_parser class_name field_name self_name) (-> Text Text Text (Parser Code)) (do <>.monad [.let [dotted_name (format "::" field_name)] @@ -434,7 +434,7 @@ (~ value) (~ (code.local self_name))))))) -(def: (replaced f input) +(def (replaced f input) (-> (-> Code Code) Code Code) (case (f input) (^.with_template [<tag>] @@ -447,7 +447,7 @@ ast' ast')) -(def: (parser->replacer p ast) +(def (parser->replacer p ast) (-> (Parser Code) (-> Code Code)) (case (<>.result p (list ast)) {.#Right [{.#End} ast']} @@ -457,7 +457,7 @@ ast )) -(def: (field->parser class_name self_name [[field_name _ _] field]) +(def (field->parser class_name self_name [[field_name _ _] field]) (-> Text Text [Member_Declaration FieldDecl] (Parser Code)) (case field {#ConstantField _} @@ -467,11 +467,11 @@ (<>.either (get_var_parser class_name field_name self_name) (put_var_parser class_name field_name self_name)))) -(def: (decorate_input [class value]) +(def (decorate_input [class value]) (-> [(Type Value) Code] Code) (` [(~ (code.text (..signature class))) (~ value)])) -(def: (constructor_parser class_name arguments) +(def (constructor_parser class_name arguments) (-> Text (List Argument) (Parser Code)) (do <>.monad [args (.is (Parser (List Code)) @@ -482,7 +482,7 @@ (list.zipped_2 (list#each product.right arguments)) (list#each ..decorate_input)))))))) -(def: (static_method_parser class_name method_name arguments) +(def (static_method_parser class_name method_name arguments) (-> Text Text (List Argument) (Parser Code)) (do <>.monad [.let [dotted_name (format "::" method_name "!")] @@ -495,7 +495,7 @@ (list#each ..decorate_input)))))))) (with_template [<name> <jvm_op>] - [(def: (<name> class_vars class_name type_vars method_name arguments self_name) + [(def (<name> class_vars class_name type_vars method_name arguments self_name) (-> (List (Type Var)) Text (List (Type Var)) Text (List Argument) Text (Parser Code)) (do <>.monad [.let [dotted_name (format "::" method_name "!")] @@ -514,7 +514,7 @@ [virtual_method_parser "jvm member invoke virtual"] ) -(def: (method->parser class_vars class_name [[method_name _ _] meth_def]) +(def (method->parser class_vars class_name [[method_name _ _] meth_def]) (-> (List (Type Var)) Text [Member_Declaration Method_Definition] (Parser Code)) (case meth_def {#ConstructorMethod strict? type_vars self_name args constructor_args return_expr exs} @@ -535,7 +535,7 @@ {#NativeMethod type_vars args return_type exs} (virtual_method_parser class_vars class_name type_vars method_name args ""))) -(def: privacy_modifier^ +(def privacy_modifier^ (Parser Privacy) (let [(open "[0]") <>.monad] (all <>.or @@ -544,7 +544,7 @@ (<code>.this (' "protected")) (in [])))) -(def: inheritance_modifier^ +(def inheritance_modifier^ (Parser Inheritance) (let [(open "[0]") <>.monad] (all <>.or @@ -562,12 +562,12 @@ "Name" (%.text name) "Type Variables" (exception.listing parser.name type_vars))) -(def: (assertion exception payload test) +(def (assertion exception payload test) (All (_ e) (-> (Exception e) e Bit (Parser Any))) (<>.assertion (exception.error exception payload) test)) -(def: (valid_class_name type_vars) +(def (valid_class_name type_vars) (-> (List (Type Var)) (Parser External)) (do <>.monad [name <code>.local @@ -579,7 +579,7 @@ name)))] (in name))) -(def: (class^' parameter^ type_vars) +(def (class^' parameter^ type_vars) (-> (-> (List (Type Var)) (Parser (Type Parameter))) (-> (List (Type Var)) (Parser (Type Class)))) (do <>.monad @@ -596,7 +596,7 @@ "Unexpected Type Variable" (%.text name) "Expected Type Variables" (exception.listing parser.name type_vars))) -(def: (type_variable options) +(def (type_variable options) (-> (List (Type Var)) (Parser (Type Parameter))) (do <>.monad [name <code>.local @@ -604,14 +604,14 @@ (list.member? text.equivalence (list#each parser.name options) name))] (in (jvm.var name)))) -(def: wildcard^ +(def wildcard^ (Parser (Type Parameter)) (do <>.monad [_ (<code>.this (' ?))] (in jvm.wildcard))) (with_template [<name> <comparison> <constructor>] - [(def: <name> + [(def <name> (-> (Parser (Type Class)) (Parser (Type Parameter))) (|>> (<>.after (<code>.this (' <comparison>))) (<>.after ..wildcard^) @@ -622,7 +622,7 @@ [lower^ > jvm.lower] ) -(def: (parameter^ type_vars) +(def (parameter^ type_vars) (-> (List (Type Var)) (Parser (Type Parameter))) (<>.rec (function (_ _) @@ -635,7 +635,7 @@ class^ ))))) -(def: (itself^ type) +(def (itself^ type) (All (_ category) (-> (Type (<| Return' Value' category)) (Parser (Type (<| Return' Value' category))))) @@ -643,7 +643,7 @@ [_ (<code>.this_symbol ["" (..reflection type)])] (in type))) -(def: primitive^ +(def primitive^ (Parser (Type Primitive)) (all <>.either (itself^ jvm.boolean) @@ -656,12 +656,12 @@ (itself^ jvm.char) )) -(def: array^ +(def array^ (-> (Parser (Type Value)) (Parser (Type Array))) (|>> <code>.tuple (at <>.monad each jvm.array))) -(def: (type^ type_vars) +(def (type^ type_vars) (-> (List (Type Var)) (Parser (Type Value))) (<>.rec (function (_ type^) @@ -671,26 +671,26 @@ (..array^ type^) )))) -(def: void^ +(def void^ (Parser (Type Void)) (do <>.monad [_ (<code>.this_symbol ["" (reflection.reflection reflection.void)])] (in jvm.void))) -(def: (return^ type_vars) +(def (return^ type_vars) (-> (List (Type Var)) (Parser (Type Return))) (<>.either ..void^ (..type^ type_vars))) -(def: var^ +(def var^ (Parser (Type Var)) (at <>.monad each jvm.var <code>.local)) -(def: vars^ +(def vars^ (Parser (List (Type Var))) (<code>.tuple (<>.some var^))) -(def: declaration^ +(def declaration^ (Parser (Type Declaration)) (do <>.monad [[name variables] (.is (Parser [External (List (Type Var))]) @@ -701,15 +701,15 @@ ))] (in (jvm.declaration name variables)))) -(def: (class^ type_vars) +(def (class^ type_vars) (-> (List (Type Var)) (Parser (Type Class))) (class^' parameter^ type_vars)) -(def: annotation_parameters^ +(def annotation_parameters^ (Parser (List Annotation_Parameter)) (<code>.tuple (<>.some (<>.and <code>.text <code>.any)))) -(def: annotation^ +(def annotation^ (Parser Annotation) (<>.either (do <>.monad [ann_name <code>.local] @@ -717,21 +717,21 @@ (<code>.form (<>.and <code>.local annotation_parameters^)))) -(def: annotations^ +(def annotations^ (Parser (List Annotation)) (<| (<>.else (list)) (do <>.monad [_ (<code>.this (' "ann"))] (<code>.tuple (<>.some ..annotation^))))) -(def: (throws_decl^ type_vars) +(def (throws_decl^ type_vars) (-> (List (Type Var)) (Parser (List (Type Class)))) (<| (<>.else (list)) (do <>.monad [_ (<code>.this (' "throws"))] (<code>.tuple (<>.some (..class^ type_vars)))))) -(def: (method_decl^ type_vars) +(def (method_decl^ type_vars) (-> (List (Type Var)) (Parser [Member_Declaration MethodDecl])) (<code>.form (do <>.monad [tvars (<>.else (list) ..vars^) @@ -746,14 +746,14 @@ #method_output output #method_exs exs]])))) -(def: state_modifier^ +(def state_modifier^ (Parser State) (all <>.or (<code>.this (' "volatile")) (<code>.this (' "final")) (at <>.monad in []))) -(def: (field_decl^ type_vars) +(def (field_decl^ type_vars) (-> (List (Type Var)) (Parser [Member_Declaration FieldDecl])) (<>.either (<code>.form (do <>.monad [_ (<code>.this (' "const")) @@ -771,24 +771,24 @@ type (..type^ type_vars)] (in [[name pm anns] {#VariableField [sm static? type]}]))))) -(def: (argument^ type_vars) +(def (argument^ type_vars) (-> (List (Type Var)) (Parser Argument)) (<>.and <code>.local (..type^ type_vars))) -(def: (arguments^ type_vars) +(def (arguments^ type_vars) (-> (List (Type Var)) (Parser (List Argument))) (<code>.tuple (<>.some (..argument^ type_vars)))) -(def: (constructor_arg^ type_vars) +(def (constructor_arg^ type_vars) (-> (List (Type Var)) (Parser (Typed Code))) (<>.and (..type^ type_vars) <code>.any)) -(def: (constructor_args^ type_vars) +(def (constructor_args^ type_vars) (-> (List (Type Var)) (Parser (List (Typed Code)))) (<code>.tuple (<>.some (..constructor_arg^ type_vars)))) -(def: (constructor_method^ class_vars) +(def (constructor_method^ class_vars) (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition])) (<code>.form (do <>.monad [pm privacy_modifier^ @@ -808,7 +808,7 @@ #member_anns annotations] {#ConstructorMethod strict_fp? method_vars self_name arguments constructor_args body exs}])))) -(def: (virtual_method_def^ class_vars) +(def (virtual_method_def^ class_vars) (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition])) (<code>.form (do <>.monad [pm privacy_modifier^ @@ -829,7 +829,7 @@ #member_anns annotations] {#VirtualMethod final? strict_fp? method_vars self_name arguments return_type body exs}])))) -(def: overriden_method_def^ +(def overriden_method_def^ (Parser [Member_Declaration Method_Definition]) (<code>.form (do <>.monad [strict_fp? (<>.parses? (<code>.this (' "strict"))) @@ -850,7 +850,7 @@ #member_anns annotations] {#OverridenMethod strict_fp? owner_class method_vars self_name arguments return_type body exs}])))) -(def: static_method_def^ +(def static_method_def^ (Parser [Member_Declaration Method_Definition]) (<code>.form (do <>.monad [pm privacy_modifier^ @@ -869,7 +869,7 @@ #member_anns annotations] {#StaticMethod strict_fp? method_vars arguments return_type body exs}])))) -(def: abstract_method_def^ +(def abstract_method_def^ (Parser [Member_Declaration Method_Definition]) (<code>.form (do <>.monad [pm privacy_modifier^ @@ -886,7 +886,7 @@ #member_anns annotations] {#AbstractMethod method_vars arguments return_type exs}])))) -(def: native_method_def^ +(def native_method_def^ (Parser [Member_Declaration Method_Definition]) (<code>.form (do <>.monad [pm privacy_modifier^ @@ -903,7 +903,7 @@ #member_anns annotations] {#NativeMethod method_vars arguments return_type exs}])))) -(def: (method_def^ class_vars) +(def (method_def^ class_vars) (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition])) (all <>.either (..constructor_method^ class_vars) @@ -913,34 +913,34 @@ ..abstract_method_def^ ..native_method_def^)) -(def: partial_call^ +(def partial_call^ (Parser Partial_Call) (<code>.form (<>.and <code>.symbol (<>.some <code>.any)))) -(def: import_member_alias^ +(def import_member_alias^ (Parser (Maybe Text)) (<>.maybe (do <>.monad [_ (<code>.this (' "as"))] <code>.local))) -(def: (import_member_args^ type_vars) +(def (import_member_args^ type_vars) (-> (List (Type Var)) (Parser (List [Bit (Type Value)]))) (<code>.tuple (<>.some (<>.and (<>.parses? (<code>.this (' "?"))) (..type^ type_vars))))) -(def: import_member_return_flags^ +(def import_member_return_flags^ (Parser [Bit Bit Bit]) (all <>.and (<>.parses? (<code>.this (' "io"))) (<>.parses? (<code>.this (' "try"))) (<>.parses? (<code>.this (' "?"))))) -(def: primitive_mode^ +(def primitive_mode^ (Parser Primitive_Mode) (<>.or (<code>.this (' "manual")) (<code>.this (' "auto")))) -(def: (import_member_decl^ owner_vars) +(def (import_member_decl^ owner_vars) (-> (List (Type Var)) (Parser Import_Member_Declaration)) (all <>.either (<code>.form (do <>.monad @@ -1002,7 +1002,7 @@ #import_field_type gtype]}))) )) -(def: (privacy_modifier$ pm) +(def (privacy_modifier$ pm) (-> Privacy Code) (case pm {#PublicP} (code.text "public") @@ -1010,23 +1010,23 @@ {#ProtectedP} (code.text "protected") {#DefaultP} (code.text "default"))) -(def: (inheritance_modifier$ im) +(def (inheritance_modifier$ im) (-> Inheritance Code) (case im {#FinalI} (code.text "final") {#AbstractI} (code.text "abstract") {#DefaultI} (code.text "default"))) -(def: (annotation_parameter$ [name value]) +(def (annotation_parameter$ [name value]) (-> Annotation_Parameter Code) (` [(~ (code.text name)) (~ value)])) -(def: (annotation$ [name params]) +(def (annotation$ [name params]) (-> Annotation Code) (` ((~ (code.text name)) (~+ (list#each annotation_parameter$ params))))) (with_template [<name> <category>] - [(def: <name> + [(def <name> (-> (Type <category>) Code) (|>> ..signature code.text))] @@ -1038,11 +1038,11 @@ [class$ Class] ) -(def: var$' +(def var$' (-> (Type Var) Code) (|>> ..signature code.local)) -(def: (method_decl$ [[name pm anns] method_decl]) +(def (method_decl$ [[name pm anns] method_decl]) (-> [Member_Declaration MethodDecl] Code) (let [(open "[0]") method_decl] (` ((~ (code.text name)) @@ -1052,14 +1052,14 @@ [(~+ (list#each value$ #method_inputs))] (~ (return$ #method_output)))))) -(def: (state_modifier$ it) +(def (state_modifier$ it) (-> State Code) (case it {#VolatileS} (' "volatile") {#FinalS} (' "final") {#DefaultS} (' "default"))) -(def: (field_decl$ [[name pm anns] field]) +(def (field_decl$ [[name pm anns] field]) (-> [Member_Declaration FieldDecl] Code) (case field {#ConstantField class value} @@ -1081,15 +1081,15 @@ )) )) -(def: (argument$ [name type]) +(def (argument$ [name type]) (-> Argument Code) (` [(~ (code.text name)) (~ (value$ type))])) -(def: (constructor_arg$ [class term]) +(def (constructor_arg$ [class term]) (-> (Typed Code) Code) (` [(~ (value$ class)) (~ term)])) -(def: (overriden_method_macro super_class name declaration type_vars self_name expected_arguments) +(def (overriden_method_macro super_class name declaration type_vars self_name expected_arguments) (-> (Type Class) Text (Type Declaration) (List (Type Var)) Text (List Argument) Macro) (syntax (_ [_ (<code>.this (' "super")) actual_arguments (<code>.tuple (<>.exactly (list.size expected_arguments) <code>.any))]) @@ -1104,7 +1104,7 @@ (list.zipped_2 (list#each product.right expected_arguments)) (list#each ..decorate_input))))))))) -(def: (method_def$ fully_qualified_class_name method_parser super_class fields [[name pm anns] method_def]) +(def (method_def$ fully_qualified_class_name method_parser super_class fields [[name pm anns] method_def]) (-> External (Parser Code) (Type Class) (List [Member_Declaration FieldDecl]) [Member_Declaration Method_Definition] (Meta Code)) (case method_def {#ConstructorMethod strict_fp? type_vars self_name arguments constructor_args body exs} @@ -1195,15 +1195,15 @@ (~ (return$ return_type))))) )) -(def: (complete_call$ g!obj [method args]) +(def (complete_call$ g!obj [method args]) (-> Code Partial_Call Code) (` ((~ (code.symbol method)) (~+ args) (~ g!obj)))) -(def: $Object +(def $Object (Type Class) (jvm.class "java.lang.Object" (list))) -(def: .public class +(def .public class (syntax (_ [.let [! <>.monad] im inheritance_modifier^ [full_class_name class_vars] (at ! each parser.declaration ..declaration^) @@ -1230,7 +1230,7 @@ [(~+ (list#each field_decl$ fields))] [(~+ methods)]))))))) -(def: .public interface +(def .public interface (syntax (_ [.let [! <>.monad] [full_class_name class_vars] (at ! each parser.declaration ..declaration^) supers (<>.else (list) @@ -1243,7 +1243,7 @@ [(~+ (list#each annotation$ annotations))] (~+ (list#each method_decl$ members)))))))) -(def: .public object +(def .public object (syntax (_ [class_vars ..vars^ super (<>.else $Object (class^ class_vars)) @@ -1260,15 +1260,15 @@ [(~+ (list#each constructor_arg$ constructor_args))] [(~+ methods)]))))))) -(def: .public null +(def .public null (syntax (_ []) (in (list (` ("jvm object null")))))) -(def: .public (null? obj) +(def .public (null? obj) (-> (.Primitive "java.lang.Object") Bit) ("jvm object null?" obj)) -(def: .public ??? +(def .public ??? (syntax (_ [expr <code>.any]) (with_symbols [g!temp] (in (list (` (let [(~ g!temp) (~ expr)] @@ -1276,7 +1276,7 @@ {.#Some (~ g!temp)} {.#None})))))))) -(def: .public !!! +(def .public !!! (syntax (_ [expr <code>.any]) (with_symbols [g!value] (in (list (` (.case (~ expr) @@ -1286,7 +1286,7 @@ {.#None} ("jvm object null")))))))) -(def: .public as +(def .public as (syntax (_ [class (..type^ (list)) unchecked (<>.maybe <code>.any)]) (with_symbols [g!_ g!unchecked] @@ -1309,12 +1309,12 @@ (~ check_code)))))) ))))) -(def: .public synchronized +(def .public synchronized (syntax (_ [lock <code>.any body <code>.any]) (in (list (` ("jvm object synchronized" (~ lock) (~ body))))))) -(def: .public do_to +(def .public do_to (syntax (_ [obj <code>.any methods (<>.some partial_call^)]) (with_symbols [g!obj] @@ -1322,19 +1322,19 @@ (exec (~+ (list#each (complete_call$ g!obj) methods)) (~ g!obj))))))))) -(def: (class_import$ declaration) +(def (class_import$ declaration) (-> (Type Declaration) Code) (let [[full_name params] (parser.declaration declaration) def_name (..internal full_name) params' (list#each ..var$' params)] (template.with_locals [g!_] - (` (def: (~ (code.symbol ["" def_name])) + (` (def (~ (code.symbol ["" def_name])) .Type (All ((~ (' g!_)) (~+ params')) (.Primitive (~ (code.text full_name)) [(~+ params')]))))))) -(def: (member_type_vars class_tvars member) +(def (member_type_vars class_tvars member) (-> (List (Type Var)) Import_Member_Declaration (List (Type Var))) (case member {#ConstructorDecl [commons _]} @@ -1351,7 +1351,7 @@ _ class_tvars)) -(def: (member_def_arg_bindings vars member) +(def (member_def_arg_bindings vars member) (-> (List (Type Var)) Import_Member_Declaration (Meta [(List [Bit Code]) (List (Type Value)) (List Code)])) (case member (^.or {#ConstructorDecl [commons _]} {#MethodDecl [commons _]}) @@ -1376,7 +1376,7 @@ _ (at meta.monad in [(list) (list) (list)]))) -(def: (with_return_maybe member never_null? unboxed return_term) +(def (with_return_maybe member never_null? unboxed return_term) (-> Import_Member_Declaration Bit (Type Value) Code Code) (case member (^.or {#ConstructorDecl [commons _]} {#MethodDecl [commons _]}) @@ -1399,7 +1399,7 @@ return_term)) (with_template [<name> <tag> <term_trans>] - [(def: (<name> member return_term) + [(def (<name> member return_term) (-> Import_Member_Declaration Code Code) (case member (^.or {#ConstructorDecl [commons _]} {#MethodDecl [commons _]}) @@ -1415,7 +1415,7 @@ ) (with_template [<input?> <name> <unbox/box> <special+>] - [(def: (<name> mode [unboxed raw]) + [(def (<name> mode [unboxed raw]) (-> Primitive_Mode [(Type Value) Code] Code) (let [[unboxed refined post] (.is [(Type Value) Code (List Code)] (case mode @@ -1472,11 +1472,11 @@ [jvm.double (list) [(` (.is (.Primitive (~ (code.text box.double)))))]]]] ) -(def: (un_quoted quoted) +(def (un_quoted quoted) (-> Code Code) (` ((~' ~) (~ quoted)))) -(def: (jvm_invoke_inputs mode classes inputs) +(def (jvm_invoke_inputs mode classes inputs) (-> Primitive_Mode (List (Type Value)) (List [Bit Code]) (List Code)) (|> inputs (list.zipped_2 classes) @@ -1488,13 +1488,13 @@ [class] (with_automatic_input_conversion mode)))))) -(def: (import_name format class member) +(def (import_name format class member) (-> Text Text Text Text) (|> format (text.replaced "[1]" class) (text.replaced "[0]" member))) -(def: syntax_inputs +(def syntax_inputs (-> (List Code) (List Code)) (|>> (list#each (function (_ name) (list name (` (~! <code>.any))))) @@ -1506,7 +1506,7 @@ "Class" (%.text class) "Field" (%.text field))) -(def: (member_def_interop vars kind class [arg_function_inputs input_jvm_types arg_types] member method_prefix import_format) +(def (member_def_interop vars kind class [arg_function_inputs input_jvm_types arg_types] member method_prefix import_format) (-> (List (Type Var)) Class_Kind (Type Declaration) [(List [Bit Code]) (List (Type Value)) (List Code)] Import_Member_Declaration Text Text (Meta (List Code))) (let [[full_name class_tvars] (parser.declaration class)] (case member @@ -1525,7 +1525,7 @@ getter_interop (.is (-> Text Code) (function (_ name) (let [getter_name (code.symbol ["" (..import_name import_format method_prefix name)])] - (` (def: (~ getter_name) + (` (def (~ getter_name) (~ enum_type) (~ (get_static_field full_name name)))))))]] (in (list#each getter_interop enum_members)))) @@ -1546,7 +1546,7 @@ (with_return_maybe member true classT) (with_return_try member) (with_return_io member))]] - (in (list (` (def: (~ def_name) + (in (list (` (def (~ def_name) ((~! syntax) ((~ def_name) [(~+ (syntax_inputs (list#each product.right arg_function_inputs)))]) ((~' in) (.list (.` (~ jvm_interop)))))))))) @@ -1601,7 +1601,7 @@ (|> callC (with_return_try member) (with_return_io member))))]] - (in (list (` (def: (~ def_name) + (in (list (` (def (~ def_name) ((~! syntax) ((~ def_name) [(~+ (syntax_inputs (list#each product.right arg_function_inputs))) (~+ (syntax_inputs object_ast))]) ((~' in) (.list (.` (~ jvm_interop))))))))))) @@ -1657,14 +1657,14 @@ (` {.#Right []}) (` {.#Right [(~ g!obj)]})) (` ((~' in) (.list (.` (~ getter_body))))))] - (list (` (def: (~ g!name) + (list (` (def (~ g!name) ((~! syntax) ((~ g!name) [(~ write|read) (~ parser)]) (case (~ write|read) (~+ write) (~+ read)))))))))) ))) -(def: (member_import$ vars kind class [import_format member]) +(def (member_import$ vars kind class [import_format member]) (-> (List (Type Var)) Class_Kind (Type Declaration) [Text Import_Member_Declaration] (Meta (List Code))) (let [[full_name _] (parser.declaration class) method_prefix (..internal full_name)] @@ -1672,21 +1672,21 @@ [=args (member_def_arg_bindings vars member)] (member_def_interop vars kind class =args member method_prefix import_format)))) -(def: interface? +(def interface? (All (_ a) (-> (.Primitive "java.lang.Class" [a]) Bit)) (|>> ("jvm member invoke virtual" [] "java.lang.Class" "isInterface" []) "jvm object cast" (.is ..Boolean) (.as Bit))) -(def: load_class +(def load_class (-> External (Try (.Primitive "java.lang.Class" [Any]))) (|>> (.as (.Primitive "java.lang.String")) ["Ljava/lang/String;"] ("jvm member invoke static" [] "java.lang.Class" "forName" []) try)) -(def: (class_kind declaration) +(def (class_kind declaration) (-> (Type Declaration) (Meta Class_Kind)) (let [[class_name _] (parser.declaration declaration)] (case (load_class class_name) @@ -1698,7 +1698,7 @@ {.#Left _} (meta.failure (format "Unknown class: " class_name))))) -(def: .public import +(def .public import (syntax (_ [declaration ..declaration^ .let [[class_name class_type_vars] (parser.declaration declaration)] import_format <code>.text @@ -1710,7 +1710,7 @@ (monad.each ! (member_import$ class_type_vars kind declaration)))] (in (list.partial (class_import$ declaration) (list#conjoint =members)))))) -(def: .public array +(def .public array (syntax (_ [type (..type^ (list)) size <code>.any]) (let [g!size (` (|> (~ size) @@ -1740,7 +1740,7 @@ "Lux Type" (%.type type))) (with_expansions [<failure> (these (meta.failure (exception.error ..cannot_convert_to_jvm_type [type])))] - (def: (lux_type->jvm_type context type) + (def (lux_type->jvm_type context type) (-> Type_Context .Type (Meta (Type Value))) (if (type#= .Any type) (at meta.monad in $Object) @@ -1838,7 +1838,7 @@ _ <failure>)))) -(def: .public length +(def .public length (syntax (_ [array <code>.any]) (case array [_ {.#Symbol array_name}] @@ -1874,7 +1874,7 @@ (in (list (` (let [(~ g!array) (~ array)] (..length (~ g!array)))))))))) -(def: .public read! +(def .public read! (syntax (_ [idx <code>.any array <code>.any]) (case array @@ -1913,7 +1913,7 @@ (in (list (` (let [(~ g!array) (~ array)] (..read! (~ idx) (~ g!array)))))))))) -(def: .public write! +(def .public write! (syntax (_ [idx <code>.any value <code>.any array <code>.any]) @@ -1954,11 +1954,11 @@ (in (list (` (let [(~ g!array) (~ array)] (..write! (~ idx) (~ value) (~ g!array)))))))))) -(def: .public class_for +(def .public class_for (syntax (_ [type (..type^ (list))]) (in (list (` ("jvm object class" (~ (code.text (..reflection type))))))))) -(def: .public type +(def .public type (syntax (_ [type (..type^ (list))]) (in (list (..value_type {#ManualPrM} type))))) @@ -1967,7 +1967,7 @@ "Signature" (..signature type) "Reflection" (..reflection type))) -(def: .public is +(def .public is (syntax (_ [type (..type^ (list)) object <code>.any]) (case [(parser.array? type) @@ -1980,11 +1980,11 @@ (meta.failure (exception.error ..cannot_cast_to_non_object [type]))))) (with_template [<forward> <from> <to> <backward>] - [(def: .public <forward> + [(def .public <forward> (template (<forward> it) [(|> it (.is <from>) (.as <to>))])) - (def: .public <backward> + (def .public <backward> (template (<backward> it) [(|> it (.is <to>) (.as <from>))]))] @@ -1995,11 +1995,11 @@ ) (with_template [<forward> <from> <$> <mid> <$'> <to> <backward>] - [(def: .public <forward> + [(def .public <forward> (template (<forward> it) [(|> it (.is <from>) (.as <mid>) <$> (.is <to>))])) - (def: .public <backward> + (def .public <backward> (template (<backward> it) [(|> it (.is <to>) <$'> (.is <mid>) (.as <from>))]))] |