aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/ffi.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/library/lux/ffi.jvm.lux414
1 files changed, 207 insertions, 207 deletions
diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux
index 76983acd5..ff3215f6a 100644
--- a/stdlib/source/library/lux/ffi.jvm.lux
+++ b/stdlib/source/library/lux/ffi.jvm.lux
@@ -395,14 +395,14 @@
(do <>.monad
[#let [dotted_name (format "::" field_name)]
_ (<code>.this! (code.identifier ["" dotted_name]))]
- (wrap (get_static_field class_name field_name))))
+ (in (get_static_field class_name field_name))))
(def: (make_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.identifier ["" dotted_name]))]
- (wrap (get_virtual_field class_name field_name (code.local_identifier self_name)))))
+ (in (get_virtual_field class_name field_name (code.local_identifier self_name)))))
(def: (make_put_var_parser class_name field_name self_name)
(-> Text Text Text (Parser Code))
@@ -410,11 +410,11 @@
[#let [dotted_name (format "::" field_name)]
[_ _ value] (: (Parser [Any Any Code])
(<code>.form ($_ <>.and (<code>.this! (' :=)) (<code>.this! (code.identifier ["" dotted_name])) <code>.any)))]
- (wrap (`' ("jvm member put virtual"
- (~ (code.text class_name))
- (~ (code.text field_name))
- (~ value)
- (~ (code.local_identifier self_name)))))))
+ (in (`' ("jvm member put virtual"
+ (~ (code.text class_name))
+ (~ (code.text field_name))
+ (~ value)
+ (~ (code.local_identifier self_name)))))))
(def: (pre_walk_replace f input)
(-> (-> Code Code) Code Code)
@@ -464,10 +464,10 @@
[args (: (Parser (List Code))
(<code>.form (<>.after (<code>.this! (' ::new!))
(<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))]
- (wrap (` ("jvm member invoke constructor" (~ (code.text class_name))
- (~+ (|> args
- (list.zipped/2 (list\map product.right arguments))
- (list\map ..decorate_input))))))))
+ (in (` ("jvm member invoke constructor" (~ (code.text class_name))
+ (~+ (|> args
+ (list.zipped/2 (list\map product.right arguments))
+ (list\map ..decorate_input))))))))
(def: (make_static_method_parser class_name method_name arguments)
(-> Text Text (List Argument) (Parser Code))
@@ -476,10 +476,10 @@
args (: (Parser (List Code))
(<code>.form (<>.after (<code>.this! (code.identifier ["" dotted_name]))
(<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))]
- (wrap (` ("jvm member invoke static" (~ (code.text class_name)) (~ (code.text method_name))
- (~+ (|> args
- (list.zipped/2 (list\map product.right arguments))
- (list\map ..decorate_input))))))))
+ (in (` ("jvm member invoke static" (~ (code.text class_name)) (~ (code.text method_name))
+ (~+ (|> args
+ (list.zipped/2 (list\map product.right arguments))
+ (list\map ..decorate_input))))))))
(template [<name> <jvm_op>]
[(def: (<name> class_name method_name arguments self_name)
@@ -489,11 +489,11 @@
args (: (Parser (List Code))
(<code>.form (<>.after (<code>.this! (code.identifier ["" dotted_name]))
(<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))]
- (wrap (` (<jvm_op> (~ (code.text class_name)) (~ (code.text method_name))
- (~ (code.local_identifier self_name))
- (~+ (|> args
- (list.zipped/2 (list\map product.right arguments))
- (list\map ..decorate_input))))))))]
+ (in (` (<jvm_op> (~ (code.text class_name)) (~ (code.text method_name))
+ (~ (code.local_identifier self_name))
+ (~+ (|> args
+ (list.zipped/2 (list\map product.right arguments))
+ (list\map ..decorate_input))))))))]
[make_special_method_parser "jvm member invoke special"]
[make_virtual_method_parser "jvm member invoke virtual"]
@@ -527,7 +527,7 @@
(<code>.this! (' #public))
(<code>.this! (' #private))
(<code>.this! (' #protected))
- (wrap []))))
+ (in []))))
(def: inheritance_modifier^
(Parser Inheritance)
@@ -535,7 +535,7 @@
($_ <>.or
(<code>.this! (' #final))
(<code>.this! (' #abstract))
- (wrap []))))
+ (in []))))
(exception: #export (class_names_cannot_contain_periods {name Text})
(exception.report
@@ -562,7 +562,7 @@
(not (list.member? text.equivalence
(list\map parser.name type_vars)
name)))]
- (wrap name)))
+ (in name)))
(def: (class^' parameter^ type_vars)
(-> (-> (List (Type Var)) (Parser (Type Parameter)))
@@ -571,10 +571,10 @@
[[name parameters] (: (Parser [External (List (Type Parameter))])
($_ <>.either
(<>.and (valid_class_name type_vars)
- (<>\wrap (list)))
+ (<>\in (list)))
(<code>.form (<>.and <code>.local_identifier
(<>.some (parameter^ type_vars))))))]
- (wrap (type.class (name.safe name) parameters))))
+ (in (type.class (name.safe name) parameters))))
(exception: #export (unexpected_type_variable {name Text}
{type_vars (List (Type Var))})
@@ -588,13 +588,13 @@
[name <code>.local_identifier
_ (..assert ..unexpected_type_variable [name type_vars]
(list.member? text.equivalence (list\map parser.name type_vars) name))]
- (wrap (type.var name))))
+ (in (type.var name))))
(def: wildcard^
(Parser (Type Parameter))
(do <>.monad
[_ (<code>.this! (' ?))]
- (wrap type.wildcard)))
+ (in type.wildcard)))
(template [<name> <comparison> <constructor>]
[(def: <name>
@@ -627,7 +627,7 @@
(Parser (Type (<| Return' Value' category)))))
(do <>.monad
[_ (<code>.identifier! ["" (..reflection type)])]
- (wrap type)))
+ (in type)))
(def: primitive^
(Parser (Type Primitive))
@@ -661,7 +661,7 @@
(Parser (Type Void))
(do <>.monad
[_ (<code>.identifier! ["" (reflection.reflection reflection.void)])]
- (wrap type.void)))
+ (in type.void)))
(def: (return^ type_vars)
(-> (List (Type Var)) (Parser (Type Return)))
@@ -681,11 +681,11 @@
(do <>.monad
[[name variables] (: (Parser [External (List (Type Var))])
(<>.either (<>.and (..valid_class_name (list))
- (<>\wrap (list)))
+ (<>\in (list)))
(<code>.form (<>.and (..valid_class_name (list))
(<>.some var^)))
))]
- (wrap (type.declaration name variables))))
+ (in (type.declaration name variables))))
(def: (class^ type_vars)
(-> (List (Type Var)) (Parser (Type Class)))
@@ -699,7 +699,7 @@
(Parser Annotation)
(<>.either (do <>.monad
[ann_name <code>.local_identifier]
- (wrap [ann_name (list)]))
+ (in [ann_name (list)]))
(<code>.form (<>.and <code>.local_identifier
annotation_parameters^))))
@@ -713,7 +713,7 @@
(Parser (List Annotation))
(do <>.monad
[anns?? (<>.maybe ..annotations^')]
- (wrap (maybe.default (list) anns??))))
+ (in (maybe.default (list) anns??))))
(def: (throws_decl^ type_vars)
(-> (List (Type Var)) (Parser (List (Type Class))))
@@ -732,17 +732,17 @@
inputs (<code>.tuple (<>.some (..type^ total_vars)))
output (..return^ total_vars)
exs (..throws_decl^ total_vars)]
- (wrap [[name #PublicP anns] {#method_tvars tvars
- #method_inputs inputs
- #method_output output
- #method_exs exs}]))))
+ (in [[name #PublicP anns] {#method_tvars tvars
+ #method_inputs inputs
+ #method_output output
+ #method_exs exs}]))))
(def: state_modifier^
(Parser State)
($_ <>.or
(<code>.this! (' #volatile))
(<code>.this! (' #final))
- (\ <>.monad wrap [])))
+ (\ <>.monad in [])))
(def: (field_decl^ type_vars)
(-> (List (Type Var)) (Parser [Member_Declaration FieldDecl]))
@@ -752,14 +752,14 @@
anns ..annotations^
type (..type^ type_vars)
body <code>.any]
- (wrap [[name #PublicP anns] (#ConstantField [type body])])))
+ (in [[name #PublicP anns] (#ConstantField [type body])])))
(<code>.form (do <>.monad
[pm privacy_modifier^
sm state_modifier^
name <code>.local_identifier
anns ..annotations^
type (..type^ type_vars)]
- (wrap [[name pm anns] (#VariableField [sm type])])))))
+ (in [[name pm anns] (#VariableField [sm type])])))))
(def: (argument^ type_vars)
(-> (List (Type Var)) (Parser Argument))
@@ -793,10 +793,10 @@
exs (throws_decl^ total_vars)
annotations ..annotations^
body <code>.any]
- (wrap [{#member_name constructor_method_name
- #member_privacy pm
- #member_anns annotations}
- (#ConstructorMethod strict_fp? method_vars self_name arguments constructor_args body exs)]))))
+ (in [{#member_name constructor_method_name
+ #member_privacy pm
+ #member_anns annotations}
+ (#ConstructorMethod strict_fp? method_vars self_name arguments constructor_args body exs)]))))
(def: (virtual_method_def^ class_vars)
(-> (List (Type Var)) (Parser [Member_Declaration Method_Definition]))
@@ -814,10 +814,10 @@
exs (throws_decl^ total_vars)
annotations ..annotations^
body <code>.any]
- (wrap [{#member_name name
- #member_privacy pm
- #member_anns annotations}
- (#VirtualMethod final? strict_fp? method_vars self_name arguments return_type body exs)]))))
+ (in [{#member_name name
+ #member_privacy pm
+ #member_anns annotations}
+ (#VirtualMethod final? strict_fp? method_vars self_name arguments return_type body exs)]))))
(def: overriden_method_def^
(Parser [Member_Declaration Method_Definition])
@@ -835,10 +835,10 @@
exs (throws_decl^ total_vars)
annotations ..annotations^
body <code>.any]
- (wrap [{#member_name name
- #member_privacy #PublicP
- #member_anns annotations}
- (#OverridenMethod strict_fp? owner_class method_vars self_name arguments return_type body exs)]))))
+ (in [{#member_name name
+ #member_privacy #PublicP
+ #member_anns annotations}
+ (#OverridenMethod strict_fp? owner_class method_vars self_name arguments return_type body exs)]))))
(def: static_method_def^
(Parser [Member_Declaration Method_Definition])
@@ -854,10 +854,10 @@
exs (throws_decl^ total_vars)
annotations ..annotations^
body <code>.any]
- (wrap [{#member_name name
- #member_privacy pm
- #member_anns annotations}
- (#StaticMethod strict_fp? method_vars arguments return_type body exs)]))))
+ (in [{#member_name name
+ #member_privacy pm
+ #member_anns annotations}
+ (#StaticMethod strict_fp? method_vars arguments return_type body exs)]))))
(def: abstract_method_def^
(Parser [Member_Declaration Method_Definition])
@@ -871,10 +871,10 @@
return_type (..return^ total_vars)
exs (throws_decl^ total_vars)
annotations ..annotations^]
- (wrap [{#member_name name
- #member_privacy pm
- #member_anns annotations}
- (#AbstractMethod method_vars arguments return_type exs)]))))
+ (in [{#member_name name
+ #member_privacy pm
+ #member_anns annotations}
+ (#AbstractMethod method_vars arguments return_type exs)]))))
(def: native_method_def^
(Parser [Member_Declaration Method_Definition])
@@ -888,10 +888,10 @@
return_type (..return^ total_vars)
exs (throws_decl^ total_vars)
annotations ..annotations^]
- (wrap [{#member_name name
- #member_privacy pm
- #member_anns annotations}
- (#NativeMethod method_vars arguments return_type exs)]))))
+ (in [{#member_name name
+ #member_privacy pm
+ #member_anns annotations}
+ (#NativeMethod method_vars arguments return_type exs)]))))
(def: (method_def^ class_vars)
(-> (List (Type Var)) (Parser [Member_Declaration Method_Definition]))
@@ -911,10 +911,10 @@
(Parser Class_Kind)
(<>.either (do <>.monad
[_ (<code>.this! (' #class))]
- (wrap #Class))
+ (in #Class))
(do <>.monad
[_ (<code>.this! (' #interface))]
- (wrap #Interface))
+ (in #Interface))
))
(def: import_member_alias^
@@ -946,7 +946,7 @@
(<code>.form (do <>.monad
[_ (<code>.this! (' #enum))
enum_members (<>.some <code>.local_identifier)]
- (wrap (#EnumDecl enum_members))))
+ (in (#EnumDecl enum_members))))
(<code>.form (do <>.monad
[tvars (<>.default (list) ..vars^)
_ (<code>.identifier! ["" "new"])
@@ -955,20 +955,20 @@
?prim_mode (<>.maybe primitive_mode^)
args (..import_member_args^ total_vars)
[io? try? maybe?] import_member_return_flags^]
- (wrap (#ConstructorDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode)
- #import_member_alias (maybe.default "new" ?alias)
- #import_member_kind #VirtualIMK
- #import_member_tvars tvars
- #import_member_args args
- #import_member_maybe? maybe?
- #import_member_try? try?
- #import_member_io? io?}
- {}]))
+ (in (#ConstructorDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode)
+ #import_member_alias (maybe.default "new" ?alias)
+ #import_member_kind #VirtualIMK
+ #import_member_tvars tvars
+ #import_member_args args
+ #import_member_maybe? maybe?
+ #import_member_try? try?
+ #import_member_io? io?}
+ {}]))
))
(<code>.form (do <>.monad
[kind (: (Parser ImportMethodKind)
(<>.or (<code>.tag! ["" "static"])
- (wrap [])))
+ (in [])))
tvars (<>.default (list) ..vars^)
name <code>.local_identifier
?alias import_member_alias^
@@ -977,16 +977,16 @@
args (..import_member_args^ total_vars)
[io? try? maybe?] import_member_return_flags^
return (..return^ total_vars)]
- (wrap (#MethodDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode)
- #import_member_alias (maybe.default name ?alias)
- #import_member_kind kind
- #import_member_tvars tvars
- #import_member_args args
- #import_member_maybe? maybe?
- #import_member_try? try?
- #import_member_io? io?}
- {#import_method_name name
- #import_method_return return}]))))
+ (in (#MethodDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode)
+ #import_member_alias (maybe.default name ?alias)
+ #import_member_kind kind
+ #import_member_tvars tvars
+ #import_member_args args
+ #import_member_maybe? maybe?
+ #import_member_try? try?
+ #import_member_io? io?}
+ {#import_method_name name
+ #import_method_return return}]))))
(<code>.form (do <>.monad
[static? (<>.parses? (<code>.this! (' #static)))
name <code>.local_identifier
@@ -994,12 +994,12 @@
gtype (..type^ owner_vars)
maybe? (<>.parses? (<code>.this! (' #?)))
setter? (<>.parses? (<code>.this! (' #!)))]
- (wrap (#FieldAccessDecl {#import_field_mode (maybe.default #AutoPrM ?prim_mode)
- #import_field_name name
- #import_field_static? static?
- #import_field_maybe? maybe?
- #import_field_setter? setter?
- #import_field_type gtype}))))
+ (in (#FieldAccessDecl {#import_field_mode (maybe.default #AutoPrM ?prim_mode)
+ #import_field_name name
+ #import_field_static? static?
+ #import_field_maybe? maybe?
+ #import_field_setter? setter?
+ #import_field_type gtype}))))
))
(def: bundle
@@ -1136,13 +1136,13 @@
super_replacer (parser->replacer (<code>.form (do <>.monad
[_ (<code>.this! (' ::super!))
args (<code>.tuple (<>.exactly (list.size arguments) <code>.any))]
- (wrap (` ("jvm member invoke special"
- (~ (code.text (product.left (parser.read_class super_class))))
- (~ (code.text name))
- (~ (code.local_identifier self_name))
- (~+ (|> args
- (list.zipped/2 (list\map product.right arguments))
- (list\map ..decorate_input)))))))))]
+ (in (` ("jvm member invoke special"
+ (~ (code.text (product.left (parser.read_class super_class))))
+ (~ (code.text name))
+ (~ (code.local_identifier self_name))
+ (~+ (|> args
+ (list.zipped/2 (list\map product.right arguments))
+ (list\map ..decorate_input)))))))))]
(` ("override"
(~ (declaration$ declaration))
(~ (code.text name))
@@ -1248,14 +1248,14 @@
(|> methods
(list\map (method->parser fully_qualified_class_name))
(list\fold <>.either (<>.failure ""))))]]
- (wrap (list (` ("jvm class"
- (~ (declaration$ (type.declaration full_class_name class_vars)))
- (~ (class$ super))
- [(~+ (list\map class$ interfaces))]
- (~ (inheritance_modifier$ im))
- [(~+ (list\map annotation$ annotations))]
- [(~+ (list\map field_decl$ fields))]
- [(~+ (list\map (method_def$ fully_qualified_class_name method_parser super fields) methods))]))))))
+ (in (list (` ("jvm class"
+ (~ (declaration$ (type.declaration full_class_name class_vars)))
+ (~ (class$ super))
+ [(~+ (list\map class$ interfaces))]
+ (~ (inheritance_modifier$ im))
+ [(~+ (list\map annotation$ annotations))]
+ [(~+ (list\map field_decl$ fields))]
+ [(~+ (list\map (method_def$ fully_qualified_class_name method_parser super fields) methods))]))))))
(syntax: #export (interface:
{#let [! <>.monad]}
@@ -1267,11 +1267,11 @@
{#.doc (doc "Allows defining JVM interfaces."
(interface: TestInterface
([] foo [boolean String] void #throws [Exception])))}
- (wrap (list (` ("jvm class interface"
- (~ (declaration$ (type.declaration full_class_name class_vars)))
- [(~+ (list\map class$ supers))]
- [(~+ (list\map annotation$ annotations))]
- (~+ (list\map method_decl$ members)))))))
+ (in (list (` ("jvm class interface"
+ (~ (declaration$ (type.declaration full_class_name class_vars)))
+ [(~+ (list\map class$ supers))]
+ [(~+ (list\map annotation$ annotations))]
+ (~+ (list\map method_decl$ members)))))))
(syntax: #export (object
{class_vars ..vars^}
@@ -1292,17 +1292,17 @@
(exec (do_something some_value)
[])))
)}
- (wrap (list (` ("jvm class anonymous"
- [(~+ (list\map var$ class_vars))]
- (~ (class$ super))
- [(~+ (list\map class$ interfaces))]
- [(~+ (list\map constructor_arg$ constructor_args))]
- [(~+ (list\map (method_def$ "" (<>.failure "") super (list)) methods))])))))
+ (in (list (` ("jvm class anonymous"
+ [(~+ (list\map var$ class_vars))]
+ (~ (class$ super))
+ [(~+ (list\map class$ interfaces))]
+ [(~+ (list\map constructor_arg$ constructor_args))]
+ [(~+ (list\map (method_def$ "" (<>.failure "") super (list)) methods))])))))
(syntax: #export (null)
{#.doc (doc "Null object reference."
(null))}
- (wrap (list (` ("jvm object null")))))
+ (in (list (` ("jvm object null")))))
(def: #export (null? obj)
{#.doc (doc "Test for null object reference."
@@ -1320,10 +1320,10 @@
(= (??? "YOLO")
(#.Some "YOLO")))}
(with_gensyms [g!temp]
- (wrap (list (` (let [(~ g!temp) (~ expr)]
- (if ("jvm object null?" (~ g!temp))
- #.None
- (#.Some (~ g!temp)))))))))
+ (in (list (` (let [(~ g!temp) (~ expr)]
+ (if ("jvm object null?" (~ g!temp))
+ #.None
+ (#.Some (~ g!temp)))))))))
(syntax: #export (!!! expr)
{#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType."
@@ -1333,12 +1333,12 @@
(= "foo"
(!!! (??? "foo"))))}
(with_gensyms [g!value]
- (wrap (list (` ({(#.Some (~ g!value))
- (~ g!value)
+ (in (list (` ({(#.Some (~ g!value))
+ (~ g!value)
- #.None
- ("jvm object null")}
- (~ expr)))))))
+ #.None
+ ("jvm object null")}
+ (~ expr)))))))
(syntax: #export (check {class (..type^ (list))}
{unchecked (<>.maybe <code>.any)})
@@ -1357,14 +1357,14 @@
#.None))]
(case unchecked
(#.Some unchecked)
- (wrap (list (` (: (~ check_type)
- (let [(~ g!unchecked) (~ unchecked)]
- (~ check_code))))))
+ (in (list (` (: (~ check_type)
+ (let [(~ g!unchecked) (~ unchecked)]
+ (~ check_code))))))
#.None
- (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check_type))
- (function ((~ g!_) (~ g!unchecked))
- (~ check_code))))))
+ (in (list (` (: (-> (primitive "java.lang.Object") (~ check_type))
+ (function ((~ g!_) (~ g!unchecked))
+ (~ check_code))))))
))))
(syntax: #export (synchronized lock body)
@@ -1373,7 +1373,7 @@
(exec (do_something ___)
(do_something_else ___)
(finish_the_computation ___))))}
- (wrap (list (` ("jvm object synchronized" (~ lock) (~ body))))))
+ (in (list (` ("jvm object synchronized" (~ lock) (~ body))))))
(syntax: #export (do_to obj {methods (<>.some partial_call^)})
{#.doc (doc "Call a variety of methods on an object. Then, return the object."
@@ -1381,9 +1381,9 @@
(ClassName::method1 arg0 arg1 arg2)
(ClassName::method2 arg3 arg4 arg5)))}
(with_gensyms [g!obj]
- (wrap (list (` (let [(~ g!obj) (~ obj)]
- (exec (~+ (list\map (complete_call$ g!obj) methods))
- (~ g!obj))))))))
+ (in (list (` (let [(~ g!obj) (~ obj)]
+ (exec (~+ (list\map (complete_call$ g!obj) methods))
+ (~ g!obj))))))))
(def: (class_import$ declaration)
(-> (Type Declaration) Code)
@@ -1424,7 +1424,7 @@
(: (-> [Bit (Type Value)] (Meta [Bit Code]))
(function (_ [maybe? _])
(with_gensyms [arg_name]
- (wrap [maybe? arg_name]))))
+ (in [maybe? arg_name]))))
import_member_args)
#let [input_jvm_types (list\map product.right import_member_args)
arg_types (list\map (: (-> [Bit (Type Value)] Code)
@@ -1434,12 +1434,12 @@
(` (Maybe (~ arg_type)))
arg_type))))
import_member_args)]]
- (wrap [arg_inputs input_jvm_types arg_types])))
+ (in [arg_inputs input_jvm_types arg_types])))
_
- (\ meta.monad wrap [(list) (list) (list)])))
+ (\ meta.monad in [(list) (list) (list)])))
-(def: (decorate_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 _]))
@@ -1473,8 +1473,8 @@
_
return_term))]
- [decorate_return_try #import_member_try? (` (.try (~ return_term)))]
- [decorate_return_io #import_member_io? (` ((~! io.io) (~ return_term)))]
+ [with_return_try #import_member_try? (` (.try (~ return_term)))]
+ [with_return_io #import_member_io? (` ((~! io.io) (~ return_term)))]
)
(def: $String
@@ -1518,7 +1518,7 @@
_
(` (.|> (~ unboxed/boxed) (~+ post))))))]
- [#1 auto_convert_input ..unbox
+ [#1 with_automatic_input_conversion ..unbox
[[type.boolean type.boolean (list (` (.: .Bit)) (` (.:as (.primitive (~ (code.text box.boolean)))))) []]
[type.byte type.byte (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long))))) (` ..long_to_byte)) []]
[type.short type.short (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long))))) (` ..long_to_short)) []]
@@ -1530,7 +1530,7 @@
[(type.class box.boolean (list)) (type.class box.boolean (list)) (list (` (.: .Bit)) (` (.:as (.primitive (~ (code.text box.boolean)))))) []]
[(type.class box.long (list)) (type.class box.long (list)) (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long)))))) []]
[(type.class box.double (list)) (type.class box.double (list)) (list (` (.: .Frac)) (` (.:as (.primitive (~ (code.text box.double)))))) []]]]
- [#0 auto_convert_output ..box
+ [#0 with_automatic_output_conversion ..box
[[type.boolean type.boolean (list) [(` (.: (.primitive (~ (code.text box.boolean))))) (` (.:as .Bit))]]
[type.byte type.long (list (` "jvm conversion byte-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:as .Int))]]
[type.short type.long (list (` "jvm conversion short-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:as .Int))]]
@@ -1558,7 +1558,7 @@
((~! !!!) (~ (un_quote input)))))
(un_quote input))
[class]
- (auto_convert_input mode))))))
+ (with_automatic_input_conversion mode))))))
(def: (import_name format class member)
(-> Text Text Text Text)
@@ -1586,7 +1586,7 @@
(` (def: (~ getter_name)
(~ enum_type)
(~ (get_static_field full_name name)))))))]]
- (wrap (list\map getter_interop enum_members)))
+ (in (list\map getter_interop enum_members)))
(#ConstructorDecl [commons _])
(do meta.monad
@@ -1600,12 +1600,12 @@
(~+ (|> (jvm_invoke_inputs (get@ #import_member_mode commons) input_jvm_types arg_function_inputs)
(list.zipped/2 input_jvm_types)
(list\map ..decorate_input)))))]
- (auto_convert_output (get@ #import_member_mode commons))
- (decorate_return_maybe member true classT)
- (decorate_return_try member)
- (decorate_return_io member))]]
- (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)))
- ((~' wrap) (.list (.` (~ jvm_interop)))))))))
+ (with_automatic_output_conversion (get@ #import_member_mode commons))
+ (with_return_maybe member true classT)
+ (with_return_try member)
+ (with_return_io member))]]
+ (in (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)))
+ ((~' in) (.list (.` (~ jvm_interop)))))))))
(#MethodDecl [commons method])
(with_gensyms [g!obj]
@@ -1639,7 +1639,7 @@
(~+ (|> object_ast
(list\map ..un_quote)
(list.zipped/2 (list (type.class full_name (list))))
- (list\map (auto_convert_input (get@ #import_member_mode commons)))))
+ (list\map (with_automatic_input_conversion (get@ #import_member_mode commons)))))
(~+ (|> (jvm_invoke_inputs (get@ #import_member_mode commons) input_jvm_types arg_function_inputs)
(list.zipped/2 input_jvm_types)
(list\map ..decorate_input))))))
@@ -1648,18 +1648,18 @@
(#.Left method_return)
(|> [method_return
callC]
- (auto_convert_output (get@ #import_member_mode commons))
- (decorate_return_maybe member false method_return)
- (decorate_return_try member)
- (decorate_return_io member))
+ (with_automatic_output_conversion (get@ #import_member_mode commons))
+ (with_return_maybe member false method_return)
+ (with_return_try member)
+ (with_return_io member))
(#.Right method_return)
(|> callC
- (decorate_return_try member)
- (decorate_return_io member))))]]
- (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast))
- ((~' wrap) (.list (.` (~ jvm_interop))))))))))
+ (with_return_try member)
+ (with_return_io member))))]]
+ (in (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast))
+ ((~' in) (.list (.` (~ jvm_interop))))))))))
(#FieldAccessDecl fad)
(do meta.monad
@@ -1670,7 +1670,7 @@
(let [getter_call (if import_field_static?
(` ((~ getter_name)))
(` ((~ getter_name) (~ g!obj))))
- getter_body (<| (auto_convert_output import_field_mode)
+ getter_body (<| (with_automatic_output_conversion import_field_mode)
[import_field_type
(if import_field_static?
(get_static_field full_name import_field_name)
@@ -1681,8 +1681,8 @@
getter_body (if import_field_setter?
(` ((~! io.io) (~ getter_body)))
getter_body)]
- (wrap (` ((~! syntax:) (~ getter_call)
- ((~' wrap) (.list (.` (~ getter_body)))))))))
+ (in (` ((~! syntax:) (~ getter_call)
+ ((~' in) (.list (.` (~ getter_body)))))))))
setter_interop (: (Meta (List Code))
(if import_field_setter?
(with_gensyms [g!obj g!value]
@@ -1690,7 +1690,7 @@
(` ((~ setter_name) (~ g!value)))
(` ((~ setter_name) (~ g!value) (~ g!obj))))
setter_value (|> [import_field_type (un_quote g!value)]
- (auto_convert_input import_field_mode))
+ (with_automatic_input_conversion import_field_mode))
setter_value (if import_field_maybe?
(` ((~! !!!) (~ setter_value)))
setter_value)
@@ -1700,10 +1700,10 @@
(if import_field_static?
(list)
(list (un_quote g!obj))))]
- (wrap (list (` ((~! syntax:) (~ setter_call)
- ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value))))))))))))
- (wrap (list))))]
- (wrap (list& getter_interop setter_interop)))
+ (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)))
)))
(def: (member_import$ vars kind class [import_format member])
@@ -1733,9 +1733,9 @@
(let [[class_name _] (parser.declaration declaration)]
(case (load_class class_name)
(#.Right class)
- (\ meta.monad wrap (if (interface? class)
- #Interface
- #Class))
+ (\ meta.monad in (if (interface? class)
+ #Interface
+ #Class))
(#.Left _)
(meta.failure (format "Unknown class: " class_name)))))
@@ -1802,7 +1802,7 @@
(list\map (|>> [import_format]) members)))
list.concat
(monad.map ! (member_import$ class_type_vars kind declaration)))]
- (wrap (list& (class_import$ declaration) (list\join =members)))))
+ (in (list& (class_import$ declaration) (list\join =members)))))
(syntax: #export (array {type (..type^ (list))}
size)
@@ -1815,7 +1815,7 @@
"jvm conversion long-to-int"))]
(`` (cond (~~ (template [<primitive> <array_op>]
[(\ type.equivalence = <primitive> type)
- (wrap (list (` (<array_op> (~ g!size)))))]
+ (in (list (` (<array_op> (~ g!size)))))]
[type.boolean "jvm array new boolean"]
[type.byte "jvm array new byte"]
@@ -1826,8 +1826,8 @@
[type.double "jvm array new double"]
[type.char "jvm array new char"]))
## else
- (wrap (list (` (: (~ (value_type #ManualPrM (type.array type)))
- ("jvm array new object" (~ g!size))))))))))
+ (in (list (` (: (~ (value_type #ManualPrM (type.array type)))
+ ("jvm array new object" (~ g!size))))))))))
(exception: #export (cannot_convert_to_jvm_type {type .Type})
(exception.report
@@ -1837,14 +1837,14 @@
(def: (lux_type->jvm_type type)
(-> .Type (Meta (Type Value)))
(if (lux_type\= .Any type)
- (\ meta.monad wrap $Object)
+ (\ meta.monad in $Object)
(case type
(#.Primitive name params)
(`` (cond (~~ (template [<type>]
[(text\= (..reflection <type>) name)
(case params
#.Nil
- (\ meta.monad wrap <type>)
+ (\ meta.monad in <type>)
_
<failure>)]
@@ -1862,7 +1862,7 @@
[(text\= (..reflection (type.array <type>)) name)
(case params
#.Nil
- (\ meta.monad wrap (type.array <type>))
+ (\ meta.monad in (type.array <type>))
_
<failure>)]
@@ -1904,7 +1904,7 @@
[paramJT (lux_type->jvm_type paramLT)]
(case (parser.parameter? paramJT)
(#.Some paramJT)
- (wrap paramJT)
+ (in paramJT)
#.None
<failure>)))
@@ -1930,7 +1930,7 @@
(case array
[_ (#.Identifier array_name)]
(do meta.monad
- [array_type (meta.find_type array_name)
+ [array_type (meta.type array_name)
array_jvm_type (lux_type->jvm_type array_type)
#let [g!extension (code.text (`` (cond (~~ (template [<primitive> <extension>]
[(\ type.equivalence =
@@ -1949,16 +1949,16 @@
## else
"jvm array length object")))]]
- (wrap (list (` (.|> ((~ g!extension) (~ array))
- "jvm conversion int-to-long"
- "jvm object cast"
- (.: (.primitive (~ (code.text box.long))))
- (.:as .Nat))))))
+ (in (list (` (.|> ((~ g!extension) (~ array))
+ "jvm conversion int-to-long"
+ "jvm object cast"
+ (.: (.primitive (~ (code.text box.long))))
+ (.:as .Nat))))))
_
(with_gensyms [g!array]
- (wrap (list (` (let [(~ g!array) (~ array)]
- (..array_length (~ g!array)))))))))
+ (in (list (` (let [(~ g!array) (~ array)]
+ (..array_length (~ g!array)))))))))
(syntax: #export (array_read idx array)
{#.doc (doc "Loads an element from an array."
@@ -1966,7 +1966,7 @@
(case array
[_ (#.Identifier array_name)]
(do meta.monad
- [array_type (meta.find_type array_name)
+ [array_type (meta.type array_name)
array_jvm_type (lux_type->jvm_type array_type)
#let [g!idx (` (.|> (~ idx)
(.: .Nat)
@@ -1977,9 +1977,9 @@
[(\ type.equivalence =
(type.array <primitive>)
array_jvm_type)
- (wrap (list (` (.|> (<extension> (~ g!idx) (~ array))
- "jvm object cast"
- (.: (.primitive (~ (code.text <box>))))))))]
+ (in (list (` (.|> (<extension> (~ g!idx) (~ array))
+ "jvm object cast"
+ (.: (.primitive (~ (code.text <box>))))))))]
[type.boolean "jvm array read boolean" box.boolean]
[type.byte "jvm array read byte" box.byte]
@@ -1991,12 +1991,12 @@
[type.char "jvm array read char" box.char]))
## else
- (wrap (list (` ("jvm array read object" (~ g!idx) (~ array))))))))
+ (in (list (` ("jvm array read object" (~ g!idx) (~ array))))))))
_
(with_gensyms [g!array]
- (wrap (list (` (let [(~ g!array) (~ array)]
- (..array_read (~ idx) (~ g!array)))))))))
+ (in (list (` (let [(~ g!array) (~ array)]
+ (..array_read (~ idx) (~ g!array)))))))))
(syntax: #export (array_write idx value array)
{#.doc (doc "Stores an element into an array."
@@ -2004,7 +2004,7 @@
(case array
[_ (#.Identifier array_name)]
(do meta.monad
- [array_type (meta.find_type array_name)
+ [array_type (meta.type array_name)
array_jvm_type (lux_type->jvm_type array_type)
#let [g!idx (` (.|> (~ idx)
(.: .Nat)
@@ -2018,7 +2018,7 @@
(let [g!value (` (.|> (~ value)
(.:as (.primitive (~ (code.text <box>))))
"jvm object cast"))]
- (wrap (list (` (<extension> (~ g!idx) (~ g!value) (~ array))))))]
+ (in (list (` (<extension> (~ g!idx) (~ g!value) (~ array))))))]
[type.boolean "jvm array write boolean" box.boolean]
[type.byte "jvm array write byte" box.byte]
@@ -2030,20 +2030,20 @@
[type.char "jvm array write char" box.char]))
## else
- (wrap (list (` ("jvm array write object" (~ g!idx) (~ value) (~ array))))))))
+ (in (list (` ("jvm array write object" (~ g!idx) (~ value) (~ array))))))))
_
(with_gensyms [g!array]
- (wrap (list (` (let [(~ g!array) (~ array)]
- (..array_write (~ idx) (~ value) (~ g!array)))))))))
+ (in (list (` (let [(~ g!array) (~ array)]
+ (..array_write (~ idx) (~ value) (~ g!array)))))))))
(syntax: #export (class_for {type (..type^ (list))})
{#.doc (doc "Loads the class as a java.lang.Class object."
(class_for java/lang/String))}
- (wrap (list (` ("jvm object class" (~ (code.text (..reflection type))))))))
+ (in (list (` ("jvm object class" (~ (code.text (..reflection type))))))))
(syntax: #export (type {type (..type^ (list))})
- (wrap (list (..value_type #ManualPrM type))))
+ (in (list (..value_type #ManualPrM type))))
(exception: #export (cannot_cast_to_non_object {type (Type Value)})
(exception.report
@@ -2055,8 +2055,8 @@
(case [(parser.array? type)
(parser.class? type)]
(^or [(#.Some _) _] [_ (#.Some _)])
- (wrap (list (` (.: (~ (..value_type #ManualPrM type))
- ("jvm object cast" (~ object))))))
+ (in (list (` (.: (~ (..value_type #ManualPrM type))
+ ("jvm object cast" (~ object))))))
_
(meta.failure (exception.construct ..cannot_cast_to_non_object [type]))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-07 19:17:30 +0000