aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/ffi.old.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/library/lux/ffi.old.lux')
-rw-r--r--stdlib/source/library/lux/ffi.old.lux220
1 files changed, 110 insertions, 110 deletions
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)))
)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-04 23:50:27 +0000