diff options
Diffstat (limited to '')
12 files changed, 413 insertions, 213 deletions
diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index 38ecbdce2..55534dfab 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -1,39 +1,23 @@ (.using [library [lux (.except) - ["[0]" debug] [abstract [monad (.only do)]] [control ["[0]" pipe] - ["[0]" function] ["[0]" try (.only Try)] ["[0]" exception (.only exception:)] - ["[0]" io (.only IO io)] - ["<>" parser (.open: "[1]#[0]" monad) - ["<[0]>" code (.only Parser)]]] + ["[0]" io (.only IO io)]] [data ["[0]" bit] - ["[0]" product] - [text - ["%" \\format (.only format)]] - [collection - ["[0]" list (.open: "[1]#[0]" monoid monad)]]] - ["[0]" macro (.only with_symbols) - ["[0]" code] - ["[0]" local] - [syntax (.only syntax) - ["|[0]|" input] - ["|[0]|" export]]] - [math - [number - ["n" nat]]] - ["[0]" meta (.only monad)] + ["[0]" product]] + [macro + ["[0]" local]] [type (.only sharing) - ["[0]" primitive (.only primitive: representation abstraction)]]]] + [primitive (.only primitive: representation abstraction)]]]] [// ["[0]" atom (.only Atom atom)] - ["[0]" async (.only Async Resolver) (.open: "[1]#[0]" monad)] + ["[0]" async (.only Async Resolver)] ["[0]" frp (.only Channel Channel')]]) (exception: .public poisoned) diff --git a/stdlib/source/library/lux/control/parser.lux b/stdlib/source/library/lux/control/parser.lux index afd8c4802..fef41832d 100644 --- a/stdlib/source/library/lux/control/parser.lux +++ b/stdlib/source/library/lux/control/parser.lux @@ -25,11 +25,11 @@ (def: (each f ma) (function (_ input) (case (ma input) - {try.#Failure msg} - {try.#Failure msg} - {try.#Success [input' a]} - {try.#Success [input' (f a)]}))))) + {try.#Success [input' (f a)]} + + {try.#Failure msg} + {try.#Failure msg}))))) (def: .public apply (All (_ s) (Apply (Parser s))) @@ -62,11 +62,11 @@ (def: (conjoint mma) (function (_ input) (case (mma input) - {try.#Failure msg} - {try.#Failure msg} - {try.#Success [input' ma]} - (ma input')))))) + (ma input') + + {try.#Failure msg} + {try.#Failure msg}))))) (def: .public (assertion message test) (All (_ s) (-> Text Bit (Parser s Any))) @@ -80,11 +80,11 @@ (-> (Parser s a) (Parser s (Maybe a)))) (function (_ input) (case (parser input) - {try.#Failure _} - {try.#Success [input {.#None}]} - {try.#Success [input' x]} - {try.#Success [input' {.#Some x}]}))) + {try.#Success [input' {.#Some x}]} + + {try.#Failure _} + {try.#Success [input {.#None}]}))) (def: .public (result parser input) (All (_ s a) @@ -130,13 +130,13 @@ (-> (Parser s a) (Parser s (List a)))) (function (_ input) (case (parser input) - {try.#Failure _} - {try.#Success [input (list)]} - {try.#Success [input' head]} (..result (at ..monad each (|>> (list.partial head)) (some parser)) - input')))) + input') + + {try.#Failure _} + {try.#Success [input (list)]}))) (def: .public (many parser) (All (_ s a) @@ -167,13 +167,13 @@ 0 (at ..monad in (list)) _ (function (_ input) (case (parser input) - {try.#Failure msg} - {try.#Success [input (list)]} - {try.#Success [input' x]} (..result (at ..monad each (|>> {.#Item x}) (at_most (-- amount) parser)) - input'))))) + input') + + {try.#Failure msg} + {try.#Success [input (list)]})))) (def: .public (between minimum additional parser) (All (_ s a) (-> Nat Nat (Parser s a) (Parser s (List a)))) @@ -189,14 +189,14 @@ (do [! ..monad] [?x (..maybe parser)] (case ?x - {.#None} - (in {.#End}) - {.#Some x} (|> parser (..and separator) ..some - (at ! each (|>> (list#each product.right) {.#Item x})))))) + (at ! each (|>> (list#each product.right) {.#Item x}))) + + {.#None} + (in {.#End})))) (def: .public (not parser) (All (_ s a) (-> (Parser s a) (Parser s Any))) @@ -227,11 +227,11 @@ (All (_ s a) (-> a (Parser s a) (Parser s a))) (function (_ input) (case (parser input) - {try.#Failure error} - {try.#Success [input value]} - {try.#Success [input' output]} - {try.#Success [input' output]}))) + {try.#Success [input' output]} + + {try.#Failure error} + {try.#Success [input value]}))) (def: .public remaining (All (_ s) (Parser s s)) @@ -267,21 +267,21 @@ (All (_ s a) (-> (Parser s a) (Parser s Bit))) (function (_ input) (case (parser input) - {try.#Failure error} - {try.#Success [input false]} - {try.#Success [input' _]} - {try.#Success [input' true]}))) + {try.#Success [input' true]} + + {try.#Failure error} + {try.#Success [input false]}))) (def: .public (parses parser) (All (_ s a) (-> (Parser s a) (Parser s Any))) (function (_ input) (case (parser input) - {try.#Failure error} - {try.#Failure error} - {try.#Success [input' _]} - {try.#Success [input' []]}))) + {try.#Success [input' []]} + + {try.#Failure error} + {try.#Failure error}))) (def: .public (speculative parser) (All (_ s a) (-> (Parser s a) (Parser s a))) @@ -290,20 +290,20 @@ {try.#Success [input' output]} {try.#Success [input output]} - output - output))) + failure + failure))) (def: .public (codec codec parser) (All (_ s a z) (-> (Codec a z) (Parser s a) (Parser s z))) (function (_ input) (case (parser input) - {try.#Failure error} - {try.#Failure error} - {try.#Success [input' to_decode]} (case (at codec decoded to_decode) - {try.#Failure error} - {try.#Failure error} - {try.#Success value} - {try.#Success [input' value]})))) + {try.#Success [input' value]} + + {try.#Failure error} + {try.#Failure error}) + + {try.#Failure error} + {try.#Failure error}))) diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 7d9a5bb2c..4753e6f14 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -1,7 +1,7 @@ (.using [library [lux (.except Primitive Type type int char is as) - ["[0]" meta] + ["[0]" meta (.open: "[1]#[0]" monad)] [abstract ["[0]" monad (.only do)]] [control @@ -23,7 +23,8 @@ [syntax (.only syntax)] ["^" pattern] ["[0]" code] - ["[0]" template]] + ["[0]" template] + ["[0]" local]] [target ["[0]" jvm [encoding @@ -1088,106 +1089,110 @@ (-> (Typed Code) Code) (` [(~ (value$ class)) (~ term)])) +(def: (overriden_method_macro super_class name declaration type_vars self_name expected_arguments) + (-> (Type Class) Text (Type Declaration) (List (Type Var)) Text (List Argument) Macro) + (syntax (_ [_ (<code>.this (' "super")) + actual_arguments (<code>.tuple (<>.exactly (list.size expected_arguments) <code>.any))]) + (in (list (` ("jvm member invoke special" + [(~+ (list#each (|>> ..signature code.text) (product.right (parser.declaration declaration))))] + (~ (code.text (product.left (parser.read_class super_class)))) + (~ (code.text name)) + [(~+ (list#each (|>> ..signature code.text) type_vars))] + ("jvm object cast" (~ (code.local self_name))) + (~+ (|> actual_arguments + (list#each (|>> ~ "jvm object cast" `)) + (list.zipped_2 (list#each product.right expected_arguments)) + (list#each ..decorate_input))))))))) + (def: (method_def$ fully_qualified_class_name method_parser super_class fields [[name pm anns] method_def]) - (-> External (Parser Code) (Type Class) (List [Member_Declaration FieldDecl]) [Member_Declaration Method_Definition] Code) + (-> External (Parser Code) (Type Class) (List [Member_Declaration FieldDecl]) [Member_Declaration Method_Definition] (Meta Code)) (case method_def {#ConstructorMethod strict_fp? type_vars self_name arguments constructor_args body exs} (let [replacer (|> (list#each (field->parser fully_qualified_class_name self_name) fields) (list#mix <>.either method_parser) parser->replacer)] - (` ("init" - (~ (privacy_modifier$ pm)) - (~ (code.bit strict_fp?)) - [(~+ (list#each annotation$ anns))] - [(~+ (list#each var$ type_vars))] - [(~+ (list#each class$ exs))] - (~ (code.text self_name)) - [(~+ (list#each argument$ arguments))] - [(~+ (list#each constructor_arg$ constructor_args))] - (~ (replaced replacer body)) - ))) + (meta#in (` ("init" + (~ (privacy_modifier$ pm)) + (~ (code.bit strict_fp?)) + [(~+ (list#each annotation$ anns))] + [(~+ (list#each var$ type_vars))] + [(~+ (list#each class$ exs))] + (~ (code.text self_name)) + [(~+ (list#each argument$ arguments))] + [(~+ (list#each constructor_arg$ constructor_args))] + (~ (replaced replacer body)) + )))) {#VirtualMethod final? strict_fp? type_vars self_name arguments return_type body exs} (let [replacer (|> (list#each (field->parser fully_qualified_class_name self_name) fields) (list#mix <>.either method_parser) parser->replacer)] - (` ("virtual" - (~ (code.text name)) - (~ (privacy_modifier$ pm)) - (~ (code.bit final?)) - (~ (code.bit strict_fp?)) - [(~+ (list#each annotation$ anns))] - [(~+ (list#each var$ type_vars))] - (~ (code.text self_name)) - [(~+ (list#each argument$ arguments))] - (~ (return$ return_type)) - [(~+ (list#each class$ exs))] - (~ (replaced replacer body))))) + (meta#in (` ("virtual" + (~ (code.text name)) + (~ (privacy_modifier$ pm)) + (~ (code.bit final?)) + (~ (code.bit strict_fp?)) + [(~+ (list#each annotation$ anns))] + [(~+ (list#each var$ type_vars))] + (~ (code.text self_name)) + [(~+ (list#each argument$ arguments))] + (~ (return$ return_type)) + [(~+ (list#each class$ exs))] + (~ (replaced replacer body)))))) - {#OverridenMethod strict_fp? declaration type_vars self_name arguments return_type body exs} + {#OverridenMethod strict_fp? declaration type_vars self_name expected_arguments return_type body exs} (let [replacer (|> (list#each (field->parser fully_qualified_class_name self_name) fields) (list#mix <>.either method_parser) - parser->replacer) - super_replacer (parser->replacer (<code>.form (do <>.monad - [_ (<code>.this (' ::super!)) - args (<code>.tuple (<>.exactly (list.size arguments) <code>.any))] - (in (` ("jvm member invoke special" - [(~+ (list#each (|>> ..signature code.text) (product.right (parser.declaration declaration))))] - (~ (code.text (product.left (parser.read_class super_class)))) - (~ (code.text name)) - [(~+ (list#each (|>> ..signature code.text) type_vars))] - ("jvm object cast" (~ (code.local self_name))) - (~+ (|> args - (list#each (|>> ~ "jvm object cast" `)) - (list.zipped_2 (list#each product.right arguments)) - (list#each ..decorate_input)))))))))] - (` ("override" - (~ (declaration$ declaration)) - (~ (code.text name)) - (~ (code.bit strict_fp?)) - [(~+ (list#each annotation$ anns))] - [(~+ (list#each var$ type_vars))] - (~ (code.text self_name)) - [(~+ (list#each argument$ arguments))] - (~ (return$ return_type)) - [(~+ (list#each class$ exs))] - (~ (|> body - (replaced replacer) - (replaced super_replacer))) - ))) + parser->replacer)] + (do meta.monad + [@ meta.current_module_name + body/+ (local.with (list [[@ name] (overriden_method_macro super_class name declaration type_vars self_name expected_arguments)]) + #1 + body)] + (in (` ("override" + (~ (declaration$ declaration)) + (~ (code.text name)) + (~ (code.bit strict_fp?)) + [(~+ (list#each annotation$ anns))] + [(~+ (list#each var$ type_vars))] + (~ (code.text self_name)) + [(~+ (list#each argument$ expected_arguments))] + (~ (return$ return_type)) + [(~+ (list#each class$ exs))] + (~+ (list#each (replaced replacer) body/+))))))) {#StaticMethod strict_fp? type_vars arguments return_type body exs} (let [replacer (parser->replacer (<>.failure ""))] - (` ("static" - (~ (code.text name)) - (~ (privacy_modifier$ pm)) - (~ (code.bit strict_fp?)) - [(~+ (list#each annotation$ anns))] - [(~+ (list#each var$ type_vars))] - [(~+ (list#each argument$ arguments))] - (~ (return$ return_type)) - [(~+ (list#each class$ exs))] - (~ (replaced replacer body))))) + (meta#in (` ("static" + (~ (code.text name)) + (~ (privacy_modifier$ pm)) + (~ (code.bit strict_fp?)) + [(~+ (list#each annotation$ anns))] + [(~+ (list#each var$ type_vars))] + [(~+ (list#each argument$ arguments))] + (~ (return$ return_type)) + [(~+ (list#each class$ exs))] + (~ (replaced replacer body)))))) {#AbstractMethod type_vars arguments return_type exs} - (` ("abstract" - (~ (code.text name)) - (~ (privacy_modifier$ pm)) - [(~+ (list#each annotation$ anns))] - [(~+ (list#each var$ type_vars))] - [(~+ (list#each argument$ arguments))] - (~ (return$ return_type)) - [(~+ (list#each class$ exs))])) + (meta#in (` ("abstract" + (~ (code.text name)) + (~ (privacy_modifier$ pm)) + [(~+ (list#each annotation$ anns))] + [(~+ (list#each var$ type_vars))] + [(~+ (list#each argument$ arguments))] + (~ (return$ return_type)) + [(~+ (list#each class$ exs))]))) {#NativeMethod type_vars arguments return_type exs} - (` ("native" - (~ (code.text name)) - (~ (privacy_modifier$ pm)) - [(~+ (list#each annotation$ anns))] - [(~+ (list#each var$ type_vars))] - [(~+ (list#each class$ exs))] - [(~+ (list#each argument$ arguments))] - (~ (return$ return_type)))) + (meta#in (` ("native" + (~ (code.text name)) + (~ (privacy_modifier$ pm)) + [(~+ (list#each annotation$ anns))] + [(~+ (list#each var$ type_vars))] + [(~+ (list#each class$ exs))] + [(~+ (list#each argument$ arguments))] + (~ (return$ return_type))))) )) (def: (complete_call$ g!obj [method args]) @@ -1214,7 +1219,8 @@ method_parser (.is (Parser Code) (|> methods (list#each (method->parser class_vars fully_qualified_class_name)) - (list#mix <>.either (<>.failure ""))))]] + (list#mix <>.either (<>.failure ""))))] + methods (monad.each ! (method_def$ fully_qualified_class_name method_parser super fields) methods)] (in (list (` ("jvm class" (~ (declaration$ (jvm.declaration full_class_name class_vars))) (~ (class$ super)) @@ -1222,7 +1228,7 @@ (~ (inheritance_modifier$ im)) [(~+ (list#each annotation$ annotations))] [(~+ (list#each field_decl$ fields))] - [(~+ (list#each (method_def$ fully_qualified_class_name method_parser super fields) methods))]))))))) + [(~+ methods)]))))))) (def: .public interface: (syntax (_ [.let [! <>.monad] @@ -1245,12 +1251,14 @@ (<code>.tuple (<>.some (class^ class_vars)))) constructor_args (..constructor_args^ class_vars) methods (<>.some ..overriden_method_def^)]) - (in (list (` ("jvm class anonymous" - [(~+ (list#each var$ class_vars))] - (~ (class$ super)) - [(~+ (list#each class$ interfaces))] - [(~+ (list#each constructor_arg$ constructor_args))] - [(~+ (list#each (method_def$ "" (<>.failure "") super (list)) methods))])))))) + (do [! meta.monad] + [methods (monad.each ! (method_def$ "" (<>.failure "") super (list)) methods)] + (in (list (` ("jvm class anonymous" + [(~+ (list#each var$ class_vars))] + (~ (class$ super)) + [(~+ (list#each class$ interfaces))] + [(~+ (list#each constructor_arg$ constructor_args))] + [(~+ methods)]))))))) (def: .public null (syntax (_ []) diff --git a/stdlib/source/library/lux/macro/local.lux b/stdlib/source/library/lux/macro/local.lux index 5a07b4a48..2d93ea1fc 100644 --- a/stdlib/source/library/lux/macro/local.lux +++ b/stdlib/source/library/lux/macro/local.lux @@ -110,18 +110,10 @@ (..push_one [g!pop (..pop_all (list#each product.left macros) g!pop)]))] (in (` ((~ g!pop)))))) -(def: .public (with macros body) - (-> (List [Symbol Macro]) Code (Meta (List Code))) +(def: .public (with macros expression? body) + (-> (List [Symbol Macro]) Bit Code (Meta (List Code))) (do [! meta.monad] - [expression? (is (Meta Bit) - (function (_ lux) - {try.#Success [lux (case (the .#expected lux) - {.#None} - false - - {.#Some _} - true)]})) - g!pop (..push macros)] + [g!pop (..push macros)] (.if expression? (//.with_symbols [g!body] (in (list (` (.let [(~ g!body) (~ body)] @@ -141,5 +133,13 @@ (meta.eval .Macro) (at ! each (|>> (as .Macro) [[here_name name]])))) - locals)] - (..with locals body)))) + locals) + expression? (is (Meta Bit) + (function (_ lux) + {try.#Success [lux (case (the .#expected lux) + {.#None} + false + + {.#Some _} + true)]}))] + (..with locals expression? body)))) 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 bb307180d..e285ff15a 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 @@ -14,7 +14,8 @@ ["<>" parser (.only) ["<[0]>" code (.only Parser)]]] [data - [binary (.only Binary)] + [binary (.only Binary) + ["[0]" \\format]] ["[0]" product] ["[0]" text (.open: "[1]#[0]" equivalence) ["%" \\format (.only format)] @@ -23,9 +24,7 @@ ["[0]" list (.open: "[1]#[0]" mix monad monoid)] ["[0]" array] ["[0]" dictionary (.only Dictionary)] - ["[0]" sequence]] - ["[0]" format - ["[1]" binary]]] + ["[0]" sequence]]] [macro ["^" pattern] ["[0]" template]] @@ -79,6 +78,8 @@ ["[0]" scope]] [/// ["[0]" phase (.open: "[1]#[0]" monad)] + ["[0]" reference (.only) + ["[0]" variable]] [meta [archive (.only Archive) [module @@ -2235,6 +2236,74 @@ (/////analysis.tuple (list forced_refencing bodyA))] (list)]})))) +(def: (with_fake_parameter#pattern it) + (-> pattern.Pattern pattern.Pattern) + (case it + {pattern.#Simple _} + it + + {pattern.#Complex it} + {pattern.#Complex + (case it + {complex.#Variant it} + {complex.#Variant (revised complex.#value with_fake_parameter#pattern it)} + + {complex.#Tuple it} + {complex.#Tuple (list#each with_fake_parameter#pattern it)})} + + {pattern.#Bind it} + {pattern.#Bind (++ it)})) + +(def: (with_fake_parameter it) + (-> Analysis Analysis) + (case it + {/////analysis.#Simple _} + it + + {/////analysis.#Structure it} + {/////analysis.#Structure + (case it + {complex.#Variant it} + {complex.#Variant (revised complex.#value with_fake_parameter it)} + + {complex.#Tuple it} + {complex.#Tuple (list#each with_fake_parameter it)})} + + {/////analysis.#Reference it} + {/////analysis.#Reference + (case it + {reference.#Variable it} + {reference.#Variable + (case it + {variable.#Local it} + {variable.#Local (++ it)} + + {variable.#Foreign _} + it)} + + {reference.#Constant _} + it)} + + {/////analysis.#Case value [head tail]} + {/////analysis.#Case (with_fake_parameter value) + (let [with_fake_parameter (is (-> /////analysis.Branch /////analysis.Branch) + (|>> (revised /////analysis.#when with_fake_parameter#pattern) + (revised /////analysis.#then with_fake_parameter)))] + [(with_fake_parameter head) + (list#each with_fake_parameter tail)])} + + {/////analysis.#Function environment body} + {/////analysis.#Function (list#each with_fake_parameter environment) + body} + + {/////analysis.#Apply parameter abstraction} + {/////analysis.#Apply (with_fake_parameter parameter) + (with_fake_parameter abstraction)} + + {/////analysis.#Extension name parameters} + {/////analysis.#Extension name + (list#each with_fake_parameter parameters)})) + (def: .public (analyse_overriden_method analyse archive selfT mapping supers method) (-> Phase Archive .Type Mapping (List (Type Class)) (Overriden_Method Code) (Operation Analysis)) (let [[parent_type method_name @@ -2265,7 +2334,8 @@ list.reversed (list#mix scope.with_local (analyse archive body)) (typeA.expecting :return:) - scope.with)] + scope.with) + .let [arity (list.size arguments)]] (in (/////analysis.tuple (list (/////analysis.text ..overriden_tag) (class_analysis parent_type) (/////analysis.text method_name) @@ -2280,7 +2350,10 @@ {/////analysis.#Function (list#each (|>> /////analysis.variable) (scope.environment scope)) - (..hidden_method_body (list.size arguments) bodyA)} + (<| (..hidden_method_body arity) + (case arity + 0 (with_fake_parameter bodyA) + _ bodyA))} )))))) (def: (matched? [sub sub_method subJT] [super super_method superJT]) @@ -2394,7 +2467,7 @@ (let [signature (signature.inheritance (list#each jvm.signature parameters) (jvm.signature super) (list#each jvm.signature interfaces))] - (try#each (|>> (format.result class.writer) + (try#each (|>> (\\format.result class.writer) [name]) (class.class version.v6_0 (all modifier#composite 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 9198eff46..957b2339d 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 @@ -12,8 +12,9 @@ ["<[0]>" code (.only Parser)] ["<[0]>" synthesis]]] [data - [binary (.only Binary)] ["[0]" product] + [binary (.only Binary) + ["[0]" \\format]] ["[0]" text ["%" \\format (.only format)] ["<[1]>" \\parser]] @@ -21,9 +22,7 @@ ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" dictionary] ["[0]" sequence] - ["[0]" set (.only Set)]] - ["[0]" format - ["[1]" binary]]] + ["[0]" set (.only Set)]]] [macro ["^" pattern] ["[0]" template]] @@ -331,7 +330,7 @@ (<synthesis>.tuple (<>.some ..annotation_synthesis)) (<synthesis>.tuple (<>.some ..var_type_synthesis)) <synthesis>.text - (do <>.monad + (do [! <>.monad] [args (<synthesis>.tuple (<>.some ..argument_synthesis))] (all <>.and (in args) @@ -533,7 +532,10 @@ (do [! phase.monad] [.let [[super method_name strict_floating_point? annotations method_tvars self arguments returnJ exceptionsJ - bodyS] method] + bodyS] method + bodyS (case (list.size arguments) + 0 (host.without_fake_parameter bodyS) + _ bodyS)] generate directive.generation] (directive.lifted_generation (do ! @@ -684,7 +686,7 @@ (let [signature (signature.inheritance (list#each type.signature parameters) (type.signature super) (list#each type.signature interfaces))] - (try#each (|>> (format.result class.writer) + (try#each (|>> (\\format.result class.writer) [name]) (class.class version.v6_0 (all modifier#composite @@ -901,7 +903,7 @@ (the [directive.#generation directive.#phase] state)]) methods) .let [all_dependencies (cache.all (list#each product.left methods))] - bytecode (<| (at ! each (format.result class.writer)) + bytecode (<| (at ! each (\\format.result class.writer)) phase.lifted (class.class version.v6_0 (all modifier#composite @@ -940,7 +942,7 @@ (function (_ extension_name phase archive [[name parameters] supers annotations method_declarations]) (directive.lifted_generation (do [! phase.monad] - [bytecode (<| (at ! each (format.result class.writer)) + [bytecode (<| (at ! each (\\format.result class.writer)) phase.lifted (class.class version.v6_0 (all modifier#composite 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 6f5057d00..30ef58a77 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 @@ -10,6 +10,8 @@ ["<[0]>" synthesis (.only Parser)]]] [data ["[0]" product] + [binary + ["[0]" \\format]] ["[0]" text (.open: "[1]#[0]" equivalence) ["%" \\format] ["<[1]>" \\parser]] @@ -17,9 +19,7 @@ ["[0]" list (.open: "[1]#[0]" monad mix monoid)] ["[0]" dictionary (.only Dictionary)] ["[0]" set (.only Set)] - ["[0]" sequence]] - ["[0]" format - ["[1]" binary]]] + ["[0]" sequence]]] [macro ["^" pattern] ["[0]" template]] @@ -64,9 +64,10 @@ [analysis ["/" jvm]]] ["/[1]" // - [analysis (.only Environment)] ["[1][0]" synthesis (.only Synthesis Path %synthesis)] ["[1][0]" generation] + [analysis (.only Environment) + ["[0]" complex]] [/// ["[1]" phase] ["[1][0]" reference (.only) @@ -846,6 +847,129 @@ _ <oops>))) +(def: (without_fake_parameter#path without_fake_parameter) + (-> (-> Synthesis Synthesis) + (-> Path Path)) + (function (again it) + (case it + (^.or {//////synthesis.#Pop} + {//////synthesis.#Access _}) + it + + {//////synthesis.#Bind it} + {//////synthesis.#Bind (-- it)} + + {//////synthesis.#Bit_Fork when then else} + {//////synthesis.#Bit_Fork when + (again then) + (maybe#each again else)} + + (^.with_template [<tag>] + [{<tag> [head tail]} + {<tag> [(revised //////synthesis.#then again head) + (list#each (revised //////synthesis.#then again) tail)]}]) + ([//////synthesis.#I64_Fork] + [//////synthesis.#F64_Fork] + [//////synthesis.#Text_Fork]) + + (^.with_template [<tag>] + [{<tag> left right} + {<tag> (again left) (again right)}]) + ([//////synthesis.#Seq] + [//////synthesis.#Alt]) + + {//////synthesis.#Then it} + {//////synthesis.#Then (without_fake_parameter it)}))) + +(def: .public (without_fake_parameter it) + (-> Synthesis Synthesis) + (case it + {//////synthesis.#Simple _} + it + + {//////synthesis.#Structure it} + {//////synthesis.#Structure + (case it + {complex.#Variant it} + {complex.#Variant (revised complex.#value without_fake_parameter it)} + + {complex.#Tuple it} + {complex.#Tuple (list#each without_fake_parameter it)})} + + {//////synthesis.#Reference it} + {//////synthesis.#Reference + (case it + {//////reference.#Variable it} + {//////reference.#Variable + (case it + {//////variable.#Local it} + {//////variable.#Local (-- it)} + + {//////variable.#Foreign _} + it)} + + {//////reference.#Constant _} + it)} + + {//////synthesis.#Control it} + {//////synthesis.#Control + (case it + {//////synthesis.#Branch it} + {//////synthesis.#Branch + (case it + {//////synthesis.#Exec before after} + {//////synthesis.#Exec (without_fake_parameter before) + (without_fake_parameter after)} + + {//////synthesis.#Let value register body} + {//////synthesis.#Let (without_fake_parameter value) + (-- register) + (without_fake_parameter body)} + + {//////synthesis.#If when then else} + {//////synthesis.#If (without_fake_parameter when) + (without_fake_parameter then) + (without_fake_parameter else)} + + {//////synthesis.#Get members record} + {//////synthesis.#Get members + (without_fake_parameter record)} + + {//////synthesis.#Case value path} + {//////synthesis.#Case (without_fake_parameter value) + (without_fake_parameter#path without_fake_parameter path)})} + + {//////synthesis.#Loop it} + {//////synthesis.#Loop + (case it + {//////synthesis.#Scope [//////synthesis.#start start + //////synthesis.#inits inits + //////synthesis.#iteration iteration]} + {//////synthesis.#Scope [//////synthesis.#start (-- start) + //////synthesis.#inits (list#each without_fake_parameter inits) + //////synthesis.#iteration iteration]} + + {//////synthesis.#Again _} + it)} + + {//////synthesis.#Function it} + {//////synthesis.#Function + (case it + {//////synthesis.#Abstraction [//////synthesis.#environment environment + //////synthesis.#arity arity + //////synthesis.#body body]} + {//////synthesis.#Abstraction [//////synthesis.#environment (list#each without_fake_parameter environment) + //////synthesis.#arity arity + //////synthesis.#body body]} + + {//////synthesis.#Apply [//////synthesis.#function function + //////synthesis.#arguments arguments]} + {//////synthesis.#Apply [//////synthesis.#function (without_fake_parameter function) + //////synthesis.#arguments (list#each without_fake_parameter arguments)]})})} + + {//////synthesis.#Extension name parameters} + {//////synthesis.#Extension name (list#each without_fake_parameter parameters)})) + (def: overriden_method_definition (Parser [(Environment Synthesis) (/.Overriden_Method Synthesis)]) (<synthesis>.tuple (do <>.monad @@ -863,12 +987,16 @@ (<synthesis>.loop (<>.exactly 0 <synthesis>.any)) <synthesis>.tuple (<>.after <synthesis>.any) - <synthesis>.any)] + <synthesis>.any) + .let [arity (list.size arguments)]] (in [environment [ownerT name strict_fp? annotations vars self_name arguments returnT exceptionsT - (..hidden_method_body (list.size arguments) body)]])))) + (<| (..hidden_method_body arity) + (case arity + 0 (without_fake_parameter body) + _ body))]])))) (def: (normalize_path normalize) (-> (-> Synthesis Synthesis) @@ -1222,7 +1350,7 @@ methods! (|> overriden_methods (list#each (normalized_method global_mapping)) (monad.each ! (method_definition generate archive artifact_id))) - bytecode (<| (at ! each (format.result class.writer)) + bytecode (<| (at ! each (\\format.result class.writer)) //////.lifted (class.class version.v6_0 (all modifier#composite class.public class.final) (name.internal anonymous_class_name) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux index 3de519160..a87be42cc 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux @@ -5,22 +5,22 @@ ["[0]" monad (.only do)]] [data ["[0]" product] + [binary + ["[0]" \\format]] [collection ["[0]" list (.open: "[1]#[0]" monoid functor)] - ["[0]" sequence]] - ["[0]" format - ["[1]" binary]]] + ["[0]" sequence]]] [math [number ["n" nat] ["[0]" i32]]] [target [jvm + ["_" bytecode (.only Label Bytecode) (.open: "[1]#[0]" monad)] ["[0]" version] ["[0]" modifier (.only Modifier) (.open: "[1]#[0]" monoid)] ["[0]" field (.only Field)] ["[0]" method (.only Method)] - ["_" bytecode (.only Label Bytecode) (.open: "[1]#[0]" monad)] ["[0]" class (.only Class)] ["[0]" type (.only Type) [category (.only Return' Value')] @@ -122,7 +122,7 @@ fields methods (sequence.sequence))) - .let [bytecode [function_class (format.result class.writer class)]] + .let [bytecode [function_class (\\format.result class.writer class)]] _ (generation.execute! bytecode) _ (generation.save! (product.right function_context) {.#None} bytecode)] (in instance))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux index 0a1eba71c..eb8478a41 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux @@ -12,16 +12,15 @@ [concurrency ["[0]" atom (.only Atom atom)]]] [data - [binary (.only Binary)] + [binary (.only Binary) + ["[0]" \\format]] ["[0]" product] ["[0]" text (.open: "[1]#[0]" hash) ["%" \\format (.only format)]] [collection ["[0]" array] ["[0]" dictionary (.only Dictionary)] - ["[0]" sequence]] - ["[0]" format - ["[1]" binary]]] + ["[0]" sequence]]] [target [jvm ["_" bytecode (.only Bytecode)] @@ -132,7 +131,7 @@ _.return)})) (sequence.sequence))] (io.run! (do [! (try.with io.monad)] - [bytecode (at ! each (format.result class.writer) + [bytecode (at ! each (\\format.result class.writer) (io.io bytecode)) _ (loader.store eval_class bytecode library) class (loader.load eval_class loader) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux index 6f9aa8aa3..a81896178 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux @@ -6,10 +6,10 @@ [control ["[0]" try]] [data + [binary + ["[0]" \\format]] [collection - ["[0]" sequence]] - ["[0]" format - ["[1]" binary]]] + ["[0]" sequence]]] [target [jvm ["_" bytecode (.only Bytecode)] @@ -155,7 +155,7 @@ _.return)}) class (artifact_name context)] [class - (<| (format.result class.writer) + (<| (\\format.result class.writer) try.trusted (class.class version.v6_0 ..program::modifier diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux index 9b61d3737..c4a772695 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux @@ -59,8 +59,14 @@ [#locals 0 #currying? false]) +(type: .public (Road value next) + (Record + [#when value + #then next])) + (type: .public (Fork value next) - [[value next] (List [value next])]) + [(Road value next) + (List (Road value next))]) (type: .public (Path' s) (Variant diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux index 4b924b6a6..e2f50a5e6 100644 --- a/stdlib/source/test/lux/ffi.jvm.lux +++ b/stdlib/source/test/lux/ffi.jvm.lux @@ -319,9 +319,9 @@ [] (actual1 self [throw? java/lang/Boolean]) java/lang/Long "throws" [java/lang/Throwable] - (if (/.of_boolean throw?) - (panic! "YOLO") - (/.as_long (.int expected))))) + (if (not (/.of_boolean throw?)) + (/.as_long (.int expected)) + (panic! "YOLO")))) example/1! (and (case (test/TestInterface1::actual1 (/.as_boolean false) object/1) {try.#Success actual} @@ -401,9 +401,9 @@ (test/TestInterface1 [] (actual1 self [throw? java/lang/Boolean]) java/lang/Long "throws" [java/lang/Throwable] - (if (/.of_boolean throw?) - (panic! "YOLO") - ::value))) + (if (not (/.of_boolean throw?)) + ::value + (panic! "YOLO")))) (/.import test/TestClass1 "[1]::[0]" |