From ac2c19d93407b00c89513f0f81e9cbbd1425bd9a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 9 Mar 2022 03:35:16 -0400 Subject: Added an easy way to export Lux functionality to host programs (in JVM). --- changelog.md | 6 +- lux-mode/lux-mode.el | 2 +- stdlib/source/library/lux/ffi.jvm.lux | 135 ++++++++++++++--- stdlib/source/library/lux/static.lux | 2 + stdlib/source/library/lux/target/jvm/bytecode.lux | 19 ++- .../language/lux/phase/extension/analysis/jvm.lux | 96 ++++++------ .../language/lux/phase/extension/directive/jvm.lux | 12 +- .../lux/phase/extension/generation/jvm/host.lux | 152 ++++++++----------- .../library/lux/tool/compiler/meta/packager.lux | 2 +- .../lux/tool/compiler/meta/packager/jvm.lux | 17 ++- stdlib/source/program/compositor.lux | 5 +- stdlib/source/test/lux/ffi.jvm.lux | 167 ++++++++++++++++++++- 12 files changed, 439 insertions(+), 176 deletions(-) diff --git a/changelog.md b/changelog.md index 688793326..ddfd14d9a 100644 --- a/changelog.md +++ b/changelog.md @@ -4,9 +4,11 @@ ### Added * Inline functions. * Can pass configuration parameters from the build description to the compiler. -* Can select code based on configuration parameters. -* Can select code based on compiler version. +* Code selection based on configuration parameters. +* Code selection based on compiler version. +* Extensible meta-compiler. ### Changed +* JVM compilation no longer relies on the ASM library. ### Removed ### Fixed ### Deprecated diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index ee5050d47..016c0170c 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -393,7 +393,7 @@ Called by `imenu--generic-function'." (code//template (altRE "template" "template:")) ;; Miscellaneous (actor (altRE "actor:" "message:" "actor")) - (jvm-host (altRE "class:" "interface:" "import:" "object" "do_to" "synchronized" "class_for")) + (jvm-host (altRE "import:" "export:" "class:" "interface:" "object" "do_to" "synchronized" "class_for")) (alternative-format (altRE "char" "bin" "oct" "hex")) (documentation (altRE "comment" "documentation:")) (function-application (altRE "|>" "<|" "_\\$" "\\$_")) diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index f5f804fee..a93701270 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -1,6 +1,6 @@ (.using [library - ["[0]" lux {"-" Primitive Type type int char :as} + ["[0]" lux {"-" Primitive Type type int char :as function} ["[0]" meta] [abstract ["[0]" monad {"+" Monad do}] @@ -230,7 +230,7 @@ (type: FieldDecl (Variant {#ConstantField (Type Value) Code} - {#VariableField State (Type Value)})) + {#VariableField [State Bit (Type Value)]})) (type: MethodDecl (Record @@ -624,7 +624,7 @@ (def: (parameter^ type_vars) (-> (List (Type Var)) (Parser (Type Parameter))) (<>.rec - (function (_ _) + (.function (_ _) (let [class^ (..class^' parameter^ type_vars)] ($_ <>.either (..type_variable type_vars) @@ -663,7 +663,7 @@ (def: (type^ type_vars) (-> (List (Type Var)) (Parser (Type Value))) (<>.rec - (function (_ type^) + (.function (_ type^) ($_ <>.either ..primitive^ (..parameter^ type_vars) @@ -764,10 +764,11 @@ (.form (do <>.monad [pm privacy_modifier^ sm state_modifier^ + static? (<>.parses? (.this! (' "static"))) name .local_symbol anns ..annotations^ type (..type^ type_vars)] - (in [[name pm anns] {#VariableField [sm type]}]))))) + (in [[name pm anns] {#VariableField [sm static? type]}]))))) (def: (argument^ type_vars) (-> (List (Type Var)) (Parser Argument)) @@ -790,7 +791,7 @@ (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition])) (.form (do <>.monad [pm privacy_modifier^ - strict_fp? (<>.parses? (.this! (' "strict"))) + strict_fp? (<>.parses? (.text! "strict")) method_vars (<>.else (list) ..vars^) .let [total_vars (list#composite class_vars method_vars)] [_ self_name arguments] (.form ($_ <>.and @@ -1057,9 +1058,9 @@ [(~+ (list#each value$ #method_inputs))] (~ (return$ #method_output)))))) -(def: (state_modifier$ sm) +(def: (state_modifier$ it) (-> State Code) - (case sm + (case it {#VolatileS} (' "volatile") {#FinalS} (' "final") {#DefaultS} (' "default"))) @@ -1074,10 +1075,13 @@ (~ value) )) - {#VariableField sm class} + {#VariableField [state static? class]} (` ("variable" (~ (code.text name)) (~ (privacy_modifier$ pm)) - (~ (state_modifier$ sm)) + (~ (state_modifier$ state)) + (~+ (if static? + (list (' "static")) + (list))) [(~+ (list#each annotation$ anns))] (~ (value$ class)) )) @@ -1293,7 +1297,7 @@ {.#None} (in (list (` (: (-> (.Primitive "java.lang.Object") (~ check_type)) - (function ((~ g!_) (~ g!unchecked)) + (.function ((~ g!_) (~ g!unchecked)) (~ check_code)))))) )))) @@ -1345,13 +1349,13 @@ (do [! meta.monad] [arg_inputs (monad.each ! (: (-> [Bit (Type Value)] (Meta [Bit Code])) - (function (_ [maybe? _]) + (.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 (: (-> [Bit (Type Value)] Code) - (function (_ [maybe? arg]) + (.function (_ [maybe? arg]) (let [arg_type (value_type (value@ #import_member_mode commons) arg)] (if maybe? (` (Maybe (~ arg_type))) @@ -1444,6 +1448,7 @@ [type.short (list (` (.:as (.Primitive (~ (code.text box.short)))))) []] [type.int (list (` (.: (.Primitive (~ (code.text box.int)))))) []] [type.long (list (` (.:as (.Primitive (~ (code.text box.long)))))) []] + [type.char (list (` (.:as (.Primitive (~ (code.text box.char)))))) []] [type.float (list (` (.:as (.Primitive (~ (code.text box.float)))))) []] [type.double (list (` (.:as (.Primitive (~ (code.text box.double)))))) []]]] [#0 with_automatic_output_conversion ..box @@ -1452,6 +1457,7 @@ [type.short (list) [(` (.: (.Primitive (~ (code.text box.short)))))]] [type.int (list) [(` (.: (.Primitive (~ (code.text box.int)))))]] [type.long (list) [(` (.: (.Primitive (~ (code.text box.long)))))]] + [type.char (list) [(` (.: (.Primitive (~ (code.text box.char)))))]] [type.float (list) [(` (.: (.Primitive (~ (code.text box.float)))))]] [type.double (list) [(` (.: (.Primitive (~ (code.text box.double)))))]]]] ) @@ -1464,7 +1470,7 @@ (-> Primitive_Mode (List (Type Value)) (List [Bit Code]) (List Code)) (|> inputs (list.zipped/2 classes) - (list#each (function (_ [class [maybe? input]]) + (list#each (.function (_ [class [maybe? input]]) (|> (if maybe? (` (: (.Primitive (~ (code.text (..reflection class)))) ((~! !!!) (~ (..un_quoted input))))) @@ -1480,7 +1486,7 @@ (def: syntax_inputs (-> (List Code) (List Code)) - (|>> (list#each (function (_ name) + (|>> (list#each (.function (_ name) (list name (` (~! .any))))) list#conjoint)) @@ -1501,7 +1507,7 @@ (` (All ((~ g!_) (~+ =class_tvars)) (.Primitive (~ (code.text full_name)) [(~+ =class_tvars)])))))) getter_interop (: (-> Text Code) - (function (_ name) + (.function (_ name) (let [getter_name (code.symbol ["" (..import_name import_format method_prefix name)])] (` (def: (~ getter_name) (~ enum_type) @@ -1668,7 +1674,7 @@ (do [! meta.monad] [kind (class_kind declaration) =members (|> bundles - (list#each (function (_ [import_format members]) + (list#each (.function (_ [import_format members]) (list#each (|>> [import_format]) members))) list.together (monad.each ! (member_import$ class_type_vars kind declaration)))] @@ -1767,7 +1773,7 @@ (# meta.monad each (type.class name) (: (Meta (List (Type Parameter))) (monad.each meta.monad - (function (_ paramLT) + (.function (_ paramLT) (do meta.monad [paramJT (lux_type->jvm_type context paramLT)] (case (parser.parameter? paramJT) @@ -1961,3 +1967,96 @@ [as_char .Int ..long_to_char ..Long ..char_to_long ..Character of_char] [as_float .Frac ..double_to_float ..Double ..float_to_double ..Float of_float] ) + +(type: (API of) + (Record + [#interface of + #type Code + #term Code])) + +(def: (api of) + (All (_ of) (-> (Parser of) (Parser (API of)))) + (.form + ($_ <>.and + of + .any + .any + ))) + +(type: Constant + Text) + +(def: constant + (Parser Constant) + .local_symbol) + +(type: Function + (Record + [#variables (List Text) + #name Text + #requirements (List [Text Code])])) + +(def: function + (Parser Function) + (.form + ($_ <>.and + (<>.else (list) (.tuple (<>.some .local_symbol))) + .local_symbol + (.tuple (<>.some ($_ <>.and + .local_symbol + .any + ))) + ))) + +(type: Export + (Variant + {#Constant (API Constant)} + {#Function (API Function)})) + +(def: export + (Parser Export) + ($_ <>.or + (..api ..constant) + (..api ..function) + )) + +(syntax: .public (export: [api .local_symbol + exports (<>.many ..export)]) + (let [initialization (: (List (API Constant)) + (list.all (.function (_ it) + (case it + {#Constant it} + {.#Some it} + + _ + {.#None})) + exports))] + (in (list (` (..class: "final" (~ (code.local_symbol api)) + (~+ (list#each (.function (_ it) + (case it + {#Constant [name type term]} + (` ("public" "final" "static" (~ (code.local_symbol name)) (~ type))) + + {#Function [[variables name requirements] type term]} + (` ("public" "strict" "static" + [(~+ (list#each code.local_symbol variables))] + ((~ (code.local_symbol name)) + [(~+ (|> requirements + (list#each (.function (_ [name type]) + (list (code.local_symbol name) + type))) + list#conjoint))]) + (~ type) + (~ term))))) + exports)) + ... Useless constructor + ("private" [] ((~' new) (~' self) []) [] []) + ("public" "strict" "static" [] ((~' ) []) + (~' void) + [(~+ (list#each (.function (_ [name type term]) + (` ("jvm member put static" + (~ (code.text api)) + (~ (code.text name)) + ("jvm object cast" (~ term))))) + initialization))]) + )))))) diff --git a/stdlib/source/library/lux/static.lux b/stdlib/source/library/lux/static.lux index 9bb38bd1d..6de030bee 100644 --- a/stdlib/source/library/lux/static.lux +++ b/stdlib/source/library/lux/static.lux @@ -23,6 +23,7 @@ (|>> (:as ) list) (meta.eval expression)))] + [bit .Bit code.bit] [nat .Nat code.nat] [int .Int code.int] [rev .Rev code.rev] @@ -64,6 +65,7 @@ )]] (in (list ( result)))))] + [random_bit random.bit code.bit] [random_nat random.nat code.nat] [random_int random.int code.int] [random_rev random.rev code.rev] diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index 4cdd42299..55e9fa71f 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -1102,9 +1102,24 @@ (..bytecode $1 @_ <1> [index]))))] [$0 getstatic _.getstatic/1 _.getstatic/2] - [$1 putstatic _.putstatic/1 _.putstatic/2] [$1 getfield _.getfield/1 _.getfield/2] - [$2 putfield _.putfield/1 _.putfield/2] + ) + +(template [ <1> <2>] + [(def: .public ( class field type) + (-> (Type Class) Text (Type Value) (Bytecode Any)) + (do [! ..monad] + [index (<| ..lifted + (//constant/pool.field (..reflection class)) + [//constant/pool.#name field + //constant/pool.#descriptor (type.descriptor type)])] + (if (or (same? type.long type) + (same? type.double type)) + (..bytecode $0 @_ <2> [index]) + (..bytecode $0 @_ <1> [index]))))] + + [putstatic $1 _.putstatic/1 $2 _.putstatic/2] + [putfield $2 _.putfield/1 $3 _.putfield/2] ) (exception: .public (invalid_range_for_try [start Address diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 8e12692c9..ea13344ed 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -917,7 +917,7 @@ (function (_ superJT) (do ! [superJT (phase.lifted (reflection!.type superJT)) - .let [super_name (|> superJT ..reflection)] + .let [super_name (..reflection superJT)] super_class (phase.lifted (reflection!.load class_loader super_name)) superT (reflection_type mapping superJT)] (in [[super_name superT] (java/lang/Class::isAssignableFrom super_class target_class)]))) @@ -1042,7 +1042,7 @@ (in (<| {/////analysis.#Extension extension_name} (list (/////analysis.text class) (/////analysis.text field) - (/////analysis.text (|> fieldJT ..reflection)))))))])) + (/////analysis.text (..signature fieldJT)))))))])) (def: (put::static class_loader) (-> java/lang/ClassLoader Handler) @@ -1058,14 +1058,15 @@ (reflection!.static_field field class))) _ (phase.assertion ..deprecated_field [class field] (not deprecated?)) - _ (phase.assertion ..cannot_set_a_final_field [class field] - (not final?)) + ... _ (phase.assertion ..cannot_set_a_final_field [class field] + ... (not final?)) fieldT (reflection_type luxT.fresh fieldJT) valueA (<| (typeA.expecting fieldT) (analyse archive valueC))] (in (<| {/////analysis.#Extension extension_name} (list (/////analysis.text class) (/////analysis.text field) + (/////analysis.text (..signature fieldJT)) valueA)))))])) (def: (get::virtual class_loader) @@ -1090,7 +1091,7 @@ (in (<| {/////analysis.#Extension extension_name} (list (/////analysis.text class) (/////analysis.text field) - (/////analysis.text (..reflection fieldJT)) + (/////analysis.text (..signature fieldJT)) objectA)))))])) (def: (put::virtual class_loader) @@ -1119,7 +1120,7 @@ (in (<| {/////analysis.#Extension extension_name} (list (/////analysis.text class) (/////analysis.text field) - (/////analysis.text (..reflection fieldJT)) + (/////analysis.text (..signature fieldJT)) valueA objectA)))))])) @@ -1775,6 +1776,14 @@ (type: Exception (Type Class)) +(def: .public parameter_types + (-> (List (Type Var)) (Check (List [(Type Var) .Type]))) + (monad.each check.monad + (function (_ parameterJ) + (do check.monad + [[_ parameterT] check.existential] + (in [parameterJ parameterT]))))) + (type: .public (Abstract_Method a) [Text Visibility @@ -1799,11 +1808,24 @@ ..return (.tuple (<>.some ..class))))) +(def: (method_mapping of_class parameters) + (-> Mapping (List (Type Var)) (Check Mapping)) + (|> parameters + ..parameter_types + (check#each (list#mix (function (_ [parameterJ parameterT] mapping) + (dictionary.has (parser.name parameterJ) parameterT mapping)) + of_class)))) + +(def: class_mapping + (-> (List (Type Var)) (Check Mapping)) + (..method_mapping luxT.fresh)) + (def: .public (analyse_abstract_method analyse archive method) (-> Phase Archive (Abstract_Method Code) (Operation Analysis)) (let [[method_name visibility annotations vars arguments return exceptions] method] (do [! phase.monad] - [annotationsA (monad.each ! (function (_ [name parameters]) + [mapping (typeA.check (method_mapping luxT.fresh vars)) + annotationsA (monad.each ! (function (_ [name parameters]) (do ! [parametersA (monad.each ! (function (_ [name value]) (do ! @@ -1856,7 +1878,8 @@ annotations vars exceptions self_name arguments super_arguments body] method] (do [! phase.monad] - [annotationsA (monad.each ! (function (_ [name parameters]) + [mapping (typeA.check (method_mapping mapping vars)) + annotationsA (monad.each ! (function (_ [name parameters]) (do ! [parametersA (monad.each ! (function (_ [name value]) (do ! @@ -1959,7 +1982,8 @@ self_name arguments return exceptions body] method] (do [! phase.monad] - [annotationsA (monad.each ! (function (_ [name parameters]) + [mapping (typeA.check (method_mapping mapping vars)) + annotationsA (monad.each ! (function (_ [name parameters]) (do ! [parametersA (monad.each ! (function (_ [name value]) (do ! @@ -1968,7 +1992,7 @@ parameters)] (in [name parametersA]))) annotations) - returnT (reflection_return mapping return) + :return: (boxed_reflection_return mapping return) arguments' (monad.each ! (function (_ [name jvmT]) (do ! @@ -1979,7 +2003,7 @@ {.#Item [self_name selfT]} list.reversed (list#mix scope.with_local (analyse archive body)) - (typeA.expecting returnT) + (typeA.expecting :return:) scope.with)] (in (/////analysis.tuple (list (/////analysis.text ..virtual_tag) (/////analysis.text method_name) @@ -2033,7 +2057,8 @@ arguments return exceptions body] method] (do [! phase.monad] - [annotationsA (monad.each ! (function (_ [name parameters]) + [mapping (typeA.check (method_mapping mapping vars)) + annotationsA (monad.each ! (function (_ [name parameters]) (do ! [parametersA (monad.each ! (function (_ [name value]) (do ! @@ -2042,7 +2067,7 @@ parameters)] (in [name parametersA]))) annotations) - returnT (reflection_return mapping return) + :return: (boxed_reflection_return mapping return) arguments' (monad.each ! (function (_ [name jvmT]) (do ! @@ -2052,7 +2077,7 @@ [scope bodyA] (|> arguments' list.reversed (list#mix scope.with_local (analyse archive body)) - (typeA.expecting returnT) + (typeA.expecting :return:) scope.with)] (in (/////analysis.tuple (list (/////analysis.text ..static_tag) (/////analysis.text method_name) @@ -2141,19 +2166,6 @@ {.#None} (phase.lifted (exception.except ..unknown_super [parent_name supers]))))) -(def: .public (with_fresh_type_vars vars mapping) - (-> (List (Type Var)) Mapping (Operation Mapping)) - (do [! phase.monad] - [pairings (monad.each ! (function (_ var) - (do ! - [[_ exT] (typeA.check check.existential)] - (in [var exT]))) - vars)] - (in (list#mix (function (_ [varJ :var:] mapping) - (dictionary.has (parser.name varJ) :var: mapping)) - mapping - pairings)))) - (def: .public (with_override_mapping supers parent_type mapping) (-> (List (Type Class)) (Type Class) Mapping (Operation Mapping)) (do phase.monad @@ -2203,7 +2215,7 @@ body] method] (do [! phase.monad] [mapping (..with_override_mapping supers parent_type mapping) - mapping (..with_fresh_type_vars vars mapping) + mapping (typeA.check (method_mapping mapping vars)) annotationsA (monad.each ! (function (_ [name parameters]) (do ! [parametersA (monad.each ! (function (_ [name value]) @@ -2219,12 +2231,12 @@ [luxT (boxed_reflection_type mapping jvmT)] (in [name luxT]))) arguments) - returnT (boxed_reflection_return mapping return) + :return: (boxed_reflection_return mapping return) [scope bodyA] (|> arguments' {.#Item [self_name selfT]} list.reversed (list#mix scope.with_local (analyse archive body)) - (typeA.expecting returnT) + (typeA.expecting :return:) scope.with)] (in (/////analysis.tuple (list (/////analysis.text ..overriden_tag) (class_analysis parent_type) @@ -2243,14 +2255,6 @@ (..hidden_method_body (list.size arguments) bodyA)} )))))) -(def: .public parameter_types - (-> (List (Type Var)) (Check (List [(Type Var) .Type]))) - (monad.each check.monad - (function (_ parameterJ) - (do check.monad - [[_ parameterT] check.existential] - (in [parameterJ parameterT]))))) - (def: (matched? [sub sub_method subJT] [super super_method superJT]) (-> [(Type Class) Text (Type Method)] [(Type Class) Text (Type Method)] Bit) (and (# descriptor.equivalence = (jvm.descriptor super) (jvm.descriptor sub)) @@ -2445,10 +2449,10 @@ ... jvm.boolean jvm.byte jvm.short jvm.int jvm.char _.iconst_0))) -(def: (mock_return returnT) +(def: (mock_return :return:) (-> (Type Return) (Bytecode Any)) - (case (jvm.void? returnT) - {.#Right returnT} + (case (jvm.void? :return:) + {.#Right :return:} _.return {.#Left valueT} @@ -2591,14 +2595,8 @@ (list#each (|>> {#Overriden_Method}) methods))) ... Necessary for reflection to work properly during analysis. _ (phase.lifted (# host execute mock)) - - parameters (typeA.check (..parameter_types parameters)) - .let [mapping (list#mix (function (_ [parameterJ parameterT] mapping) - (dictionary.has (parser.name parameterJ) - parameterT - mapping)) - luxT.fresh - parameters)] + + mapping (typeA.check (..class_mapping parameters)) super_classT (typeA.check (luxT.check (luxT.class mapping) (..signature super_class))) super_interfaceT+ (typeA.check (monad.each check.monad (|>> ..signature (luxT.check (luxT.class mapping))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index 27b3cf9d2..3374c4ba4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -167,7 +167,7 @@ ))) (type: Variable - [Text (Modifier field.Field) (Modifier field.Field) (List Annotation) (Type Value)]) + [Text (Modifier field.Field) (Modifier field.Field) Bit (List Annotation) (Type Value)]) (def: variable (Parser Variable) @@ -177,6 +177,7 @@ .text ..visibility ..state + (<>.parses? (.text! jvm.static_tag)) (.tuple (<>.some ..annotation)) ..field_type ))) @@ -250,8 +251,13 @@ (undefined)) ... TODO: Handle annotations. - {#Variable [name visibility state annotations type]} - (field.field (modifier#composite visibility state) + {#Variable [name visibility state static? annotations type]} + (field.field ($_ modifier#composite + (if static? + field.static + modifier.empty) + visibility + state) name #1 type sequence.empty))) (def: annotation_parameter_synthesis diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index cb078ad43..4fbc7e603 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -351,9 +351,19 @@ [return Return parser.return] ) +(def: reflection + (All (_ category) + (-> (Type (<| Return' Value' category)) Text)) + (|>> type.reflection reflection.reflection)) + +(def: signature + (All (_ category) + (-> (Type category) Text)) + (|>> type.signature signature.signature)) + (exception: .public (not_an_object_array [arrayJT (Type Array)]) (exception.report - ["JVM Type" (|> arrayJT type.signature signature.signature)])) + ["JVM Type" (..signature arrayJT)])) (def: .public object_array (Parser (Type Object)) @@ -589,11 +599,6 @@ (_.instanceof (type.class class (list))) (///value.wrap type.boolean)))))])) -(def: reflection - (All (_ category) - (-> (Type (<| Return' Value' category)) Text)) - (|>> type.reflection reflection.reflection)) - (def: object::cast Handler (..custom @@ -601,32 +606,27 @@ (function (_ extension_name generate archive [from to valueS]) (do //////.monad [valueG (generate archive valueS)] - (in (`` (cond (~~ (template [ ] - [(and (text#= (..reflection ) - from) - (text#= - to)) - (let [$ (type.class (list))] - ($_ _.composite - valueG - (///value.wrap ))) - - (and (text#= - from) - (text#= (..reflection ) - to)) + (in (`` (cond (~~ (template [ ] + [(and (text#= (..reflection ) from) + (text#= to)) + ($_ _.composite + valueG + (///value.wrap )) + + (and (text#= from) + (text#= (..reflection ) to)) ($_ _.composite valueG (///value.unwrap ))] - [box.boolean type.boolean "booleanValue"] - [box.byte type.byte "byteValue"] - [box.short type.short "shortValue"] - [box.int type.int "intValue"] - [box.long type.long "longValue"] - [box.float type.float "floatValue"] - [box.double type.double "doubleValue"] - [box.char type.char "charValue"])) + [box.boolean type.boolean] + [box.byte type.byte] + [box.short type.short] + [box.int type.int] + [box.long type.long] + [box.char type.char] + [box.float type.float] + [box.double type.double])) ... else valueG)))))])) @@ -643,96 +643,68 @@ (/////bundle.install "cast" object::cast) ))) -(def: primitives - (Dictionary Text (Type Primitive)) - (|> (list [(reflection.reflection reflection.boolean) type.boolean] - [(reflection.reflection reflection.byte) type.byte] - [(reflection.reflection reflection.short) type.short] - [(reflection.reflection reflection.int) type.int] - [(reflection.reflection reflection.long) type.long] - [(reflection.reflection reflection.float) type.float] - [(reflection.reflection reflection.double) type.double] - [(reflection.reflection reflection.char) type.char]) - (dictionary.of_list text.hash))) - (def: get::static Handler (..custom - [($_ <>.and .text .text .text) - (function (_ extension_name generate archive [class field unboxed]) - (do //////.monad - [.let [$class (type.class class (list))]] - (case (dictionary.value unboxed ..primitives) - {.#Some primitive} - (in (_.getstatic $class field primitive)) - - {.#None} - (in (_.getstatic $class field (type.class unboxed (list)))))))])) + [($_ <>.and .text .text ..value) + (function (_ extension_name generate archive [class field :unboxed:]) + (# //////.monad in (_.getstatic (type.class class (list)) field :unboxed:)))])) -(def: unitG (_.string //////synthesis.unit)) +(def: unitG + (_.string //////synthesis.unit)) (def: put::static Handler (..custom - [($_ <>.and .text .text .text .any) - (function (_ extension_name generate archive [class field unboxed valueS]) + [($_ <>.and .text .text ..value .any) + (function (_ extension_name generate archive [class field :unboxed: valueS]) (do //////.monad - [valueG (generate archive valueS) - .let [$class (type.class class (list))]] - (case (dictionary.value unboxed ..primitives) - {.#Some primitive} - (in ($_ _.composite - valueG - (_.putstatic $class field primitive) - ..unitG)) - - {.#None} - (in ($_ _.composite - valueG - (_.checkcast $class) - (_.putstatic $class field $class) - ..unitG)))))])) + [valueG (generate archive valueS)] + (in ($_ _.composite + valueG + (case (parser.object? :unboxed:) + {.#Some :unboxed:} + (_.checkcast :unboxed:) + + {.#None} + (_#in [])) + (_.putstatic (type.class class (list)) field :unboxed:) + ..unitG))))])) (def: get::virtual Handler (..custom - [($_ <>.and .text .text .text .any) - (function (_ extension_name generate archive [class field unboxed objectS]) + [($_ <>.and .text .text ..value .any) + (function (_ extension_name generate archive [class field :unboxed: objectS]) (do //////.monad [objectG (generate archive objectS) - .let [$class (type.class class (list)) - getG (case (dictionary.value unboxed ..primitives) - {.#Some primitive} - (_.getfield $class field primitive) - - {.#None} - (_.getfield $class field (type.class unboxed (list))))]] + .let [:class: (type.class class (list)) + getG (_.getfield :class: field :unboxed:)]] (in ($_ _.composite objectG - (_.checkcast $class) + (_.checkcast :class:) getG))))])) (def: put::virtual Handler (..custom - [($_ <>.and .text .text .text .any .any) - (function (_ extension_name generate archive [class field unboxed valueS objectS]) + [($_ <>.and .text .text ..value .any .any) + (function (_ extension_name generate archive [class field :unboxed: valueS objectS]) (do //////.monad [valueG (generate archive valueS) objectG (generate archive objectS) - .let [$class (type.class class (list)) - putG (case (dictionary.value unboxed ..primitives) - {.#Some primitive} - (_.putfield $class field primitive) + .let [:class: (type.class class (list)) + putG (case (parser.object? :unboxed:) + {.#Some :unboxed:} + ($_ _.composite + (_.checkcast :unboxed:) + (_.putfield :class: field :unboxed:)) {.#None} - (let [$unboxed (type.class unboxed (list))] - ($_ _.composite - (_.checkcast $unboxed) - (_.putfield $class field $unboxed))))]] + (_.putfield :class: field :unboxed:))]] (in ($_ _.composite objectG - (_.checkcast $class) + (_.checkcast :class:) _.dup valueG putG))))])) @@ -764,7 +736,7 @@ ..unitG {.#Left outputT} - (# _.monad in []))) + (_#in []))) (def: invoke::static Handler diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux index 51f9069d0..5b0bd0438 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux @@ -26,7 +26,7 @@ (type: .public Packager (-> (Dictionary file.Path Binary) Archive - unit.ID + (Maybe unit.ID) (Try (Either Binary (List [Text Binary]))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux index 9b84fa64d..99c9a316b 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux @@ -131,11 +131,18 @@ "1.0") (def: (manifest program) - (-> unit.ID java/util/jar/Manifest) - (let [manifest (java/util/jar/Manifest::new)] - (exec (do_to (java/util/jar/Manifest::getMainAttributes manifest) - (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MAIN_CLASS) (|> program runtime.class_name name.internal name.external)) - (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MANIFEST_VERSION) ..manifest_version)) + (-> (Maybe unit.ID) java/util/jar/Manifest) + (let [manifest (java/util/jar/Manifest::new) + attrs (do_to (java/util/jar/Manifest::getMainAttributes manifest) + (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MANIFEST_VERSION) ..manifest_version))] + (exec + (case program + {.#Some program} + (do_to attrs + (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MAIN_CLASS) (|> program runtime.class_name name.internal name.external))) + + {.#None} + attrs) manifest))) (def: (write_class static module artifact custom content sink) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index c835643dd..082ad0db9 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -94,7 +94,7 @@ (in output))) (def: (package! fs host_dependencies [packager package] archive context) - (-> (file.System Async) (Dictionary file.Path Binary) [Packager file.Path] Archive unit.ID (Async (Try Any))) + (-> (file.System Async) (Dictionary file.Path Binary) [Packager file.Path] Archive (Maybe unit.ID) (Async (Try Any))) (case (packager host_dependencies archive context) {try.#Success content} (case content @@ -173,7 +173,6 @@ (Async (Try [Archive (directive.State+ )])) (:expected (platform.compile lux_compiler phase_wrapper import file_context expander platform compilation [archive state]))) _ (cache.cache! (value@ platform.#&file_system platform) file_context archive) - program_context (async#in ($/program.context archive)) host_dependencies (..load_host_dependencies (value@ platform.#&file_system platform) compilation_host_dependencies) _ (..package! (for [@.old (file.async file.default) @.jvm (file.async file.default) @@ -183,7 +182,7 @@ host_dependencies packager,package archive - program_context)] + (try.maybe ($/program.context archive)))] (in (debug.log! "Compilation complete!")))) {cli.#Export export} diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux index 14f3d201a..9eb52d393 100644 --- a/stdlib/source/test/lux/ffi.jvm.lux +++ b/stdlib/source/test/lux/ffi.jvm.lux @@ -5,6 +5,7 @@ ["[0]" type ("[1]#[0]" equivalence)] ["[0]" meta] ["[0]" debug] + ["[0]" static] [abstract [monad {"+" do}]] [control @@ -24,8 +25,9 @@ ["[0]" code] ["[0]" template]] [math - ["[0]" random {"+" Random}] - [number + ["[0]" random {"+" Random} ("[1]#[0]" monad)] + [number {"+" hex} + ["[0]" i64] ["n" nat] ["i" int ("[1]#[0]" equivalence)] ["f" frac ("[1]#[0]" equivalence)]]] @@ -652,6 +654,166 @@ false))))) ))) +(def: expected_boolean (/.as_boolean (static.random_bit))) +(def: expected_byte (/.as_byte (static.random_int))) +(def: expected_short (/.as_short (static.random_int))) +(def: expected_int (/.as_int (static.random_int))) +(def: expected_long (/.as_long (static.random_int))) +(def: expected_char (/.as_char (static.random_int))) +(def: expected_float (/.as_float (static.random_frac))) +(def: expected_double (/.as_double (static.random_frac))) +(def: expected_string (/.as_string (static.random code.text (random.ascii/lower 2)))) + +(`` (`` (/.export: Primitives + ... Constants + (actual_boolean boolean ..expected_boolean) + (actual_byte byte ..expected_byte) + (actual_short short ..expected_short) + (actual_int int ..expected_int) + (actual_long long ..expected_long) + (actual_char char ..expected_char) + (actual_float float ..expected_float) + (actual_double double ..expected_double) + + ... Methods + (~~ (template [ <+>] + [(((~~ (template.symbol [ "_method"])) + [left + right ]) + + ((~~ (template.symbol [/._] ["as_" ])) + (<+> ((~~ (template.symbol [/._] ["of_" ])) left) + ((~~ (template.symbol [/._] ["of_" ])) right))))] + + [boolean and] + [byte i.+] + [short i.+] + [int i.+] + [long i.+] + [char i.+] + [float f.+] + [double f.+] + )) + ))) + +(`` (`` (/.import: Primitives + ["[1]::[0]" + ("static" actual_boolean boolean) + ("static" actual_byte byte) + ("static" actual_short short) + ("static" actual_int int) + ("static" actual_long long) + ("static" actual_char char) + ("static" actual_float float) + ("static" actual_double double) + + (~~ (template [] + [("static" (~~ (template.symbol [ "_method"])) [ ] )] + + [boolean] + [byte] + [short] + [int] + [long] + [char] + [float] + [double] + )) + ]))) + +(/.export: Objects + (actual_string java/lang/String ..expected_string) + + ((string_method [left java/lang/String right java/lang/String]) + java/lang/String + (/.as_string (%.format (/.of_string left) (/.of_string right)))) + + (([a] left [left a right a]) a left) + (([a] right [left a right a]) a right)) + +(/.import: Objects + ["[1]::[0]" + ("static" actual_string java/lang/String) + + ("static" string_method [java/lang/String java/lang/String] java/lang/String) + + ("static" [a] left [a a] a) + ("static" [a] right [a a] a)]) + +(def: tiny_int + (Random Int) + (random#each (|>> (i64.and (hex "F")) .int) + random.nat)) + +(def: tiny_frac + (Random Frac) + (random#each (|>> (i64.and (hex "FFFF")) + .int + i.frac) + random.nat)) + +(`` (`` (def: test|export + Test + (do [! random.monad] + [(~~ (template [ ] + [(~~ (template.symbol [left_ ])) (# ! each (|>> ) ) + (~~ (template.symbol [right_ ])) (# ! each (|>> ) )] + + [boolean /.as_boolean random.bit] + [byte /.as_byte ..tiny_int] + [short /.as_short ..tiny_int] + [int /.as_int ..tiny_int] + [long /.as_long ..tiny_int] + [char /.as_char ..tiny_int] + [float /.as_float ..tiny_frac] + [double /.as_double ..tiny_frac] + [string /.as_string (random.ascii/lower 1)] + ))] + ($_ _.and + (_.cover [/.export:] + (and (bit#= (/.of_boolean ..expected_boolean) (/.of_boolean (Primitives::actual_boolean))) + (i#= (/.of_byte ..expected_byte) (/.of_byte (Primitives::actual_byte))) + (i#= (/.of_short ..expected_short) (/.of_short (Primitives::actual_short))) + (i#= (/.of_int ..expected_int) (/.of_int (Primitives::actual_int))) + (i#= (/.of_long ..expected_long) (/.of_long (Primitives::actual_long))) + (i#= (/.of_char ..expected_char) (/.of_char (Primitives::actual_char))) + (f#= (/.of_float ..expected_float) (/.of_float (Primitives::actual_float))) + (f#= (/.of_double ..expected_double) (/.of_double (Primitives::actual_double))) + + (~~ (template [<=> <+> ] + [(with_expansions [ (template.symbol ["left_" ]) + (template.symbol ["right_" ]) + (template.symbol [/._] ["of_" ]) + (template.symbol ["Primitives::" "_method"])] + (<=> (<+> ( ) ( )) + ( ( ))))] + + [bit#= and boolean] + [i#= i.+ byte] + [i#= i.+ short] + [i#= i.+ int] + [i#= i.+ long] + [i#= i.+ char] + [f#= f.+ float] + [f#= f.+ double] + )) + + (text#= (/.of_string ..expected_string) (/.of_string (Objects::actual_string))) + + (text#= (%.format (/.of_string left_string) (/.of_string right_string)) + (/.of_string (Objects::string_method left_string right_string))) + + (text#= (/.of_string left_string) + (/.of_string (Objects::left left_string right_string))) + (text#= (/.of_string right_string) + (/.of_string (Objects::right left_string right_string))) + (i#= (/.of_long left_long) + (/.of_long (Objects::left left_long right_long))) + (i#= (/.of_long right_long) + (/.of_long (Objects::right left_long right_long))) + )) + ))))) + (def: .public test (<| (_.covering /._) ($_ _.and @@ -661,4 +823,5 @@ ..for_interface ..for_class ..for_exception + ..test|export ))) -- cgit v1.2.3