aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--changelog.md6
-rw-r--r--lux-mode/lux-mode.el2
-rw-r--r--stdlib/source/library/lux/ffi.jvm.lux135
-rw-r--r--stdlib/source/library/lux/static.lux2
-rw-r--r--stdlib/source/library/lux/target/jvm/bytecode.lux19
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux96
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux12
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux152
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux17
-rw-r--r--stdlib/source/program/compositor.lux5
-rw-r--r--stdlib/source/test/lux/ffi.jvm.lux167
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 @@
(<code>.form (do <>.monad
[pm privacy_modifier^
sm state_modifier^
+ static? (<>.parses? (<code>.this! (' "static")))
name <code>.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]))
(<code>.form (do <>.monad
[pm privacy_modifier^
- strict_fp? (<>.parses? (<code>.this! (' "strict")))
+ strict_fp? (<>.parses? (<code>.text! "strict"))
method_vars (<>.else (list) ..vars^)
.let [total_vars (list#composite class_vars method_vars)]
[_ self_name arguments] (<code>.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 (` (~! <code>.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))))
+ (<code>.form
+ ($_ <>.and
+ of
+ <code>.any
+ <code>.any
+ )))
+
+(type: Constant
+ Text)
+
+(def: constant
+ (Parser Constant)
+ <code>.local_symbol)
+
+(type: Function
+ (Record
+ [#variables (List Text)
+ #name Text
+ #requirements (List [Text Code])]))
+
+(def: function
+ (Parser Function)
+ (<code>.form
+ ($_ <>.and
+ (<>.else (list) (<code>.tuple (<>.some <code>.local_symbol)))
+ <code>.local_symbol
+ (<code>.tuple (<>.some ($_ <>.and
+ <code>.local_symbol
+ <code>.any
+ )))
+ )))
+
+(type: Export
+ (Variant
+ {#Constant (API Constant)}
+ {#Function (API Function)}))
+
+(def: export
+ (Parser Export)
+ ($_ <>.or
+ (..api ..constant)
+ (..api ..function)
+ ))
+
+(syntax: .public (export: [api <code>.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" [] ((~' <clinit>) [])
+ (~' 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 <type>) <format> list)
(meta.eval <type> expression)))]
+ [bit .Bit code.bit]
[nat .Nat code.nat]
[int .Int code.int]
[rev .Rev code.rev]
@@ -64,6 +65,7 @@
<random>)]]
(in (list (<format> 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 <consumption> $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 [<name> <consumption/1> <1> <consumption/2> <2>]
+ [(def: .public (<name> 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 <consumption/2> $0 @_ <2> [index])
+ (..bytecode <consumption/1> $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
(<code>.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 @@
<code>.text
..visibility
..state
+ (<>.parses? (<code>.text! jvm.static_tag))
(<code>.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 [<object> <type> <unwrap>]
- [(and (text#= (..reflection <type>)
- from)
- (text#= <object>
- to))
- (let [$<object> (type.class <object> (list))]
- ($_ _.composite
- valueG
- (///value.wrap <type>)))
-
- (and (text#= <object>
- from)
- (text#= (..reflection <type>)
- to))
+ (in (`` (cond (~~ (template [<object> <type>]
+ [(and (text#= (..reflection <type>) from)
+ (text#= <object> to))
+ ($_ _.composite
+ valueG
+ (///value.wrap <type>))
+
+ (and (text#= <object> from)
+ (text#= (..reflection <type>) to))
($_ _.composite
valueG
(///value.unwrap <type>))]
- [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 <synthesis>.text <synthesis>.text <synthesis>.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 <synthesis>.text <synthesis>.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 <synthesis>.text <synthesis>.text <synthesis>.text <synthesis>.any)
- (function (_ extension_name generate archive [class field unboxed valueS])
+ [($_ <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.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 <synthesis>.text <synthesis>.text <synthesis>.text <synthesis>.any)
- (function (_ extension_name generate archive [class field unboxed objectS])
+ [($_ <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.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 <synthesis>.text <synthesis>.text <synthesis>.text <synthesis>.any <synthesis>.any)
- (function (_ extension_name generate archive [class field unboxed valueS objectS])
+ [($_ <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any <synthesis>.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+ <parameters>)]))
(: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 [<type> <+>]
+ [(((~~ (template.symbol [<type> "_method"]))
+ [left <type>
+ right <type>])
+ <type>
+ ((~~ (template.symbol [/._] ["as_" <type>]))
+ (<+> ((~~ (template.symbol [/._] ["of_" <type>])) left)
+ ((~~ (template.symbol [/._] ["of_" <type>])) 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 [<type>]
+ [("static" (~~ (template.symbol [<type> "_method"])) [<type> <type>] <type>)]
+
+ [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 [<type> <as> <random>]
+ [(~~ (template.symbol [left_ <type>])) (# ! each (|>> <as>) <random>)
+ (~~ (template.symbol [right_ <type>])) (# ! each (|>> <as>) <random>)]
+
+ [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 [<=> <+> <type>]
+ [(with_expansions [<left> (template.symbol ["left_" <type>])
+ <right> (template.symbol ["right_" <type>])
+ <of> (template.symbol [/._] ["of_" <type>])
+ <method> (template.symbol ["Primitives::" <type> "_method"])]
+ (<=> (<+> (<of> <left>) (<of> <right>))
+ (<of> (<method> <left> <right>))))]
+
+ [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
)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 01:16:20 +0000