From 29bbd8a2cd4deb9038f01c16d54ffa937917cfaa Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 29 Jun 2022 00:34:27 -0400 Subject: Better syntax for getting/setting fields when defining JVM classes. --- stdlib/source/documentation/lux/tool.lux | 2 +- .../lux/tool/compiler/language/lux/analysis.lux | 2 +- .../lux/tool/compiler/language/lux/declaration.lux | 2 +- .../lux/tool/compiler/language/lux/generation.lux | 2 +- .../lux/tool/compiler/language/lux/synthesis.lux | 2 +- .../documentation/lux/tool/compiler/phase.lux | 2 +- stdlib/source/library/lux/ffi.jvm.lux | 196 +++++++++---- stdlib/source/library/lux/macro/syntax.lux | 32 +-- stdlib/source/library/lux/target/jvm.lux | 313 --------------------- .../language/lux/phase/extension/analysis/jvm.lux | 216 +++++++------- .../lux/phase/extension/declaration/jvm.lux | 10 +- stdlib/source/test/lux/ffi.jvm.lux | 22 +- 12 files changed, 294 insertions(+), 507 deletions(-) delete mode 100644 stdlib/source/library/lux/target/jvm.lux (limited to 'stdlib/source') diff --git a/stdlib/source/documentation/lux/tool.lux b/stdlib/source/documentation/lux/tool.lux index 77877d5d1..0c67d1842 100644 --- a/stdlib/source/documentation/lux/tool.lux +++ b/stdlib/source/documentation/lux/tool.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text (.only \n) ["%" \\format (.only format)]] diff --git a/stdlib/source/documentation/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/documentation/lux/tool/compiler/language/lux/analysis.lux index 64776942f..83a47a0b1 100644 --- a/stdlib/source/documentation/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/documentation/lux/tool/compiler/language/lux/analysis.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text (.only \n) ["%" \\format (.only format)]] diff --git a/stdlib/source/documentation/lux/tool/compiler/language/lux/declaration.lux b/stdlib/source/documentation/lux/tool/compiler/language/lux/declaration.lux index ff1036122..cc2088576 100644 --- a/stdlib/source/documentation/lux/tool/compiler/language/lux/declaration.lux +++ b/stdlib/source/documentation/lux/tool/compiler/language/lux/declaration.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text (.only \n) ["%" \\format (.only format)]] diff --git a/stdlib/source/documentation/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/documentation/lux/tool/compiler/language/lux/generation.lux index 4b29c8ad0..295ada218 100644 --- a/stdlib/source/documentation/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/documentation/lux/tool/compiler/language/lux/generation.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text (.only \n) ["%" \\format (.only format)]] diff --git a/stdlib/source/documentation/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/documentation/lux/tool/compiler/language/lux/synthesis.lux index d9f08010e..ed0a4e27b 100644 --- a/stdlib/source/documentation/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/documentation/lux/tool/compiler/language/lux/synthesis.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text (.only \n) ["%" \\format (.only format)]] diff --git a/stdlib/source/documentation/lux/tool/compiler/phase.lux b/stdlib/source/documentation/lux/tool/compiler/phase.lux index 5c1831be0..5efcf5d0f 100644 --- a/stdlib/source/documentation/lux/tool/compiler/phase.lux +++ b/stdlib/source/documentation/lux/tool/compiler/phase.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text (.only \n) ["%" \\format (.only format)]] diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 5768251a8..12cbdc539 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -412,32 +412,6 @@ (-> (Type Declaration) Code) (|>> ..signature code.text)) -(def (get_const_parser class_name field_name) - (-> Text Text (Parser Code)) - (do <>.monad - [.let [dotted_name (format "::" field_name)] - _ (.this (code.symbol ["" dotted_name]))] - (in (get_static_field class_name field_name)))) - -(def (get_var_parser class_name field_name self_name) - (-> Text Text Text (Parser Code)) - (do <>.monad - [.let [dotted_name (format "::" field_name)] - _ (.this (code.symbol ["" dotted_name]))] - (in (get_virtual_field class_name field_name (code.local self_name))))) - -(def (put_var_parser class_name field_name self_name) - (-> Text Text Text (Parser Code)) - (do <>.monad - [.let [dotted_name (format "::" field_name)] - [_ _ value] (.is (Parser [Any Any Code]) - (.form (all <>.and (.this (' :=)) (.this (code.symbol ["" dotted_name])) .any)))] - (in (`' ("jvm member put virtual" - (~ (code.text class_name)) - (~ (code.text field_name)) - (~ value) - (~ (code.local self_name))))))) - (def (replaced f input) (-> (-> Code Code) Code Code) (case (f input) @@ -461,16 +435,6 @@ ast )) -(def (field->parser class_name self_name [[field_name _ _] field]) - (-> Text Text [Member_Declaration FieldDecl] (Parser Code)) - (case field - {#ConstantField _} - (get_const_parser class_name field_name) - - {#VariableField _} - (<>.either (get_var_parser class_name field_name self_name) - (put_var_parser class_name field_name self_name)))) - (def (decorate_input [class value]) (-> [(Type Value) Code] Code) (` [(~ (code.text (..signature class))) (~ value)])) @@ -1109,7 +1073,7 @@ (Parser (Type Class)) (.then parser.class .text)) -(def type^^ +(def value^^ (Parser (Type Value)) (.then parser.value .text)) @@ -1124,7 +1088,7 @@ [tvars (.tuple (<>.some var^^)) name .text anns (.tuple (<>.some ..annotation^)) - inputs (.tuple (<>.some type^^)) + inputs (.tuple (<>.some value^^)) output return^^ exs (.tuple (<>.some class^^))] (in [[name {#PublicP} anns] [#method_tvars tvars @@ -1142,7 +1106,7 @@ (~ (return$ #method_output)) [(~+ (list#each class$ #method_exs))])))) -(def .public with_super +(def with_super (syntax (_ [declaration,method,self (.tuple (all <>.and (.then parser.declaration' .text) @@ -1178,12 +1142,128 @@ (list#each ..decorate_input))))))) (meta.failure (exception.error ..insufficient_parameters [expected_arguments actual_arguments])))))) +(.type Get|Set + [External + (List [Member_Declaration FieldDecl]) + Text]) + +(context.def [get|set_context get|set_expression get|set_declaration] + Get|Set) + +(def privacy_modifier^^ + (Parser Privacy) + (all <>.or + (.this (' "public")) + (.this (' "private")) + (.this (' "protected")) + (.this (' "default")))) + +(def state_modifier^^ + (Parser State) + (all <>.or + (.this (' "volatile")) + (.this (' "final")) + (.this (' "default")))) + +(def field_decl^^ + (Parser [Member_Declaration FieldDecl]) + (<>.either (.form (do <>.monad + [_ (.this (' "constant")) + name .text + anns (.tuple (<>.some ..annotation^)) + type value^^ + value .any] + (in [[name {#PublicP} anns] {#ConstantField [type value]}]))) + (.form (do <>.monad + [_ (.this (' "variable")) + name .text + pm privacy_modifier^^ + sm state_modifier^^ + static? (<>.parses? (.this (' "static"))) + anns (.tuple (<>.some ..annotation^)) + type value^^] + (in [[name pm anns] {#VariableField [sm static? type]}]))))) + +(def with_get|set + (syntax (_ [declaration,fields,self (.tuple + (all <>.and + .text + (.tuple (<>.some field_decl^^)) + .text)) + body .any]) + (do meta.monad + [body (get|set_expression declaration,fields,self body)] + (in (list body))))) + +(with_template [] + [(exception .public ( [class Text + field Text]) + (exception.report + "Class" (%.text class) + "Field" (%.text field)))] + + [cannot_get_field] + [cannot_set_field] + ) + +(def .public get + (syntax (_ [field .local]) + (do meta.monad + [[class_name member,field/* self] (context.peek ..get|set_context) + .let [fields (|> member,field/* + (list#each (function (_ [member field]) + [(the #member_name member) [member field]])) + (dictionary.of_list text.hash))]] + (case (dictionary.value field fields) + {.#Some [member {#VariableField _ static? :field:}]} + (in (list (if static? + (` ("jvm member get static" + (~ (code.text class_name)) + (~ (code.text (the #member_name member))))) + (` ("jvm member get virtual" + (~ (code.text class_name)) + (~ (code.text (the #member_name member))) + (~ (code.local self))))))) + + _ + (meta.failure (exception.error ..cannot_get_field [class_name field])))))) + +(def .public set + (syntax (_ [field .local + value .any]) + (do meta.monad + [[class_name member,field/* self] (context.peek ..get|set_context) + .let [fields (|> member,field/* + (list#each (function (_ [member field]) + [(the #member_name member) [member field]])) + (dictionary.of_list text.hash))]] + (case (dictionary.value field fields) + {.#Some [member {#VariableField state static? :field:}]} + (case state + {#FinalS} + (meta.failure (exception.error ..cannot_set_field [class_name field])) + + _ + (in (list (if static? + (` ("jvm member put static" + (~ (code.text class_name)) + (~ (code.text (the #member_name member))) + (~ value))) + (` ("jvm member put virtual" + (~ (code.text class_name)) + (~ (code.text (the #member_name member))) + (~ value) + (~ (code.local self)))))))) + + _ + (meta.failure (exception.error ..cannot_set_field [class_name field])))))) + (def (method_def$ fully_qualified_class_name method_parser super_class fields [method_declaration method_def]) (-> External (Parser Code) (Type Class) (List [Member_Declaration FieldDecl]) [Member_Declaration Method_Definition] (Meta Code)) (let [[name pm anns] method_declaration] (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) + (let [replacer (|> (list) (list#mix <>.either method_parser) parser->replacer)] (meta#in (` ("init" @@ -1195,11 +1275,14 @@ (~ (code.text self_name)) [(~+ (list#each argument$ arguments))] [(~+ (list#each constructor_arg$ constructor_args))] - (~ (replaced replacer body)) + (<| ((~! ..with_get|set) [(~ (code.text fully_qualified_class_name)) + [(~+ (list#each field_decl$ fields))] + (~ (code.text self_name))]) + (~ (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) + (let [replacer (|> (list) (list#mix <>.either method_parser) parser->replacer)] (meta#in (` ("virtual" @@ -1213,10 +1296,14 @@ [(~+ (list#each argument$ arguments))] (~ (return$ return_type)) [(~+ (list#each class$ exs))] - (~ (replaced replacer body)))))) + (<| ((~! ..with_get|set) [(~ (code.text fully_qualified_class_name)) + [(~+ (list#each field_decl$ fields))] + (~ (code.text self_name))]) + (~ (replaced replacer body))) + )))) {#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) + (let [replacer (|> (list) (list#mix <>.either method_parser) parser->replacer)] (do meta.monad @@ -1231,15 +1318,18 @@ [(~+ (list#each argument$ expected_arguments))] (~ (return$ return_type)) [(~+ (list#each class$ exs))] - (~ (replaced replacer - (` (..with_super [(~ (declaration$ declaration)) - (~ (method_decl$$ [method_declaration - [#method_tvars type_vars - #method_inputs (list#each product.right expected_arguments) - #method_output return_type - #method_exs exs]])) - (~ (code.text self_name))] - (~ body)))))))))) + (<| ((~! ..with_super) [(~ (declaration$ declaration)) + (~ (method_decl$$ [method_declaration + [#method_tvars type_vars + #method_inputs (list#each product.right expected_arguments) + #method_output return_type + #method_exs exs]])) + (~ (code.text self_name))]) + ((~! ..with_get|set) [(~ (code.text fully_qualified_class_name)) + [(~+ (list#each field_decl$ fields))] + (~ (code.text self_name))]) + (~ (replaced replacer body))) + ))))) {#StaticMethod strict_fp? type_vars arguments return_type body exs} (let [replacer (parser->replacer (<>.failure ""))] diff --git a/stdlib/source/library/lux/macro/syntax.lux b/stdlib/source/library/lux/macro/syntax.lux index 380713ff0..5f8242c85 100644 --- a/stdlib/source/library/lux/macro/syntax.lux +++ b/stdlib/source/library/lux/macro/syntax.lux @@ -6,41 +6,35 @@ ["[0]" monad (.only do)]] [control ["<>" parser] - ["[0]" maybe] ["[0]" try]] [data ["[0]" text (.use "[1]#[0]" monoid)] [collection - ["[0]" list]]] - [math - [number - ["[0]" nat] - ["[0]" int] - ["[0]" rev] - ["[0]" frac]]]]] + ["[0]" list]]]]] ["[0]" // (.only with_symbols) ["[0]" code (.only) - ["" \\parser (.only Parser)]]] - ["[0]" / - ["[1][0]" export]]) + ["" \\parser (.only Parser)]]]) (def (self_documenting binding parser) (All (_ a) (-> Code (Parser a) (Parser a))) (function (_ tokens) (case (parser tokens) - {try.#Success [tokens output]} - {try.#Success [tokens output]} - {try.#Failure error} {try.#Failure (all text#composite "Failed to parse: " (code.format binding) text.new_line - error)}))) + error)} + + success + success))) (def (un_paired pairs) (All (_ a) (-> (List [a a]) (List a))) (case pairs - {.#End} {.#End} - {.#Item [[x y] pairs']} (list.partial x y (un_paired pairs')))) + {.#Item [x y] pairs'} + (list.partial x y (un_paired pairs')) + + {.#End} + {.#End})) (def syntaxP (Parser [[Text (Maybe Text) (List Code)] Code]) @@ -91,7 +85,9 @@ (is ((~! .Parser) (Meta (List Code))) ((~! do) (~! <>.monad) [(~+ (..un_paired vars+parsers))] - (.at (~! <>.monad) (~' in) (~ body)))) + (.at (~! <>.monad) (~' in) + (is (Meta (List Code)) + (~ body))))) (~ g!tokens)) {try.#Success (~ g!body)} ((~ g!body) (~ g!state)) diff --git a/stdlib/source/library/lux/target/jvm.lux b/stdlib/source/library/lux/target/jvm.lux deleted file mode 100644 index a19962aab..000000000 --- a/stdlib/source/library/lux/target/jvm.lux +++ /dev/null @@ -1,313 +0,0 @@ -(.require - [library - [lux (.except Type Primitive Label) - [data - [collection - [sequence (.only Sequence)]]] - [target - [jvm - [type (.only Type) - ["[0]" category (.only Primitive Class Value Method)]]]]]]) - -(type .public Literal - (Variant - {#Boolean Bit} - {#Int Int} - {#Long Int} - {#Double Frac} - {#Char Nat} - {#String Text})) - -(type .public Constant - (Variant - {#BIPUSH Int} - - {#SIPUSH Int} - - {#ICONST_M1} - {#ICONST_0} - {#ICONST_1} - {#ICONST_2} - {#ICONST_3} - {#ICONST_4} - {#ICONST_5} - - {#LCONST_0} - {#LCONST_1} - - {#FCONST_0} - {#FCONST_1} - {#FCONST_2} - - {#DCONST_0} - {#DCONST_1} - - {#ACONST_NULL} - - {#LDC Literal})) - -(type .public Int_Arithmetic - (Variant - {#IADD} - {#ISUB} - {#IMUL} - {#IDIV} - {#IREM} - {#INEG})) - -(type .public Long_Arithmetic - (Variant - {#LADD} - {#LSUB} - {#LMUL} - {#LDIV} - {#LREM} - {#LNEG})) - -(type .public Float_Arithmetic - (Variant - {#FADD} - {#FSUB} - {#FMUL} - {#FDIV} - {#FREM} - {#FNEG})) - -(type .public Double_Arithmetic - (Variant - {#DADD} - {#DSUB} - {#DMUL} - {#DDIV} - {#DREM} - {#DNEG})) - -(type .public Arithmetic - (Variant - {#Int_Arithmetic Int_Arithmetic} - {#Long_Arithmetic Long_Arithmetic} - {#Float_Arithmetic Float_Arithmetic} - {#Double_Arithmetic Double_Arithmetic})) - -(type .public Int_Bitwise - (Variant - {#IOR} - {#IXOR} - {#IAND} - {#ISHL} - {#ISHR} - {#IUSHR})) - -(type .public Long_Bitwise - (Variant - {#LOR} - {#LXOR} - {#LAND} - {#LSHL} - {#LSHR} - {#LUSHR})) - -(type .public Bitwise - (Variant - {#Int_Bitwise Int_Bitwise} - {#Long_Bitwise Long_Bitwise})) - -(type .public Conversion - (Variant - {#I2B} - {#I2S} - {#I2L} - {#I2F} - {#I2D} - {#I2C} - - {#L2I} - {#L2F} - {#L2D} - - {#F2I} - {#F2L} - {#F2D} - - {#D2I} - {#D2L} - {#D2F})) - -(type .public Array - (Variant - {#ARRAYLENGTH} - - {#NEWARRAY (Type Primitive)} - {#ANEWARRAY (Type category.Object)} - - {#BALOAD} - {#BASTORE} - - {#SALOAD} - {#SASTORE} - - {#IALOAD} - {#IASTORE} - - {#LALOAD} - {#LASTORE} - - {#FALOAD} - {#FASTORE} - - {#DALOAD} - {#DASTORE} - - {#CALOAD} - {#CASTORE} - - {#AALOAD} - {#AASTORE})) - -(type .public Object - (Variant - {#GETSTATIC (Type Class) Text (Type Value)} - {#PUTSTATIC (Type Class) Text (Type Value)} - - {#NEW (Type Class)} - - {#INSTANCEOF (Type Class)} - {#CHECKCAST (Type category.Object)} - - {#GETFIELD (Type Class) Text (Type Value)} - {#PUTFIELD (Type Class) Text (Type Value)} - - {#INVOKEINTERFACE (Type Class) Text (Type Method)} - {#INVOKESPECIAL (Type Class) Text (Type Method)} - {#INVOKESTATIC (Type Class) Text (Type Method)} - {#INVOKEVIRTUAL (Type Class) Text (Type Method)})) - -(type .public Register - Nat) - -(type .public Local_Int - (Variant - {#ILOAD Register} - {#ISTORE Register})) - -(type .public Local_Long - (Variant - {#LLOAD Register} - {#LSTORE Register})) - -(type .public Local_Float - (Variant - {#FLOAD Register} - {#FSTORE Register})) - -(type .public Local_Double - (Variant - {#DLOAD Register} - {#DSTORE Register})) - -(type .public Local_Object - (Variant - {#ALOAD Register} - {#ASTORE Register})) - -(type .public Local - (Variant - {#Local_Int Local_Int} - {#IINC Register} - {#Local_Long Local_Long} - {#Local_Float Local_Float} - {#Local_Double Local_Double} - {#Local_Object Local_Object})) - -(type .public Stack - (Variant - {#DUP} - {#DUP_X1} - {#DUP_X2} - {#DUP2} - {#DUP2_X1} - {#DUP2_X2} - {#SWAP} - {#POP} - {#POP2})) - -(type .public Comparison - (Variant - {#LCMP} - - {#FCMPG} - {#FCMPL} - - {#DCMPG} - {#DCMPL})) - -(type .public Label - Nat) - -(type .public (Branching label) - (Variant - {#IF_ICMPEQ label} - {#IF_ICMPGE label} - {#IF_ICMPGT label} - {#IF_ICMPLE label} - {#IF_ICMPLT label} - {#IF_ICMPNE label} - {#IFEQ label} - {#IFNE label} - {#IFGE label} - {#IFGT label} - {#IFLE label} - {#IFLT label} - - {#TABLESWITCH Int Int label (List label)} - {#LOOKUPSWITCH label (List [Int label])} - - {#IF_ACMPEQ label} - {#IF_ACMPNE label} - {#IFNONNULL label} - {#IFNULL label})) - -(type .public (Exception label) - (Variant - {#Try label label label (Type Class)} - {#ATHROW})) - -(type .public Concurrency - (Variant - {#MONITORENTER} - {#MONITOREXIT})) - -(type .public Return - (Variant - {#RETURN} - {#IRETURN} - {#LRETURN} - {#FRETURN} - {#DRETURN} - {#ARETURN})) - -(type .public (Control label) - (Variant - {#GOTO label} - {#Branching (Branching label)} - {#Exception (Exception label)} - {#Concurrency Concurrency} - {#Return Return})) - -(type .public (Instruction embedded label) - (Variant - {#NOP} - {#Constant Constant} - {#Arithmetic Arithmetic} - {#Bitwise Bitwise} - {#Conversion Conversion} - {#Array Array} - {#Object Object} - {#Local Local} - {#Stack Stack} - {#Comparison Comparison} - {#Control (Control label)} - {#Embedded embedded})) - -(type .public (Bytecode embedded label) - (Sequence (Instruction embedded label))) 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 eb523d7e0..9530cb8dd 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 @@ -1902,6 +1902,106 @@ (.tuple (<>.some ..input)) .any))) +(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 (hidden_method_body arity bodyA) + (-> Nat Analysis Analysis) + (<| /////analysis.tuple + (list (/////analysis.unit)) + (case arity + (^.or 0 1) + bodyA + + 2 + (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices (++ arity))))] + {/////analysis.#Case (/////analysis.unit) + [[/////analysis.#when + {pattern.#Bind 2} + + /////analysis.#then + (/////analysis.tuple (list forced_refencing bodyA))] + (list)]}) + + _ + (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices (++ arity))))] + {/////analysis.#Case (/////analysis.unit) + [[/////analysis.#when + {pattern.#Complex + {complex.#Tuple + (|> (-- arity) + list.indices + (list#each (|>> (n.+ 2) {pattern.#Bind})))}} + + /////analysis.#then + (/////analysis.tuple (list forced_refencing bodyA))] + (list)]})))) + (def .public (analyse_constructor_method analyse archive selfT mapping method) (-> Phase Archive .Type Mapping (Constructor Code) (Operation Analysis)) (let [[visibility strict_fp? @@ -1936,7 +2036,8 @@ list.reversed (list#mix scope.with_local (analyse archive body)) (typeA.expecting .Any) - scope.with)] + scope.with) + .let [arity (list.size arguments)]] (in (/////analysis.tuple (list (/////analysis.text ..constructor_tag) (visibility_analysis visibility) (/////analysis.bit strict_fp?) @@ -1949,7 +2050,10 @@ {/////analysis.#Function (list#each (|>> /////analysis.variable) (scope.environment scope)) - (/////analysis.tuple (list bodyA))} + (<| (..hidden_method_body arity) + (case arity + 0 (with_fake_parameter bodyA) + _ bodyA))} )))))) (.type .public (Virtual_Method a) @@ -2034,7 +2138,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 ..virtual_tag) (/////analysis.text method_name) (visibility_analysis visibility) @@ -2049,7 +2154,10 @@ {/////analysis.#Function (list#each (|>> /////analysis.variable) (scope.environment scope)) - (/////analysis.tuple (list bodyA))} + (<| (..hidden_method_body arity) + (case arity + 0 (with_fake_parameter bodyA) + _ bodyA))} )))))) (.type .public (Static_Method a) @@ -2205,106 +2313,6 @@ mapping override_mapping)))) -(def .public (hidden_method_body arity bodyA) - (-> Nat Analysis Analysis) - (<| /////analysis.tuple - (list (/////analysis.unit)) - (case arity - (^.or 0 1) - bodyA - - 2 - (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices (++ arity))))] - {/////analysis.#Case (/////analysis.unit) - [[/////analysis.#when - {pattern.#Bind 2} - - /////analysis.#then - (/////analysis.tuple (list forced_refencing bodyA))] - (list)]}) - - _ - (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices (++ arity))))] - {/////analysis.#Case (/////analysis.unit) - [[/////analysis.#when - {pattern.#Complex - {complex.#Tuple - (|> (-- arity) - list.indices - (list#each (|>> (n.+ 2) {pattern.#Bind})))}} - - /////analysis.#then - (/////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 diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/jvm.lux index 9fdfb4d7c..f43c26adf 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/jvm.lux @@ -459,7 +459,10 @@ (-> Archive (Type Class) (jvm.Constructor Synthesis) (Operation (Resource Method))) (<| (let [[privacy strict_floating_point? annotations method_tvars exceptions self arguments constructor_argumentsS - bodyS] method]) + bodyS] method + bodyS (case (list.size arguments) + 0 (host.without_fake_parameter bodyS) + _ bodyS)]) (do [! phase.monad] [generate declaration.generation]) declaration.lifted_generation @@ -560,7 +563,10 @@ (do [! phase.monad] [.let [[method_name privacy final? 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 declaration.generation] (declaration.lifted_generation (do ! diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux index f22bb70c1..6edf7e3ac 100644 --- a/stdlib/source/test/lux/ffi.jvm.lux +++ b/stdlib/source/test/lux/ffi.jvm.lux @@ -381,11 +381,11 @@ ("private" value java/lang/Long) ... Constructors ("public" [] (new self [value java/lang/Long]) [] - (:= ::value value)) + (/.set value value)) ... Methods (test/TestInterface0 [] (actual0 self []) java/lang/Long - ::value)) + (/.get value))) (/.import test/TestClass0 "[1]::[0]" @@ -396,13 +396,13 @@ ("private" value java/lang/Long) ... Constructors ("public" [] (new self [value java/lang/Long]) [] - (:= ::value value)) + (/.set value value)) ... Methods (test/TestInterface1 [] (actual1 self [throw? java/lang/Boolean]) java/lang/Long "throws" [java/lang/Throwable] (if (not (/.of_boolean throw?)) - ::value + (/.get value) (panic! "YOLO")))) (/.import test/TestClass1 @@ -428,12 +428,12 @@ ("private" value a) ... Constructors ("public" [] (new self [value a]) [] - (:= ::value value)) + (/.set value value)) ... Methods ((test/TestInterface3 a) [] (actual3 self []) a - ::value)) + (/.get value))) (/.import (test/TestClass3 a) "[1]::[0]" @@ -513,12 +513,12 @@ ("private" value9 a) ... Constructors ("public" [] (new self [value a]) [] - (:= ::value9 value)) + (/.set value9 value)) ... Methods ("public" (set_actual9 self [value a]) void - (:= ::value9 value)) + (/.set value9 value)) ("public" (get_actual9 self []) a - ::value9)) + (/.get value9))) (/.import (test/TestClass9 a) "[1]::[0]" @@ -531,7 +531,7 @@ ("public" value10 a) ... Constructors ("public" [] (new self [init a]) [] - (:= ::value10 init))) + (/.set value10 init))) (/.import (test/TestClass10 a) "[1]::[0]" @@ -543,7 +543,7 @@ ("public" value11 a) ... Constructors ("public" [] (new self [init a]) [] - (:= ::value11 init))) + (/.set value11 init))) (/.import (test/TestClass11 a) "[1]::[0]" -- cgit v1.2.3