From 8023df0f5dae4638021fef7b8194a3d0a16b32e4 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 1 Mar 2022 02:29:52 -0400 Subject: Still more fixes for JVM interop. --- .../lux/data/collection/dictionary/plist.lux | 16 ++- stdlib/source/library/lux/ffi.jvm.lux | 26 +++-- .../source/library/lux/target/jvm/reflection.lux | 124 ++++++++++----------- stdlib/source/library/lux/target/jvm/type.lux | 4 +- .../library/lux/target/jvm/type/category.lux | 2 +- .../library/lux/target/jvm/type/descriptor.lux | 4 +- .../source/library/lux/target/jvm/type/parser.lux | 90 ++++++++------- .../library/lux/target/jvm/type/reflection.lux | 4 +- .../library/lux/target/jvm/type/signature.lux | 2 +- .../tool/compiler/language/lux/analysis/type.lux | 5 +- .../language/lux/phase/analysis/function.lux | 69 ++++++------ .../language/lux/phase/extension/analysis/jvm.lux | 110 +++++++++--------- .../language/lux/phase/generation/jvm/case.lux | 35 +++--- .../compiler/language/lux/phase/synthesis/case.lux | 21 ++-- .../lux/tool/compiler/language/lux/synthesis.lux | 74 ++++++------ .../tool/compiler/language/lux/synthesis/side.lux | 34 ++++++ .../compiler/language/lux/synthesis/simple.lux | 8 +- .../test/lux/data/collection/dictionary/plist.lux | 7 +- stdlib/source/test/lux/tool.lux | 4 +- .../tool/compiler/language/lux/synthesis/side.lux | 43 +++++++ 20 files changed, 402 insertions(+), 280 deletions(-) create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/synthesis/side.lux create mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/synthesis/side.lux (limited to 'stdlib') diff --git a/stdlib/source/library/lux/data/collection/dictionary/plist.lux b/stdlib/source/library/lux/data/collection/dictionary/plist.lux index 7eb2f4001..6ba497f34 100644 --- a/stdlib/source/library/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/library/lux/data/collection/dictionary/plist.lux @@ -4,6 +4,8 @@ [abstract [equivalence {"+" Equivalence}] [monoid {"+" Monoid}]] + [control + ["[0]" maybe ("[1]#[0]" functor)]] [data ["[0]" product] ["[0]" text ("[1]#[0]" equivalence)] @@ -94,10 +96,18 @@ {.#Item [k' v'] (lacks key properties')}))) -(def: .public equivalence +(implementation: .public (equivalence (^open "/#[0]")) (All (_ a) (-> (Equivalence a) (Equivalence (PList a)))) - (|>> (product.equivalence text.equivalence) - list.equivalence)) + + (def: (= reference subject) + (and (n.= (list.size reference) + (list.size subject)) + (list.every? (function (_ [key val]) + (|> reference + (..value key) + (maybe#each (/#= val)) + (maybe.else false))) + subject)))) (implementation: .public monoid (All (_ a) (Monoid (PList a))) diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index b43a1b122..f5f804fee 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -360,8 +360,9 @@ ... else (undefined)))) -(def: (parameter_type type) - (-> (Type Parameter) Code) +(def: (parameter_type value_type type) + (-> (-> (Type Value) Code) + (-> (Type Parameter) Code)) (`` (<| (~~ (template [ ] [(case ( type) {.#Some } @@ -372,10 +373,18 @@ [parser.var? name (code.symbol ["" name])] [parser.wildcard? _ (` .Any)] [parser.lower? _ (` .Any)] - [parser.upper? limit (parameter_type limit)] + [parser.upper? limit (parameter_type value_type limit)] [parser.class? [name parameters] (` (.Primitive (~ (code.text name)) - [(~+ (list#each parameter_type parameters))]))])) + [(~+ (list#each (parameter_type value_type) parameters))]))] + [parser.array? elementT + (case (parser.primitive? elementT) + {.#Some elementT} + (` {.#Primitive (~ (code.text (..reflection (type.array elementT)))) {.#End}}) + + {.#None} + (` {.#Primitive (~ (code.text array.type_name)) + {.#Item (~ (value_type elementT)) {.#End}}}))])) ... else (undefined) ))) @@ -389,15 +398,8 @@ {.#None})] - [parser.parameter? type (parameter_type type)] [parser.primitive? type (primitive_type mode type)] - [parser.array? elementT (case (parser.primitive? elementT) - {.#Some elementT} - (` {.#Primitive (~ (code.text (..reflection (type.array elementT)))) {.#End}}) - - {.#None} - (` {.#Primitive (~ (code.text array.type_name)) - {.#Item (~ (value_type mode elementT)) {.#End}}}))])) + [parser.parameter? type (parameter_type (value_type mode) type)])) (undefined) ))) diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux index 1462acd76..f8cce5214 100644 --- a/stdlib/source/library/lux/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/reflection.lux @@ -1,34 +1,34 @@ (.using - [library - [lux {"-" Primitive type} - ["[0]" ffi {"+" import:}] - ["[0]" type] - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}] - [parser - ["" text]]] - [data - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" mix functor)] - ["[0]" array] - ["[0]" dictionary]]] - [math - [number - ["n" nat]]]]] - ["[0]" // "_" - [encoding - ["[1][0]" name {"+" External}]] - ["/" type - [category {"+" Void Value Return Method Primitive Object Class Array Parameter}] - ["[1][0]" lux {"+" Mapping}] - ["[1][0]" descriptor] - ["[1][0]" reflection] - ["[1][0]" parser]]]) + [library + [lux {"-" Primitive type} + ["[0]" ffi {"+" import:}] + ["[0]" type] + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}] + [parser + ["" text]]] + [data + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" mix functor)] + ["[0]" array] + ["[0]" dictionary]]] + [math + [number + ["n" nat]]]]] + ["[0]" // "_" + [encoding + ["[1][0]" name {"+" External}]] + ["/" type + [category {"+" Void Value Return Method Primitive Object Class Array Parameter}] + ["[1][0]" lux {"+" Mapping}] + ["[1][0]" descriptor] + ["[1][0]" reflection] + ["[1][0]" parser]]]) (import: java/lang/String) @@ -105,11 +105,11 @@ (def: .public (load class_loader name) (-> java/lang/ClassLoader External (Try (java/lang/Class java/lang/Object))) (case (java/lang/Class::forName name false class_loader) - {try.#Success class} - {try.#Success class} - {try.#Failure _} - (exception.except ..unknown_class [name]))) + (exception.except ..unknown_class [name]) + + success + success)) (def: .public (sub? class_loader super sub) (-> java/lang/ClassLoader External External (Try Bit)) @@ -140,7 +140,7 @@ [/reflection.double] [/reflection.char])) (text.starts_with? /descriptor.array_prefix class_name)) - (exception.except ..not_a_class reflection) + (exception.except ..not_a_class [reflection]) {try.#Success (/.class class_name (list))}))) _) (case (ffi.check java/lang/reflect/ParameterizedType reflection) @@ -148,15 +148,14 @@ (let [raw (java/lang/reflect/ParameterizedType::getRawType reflection)] (case (ffi.check java/lang/Class raw) {.#Some raw} - (do [! try.monad] - [paramsT (|> reflection - java/lang/reflect/ParameterizedType::getActualTypeArguments - (array.list {.#None}) - (monad.each ! parameter))] - (in (/.class (|> raw - (:as (java/lang/Class java/lang/Object)) - java/lang/Class::getName) - paramsT))) + (let [! try.monad] + (|> reflection + java/lang/reflect/ParameterizedType::getActualTypeArguments + (array.list {.#None}) + (monad.each ! parameter) + (# ! each (/.class (|> raw + (:as (java/lang/Class java/lang/Object)) + java/lang/Class::getName))))) _ (exception.except ..not_a_class [raw]))) @@ -164,8 +163,9 @@ ... else (exception.except ..cannot_convert_to_a_lux_type [reflection]))) -(def: .public (parameter reflection) - (-> java/lang/reflect/Type (Try (/.Type Parameter))) +(def: .public (parameter type reflection) + (-> (-> java/lang/reflect/Type (Try (/.Type Value))) + (-> java/lang/reflect/Type (Try (/.Type Parameter)))) (<| (case (ffi.check java/lang/reflect/TypeVariable reflection) {.#Some reflection} {try.#Success (/.var (java/lang/reflect/TypeVariable::getName reflection))} @@ -179,25 +179,27 @@ (^template [ ] [ (case (ffi.check java/lang/reflect/GenericArrayType bound) - {.#Some _} + {.#Some it} ... TODO: Array bounds should not be "erased" as they ... are right now. {try.#Success /.wildcard} _ - (# try.monad each (..class' parameter bound)))]) + (# try.monad each (parameter type bound)))]) ([[_ {.#Some bound}] /.upper] [[{.#Some bound} _] /.lower]) _ {try.#Success /.wildcard}) _) - (..class' parameter reflection))) - -(def: .public class - (-> java/lang/reflect/Type - (Try (/.Type Class))) - (..class' ..parameter)) + (case (ffi.check java/lang/reflect/GenericArrayType reflection) + {.#Some reflection} + (|> reflection + java/lang/reflect/GenericArrayType::getGenericComponentType + type + (# try.monad each /.array)) + _) + (..class' (parameter type) reflection))) (def: .public (type reflection) (-> java/lang/reflect/Type (Try (/.Type Value))) @@ -223,15 +225,13 @@ (.result /parser.value (|> class_name //name.internal //name.read)) {try.#Success (/.class class_name (list))})))) _) - (case (ffi.check java/lang/reflect/GenericArrayType reflection) - {.#Some reflection} - (|> reflection - java/lang/reflect/GenericArrayType::getGenericComponentType - type - (# try.monad each /.array)) - _) ... else - (..parameter reflection))) + (..parameter type reflection))) + +(def: .public class + (-> java/lang/reflect/Type + (Try (/.Type Class))) + (..class' (..parameter ..type))) (def: .public (return reflection) (-> java/lang/reflect/Type (Try (/.Type Return))) diff --git a/stdlib/source/library/lux/target/jvm/type.lux b/stdlib/source/library/lux/target/jvm/type.lux index 9f4e3ad06..c4de519c3 100644 --- a/stdlib/source/library/lux/target/jvm/type.lux +++ b/stdlib/source/library/lux/target/jvm/type.lux @@ -119,7 +119,7 @@ /reflection.var])) (def: .public (lower bound) - (-> (Type Class) (Type Parameter)) + (-> (Type Parameter) (Type Parameter)) (:abstraction (let [[signature descriptor reflection] (:representation bound)] [(/signature.lower signature) @@ -127,7 +127,7 @@ (/reflection.lower reflection)]))) (def: .public (upper bound) - (-> (Type Class) (Type Parameter)) + (-> (Type Parameter) (Type Parameter)) (:abstraction (let [[signature descriptor reflection] (:representation bound)] [(/signature.upper signature) diff --git a/stdlib/source/library/lux/target/jvm/type/category.lux b/stdlib/source/library/lux/target/jvm/type/category.lux index 207c304a5..45128d756 100644 --- a/stdlib/source/library/lux/target/jvm/type/category.lux +++ b/stdlib/source/library/lux/target/jvm/type/category.lux @@ -30,7 +30,7 @@ [[] Primitive] [[Object' Parameter'] Var] [[Object' Parameter'] Class] - [[Object'] Array] + [[Object' Parameter'] Array] ) (abstract: .public Declaration Any) diff --git a/stdlib/source/library/lux/target/jvm/type/descriptor.lux b/stdlib/source/library/lux/target/jvm/type/descriptor.lux index e89b8ed06..d09a5d94f 100644 --- a/stdlib/source/library/lux/target/jvm/type/descriptor.lux +++ b/stdlib/source/library/lux/target/jvm/type/descriptor.lux @@ -73,11 +73,11 @@ ) (def: .public (lower descriptor) - (-> (Descriptor Class) (Descriptor Parameter)) + (-> (Descriptor Parameter) (Descriptor Parameter)) ..wildcard) (def: .public upper - (-> (Descriptor Class) (Descriptor Parameter)) + (-> (Descriptor Parameter) (Descriptor Parameter)) (|>> :transmutation)) (def: .public array_prefix "[") diff --git a/stdlib/source/library/lux/target/jvm/type/parser.lux b/stdlib/source/library/lux/target/jvm/type/parser.lux index 76289b082..8c896e9f1 100644 --- a/stdlib/source/library/lux/target/jvm/type/parser.lux +++ b/stdlib/source/library/lux/target/jvm/type/parser.lux @@ -1,26 +1,26 @@ (.using - [library - [lux {"-" Type Primitive int char} - [abstract - [monad {"+" do}]] - [control - ["[0]" try] - ["[0]" function] - ["<>" parser ("[1]#[0]" monad) - ["<[0]>" text {"+" Parser}]]] - [data - ["[0]" product] - [text - ["%" format {"+" format}]] - [collection - ["[0]" list]]]]] - ["[0]" // {"+" Type} - [category {"+" Void Value Return Method Primitive Object Class Array Var Parameter Declaration}] - ["[1][0]" signature] - ["[1][0]" descriptor] - ["[0]" // "_" - [encoding - ["[1][0]" name {"+" External}]]]]) + [library + [lux {"-" Type Primitive int char} + [abstract + [monad {"+" do}]] + [control + ["[0]" try] + ["[0]" function] + ["<>" parser ("[1]#[0]" monad) + ["<[0]>" text {"+" Parser}]]] + [data + ["[0]" product] + [text + ["%" format {"+" format}]] + [collection + ["[0]" list]]]]] + ["[0]" // {"+" Type} + [category {"+" Void Value Return Method Primitive Object Class Array Var Parameter Declaration}] + ["[1][0]" signature] + ["[1][0]" descriptor] + ["[0]" // "_" + [encoding + ["[1][0]" name {"+" External}]]]]) (template [ ] [(def: .public @@ -102,7 +102,7 @@ (template [ ] [(def: - (-> (Parser (Type Class)) (Parser (Type Parameter))) + (-> (Parser (Type Parameter)) (Parser (Type Parameter))) (|>> (<>.after (.this )) (<>#each )))] @@ -127,23 +127,37 @@ (|>> ..class'' (# <>.monad each (product.uncurried //.class)))) -(def: .public parameter - (Parser (Type Parameter)) +(def: .public array' + (-> (Parser (Type Value)) (Parser (Type Array))) + (|>> (<>.after (.this //descriptor.array_prefix)) + (<>#each //.array))) + +(def: (parameter' value) + (-> (Parser (Type Value)) (Parser (Type Parameter))) (<>.rec (function (_ parameter) (let [class (..class' parameter)] ($_ <>.either ..var ..wildcard - (..lower class) - (..upper class) + (..lower parameter) + (..upper parameter) + (..array' value) class ))))) -(def: .public array' - (-> (Parser (Type Value)) (Parser (Type Array))) - (|>> (<>.after (.this //descriptor.array_prefix)) - (<>#each //.array))) +(def: .public value + (Parser (Type Value)) + (<>.rec + (function (_ value) + ($_ <>.either + ..primitive + (..parameter' value) + )))) + +(def: .public parameter + (Parser (Type Parameter)) + (..parameter' ..value)) (def: .public class (Parser (Type Class)) @@ -151,10 +165,10 @@ (template [ ] [(def: .public - (-> (Type Value) (Maybe (Type Class))) + (-> (Type Value) (Maybe (Type Parameter))) (|>> //.signature //signature.signature - (.result (<>.after (.this ) ..class)) + (.result (<>.after (.this ) ..parameter)) try.maybe))] [lower? //signature.lower_prefix //.lower] @@ -168,16 +182,6 @@ (.result (..class'' ..parameter)) try.trusted)) -(def: .public value - (Parser (Type Value)) - (<>.rec - (function (_ value) - ($_ <>.either - ..primitive - ..parameter - (..array' value) - )))) - (def: .public array (Parser (Type Array)) (..array' ..value)) diff --git a/stdlib/source/library/lux/target/jvm/type/reflection.lux b/stdlib/source/library/lux/target/jvm/type/reflection.lux index 8915f5375..f4df7e88b 100644 --- a/stdlib/source/library/lux/target/jvm/type/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/type/reflection.lux @@ -95,10 +95,10 @@ ) (def: .public (lower reflection) - (-> (Reflection Class) (Reflection Parameter)) + (-> (Reflection Parameter) (Reflection Parameter)) ..wildcard) (def: .public upper - (-> (Reflection Class) (Reflection Parameter)) + (-> (Reflection Parameter) (Reflection Parameter)) (|>> :transmutation)) ) diff --git a/stdlib/source/library/lux/target/jvm/type/signature.lux b/stdlib/source/library/lux/target/jvm/type/signature.lux index ee93afa32..aa733a4e9 100644 --- a/stdlib/source/library/lux/target/jvm/type/signature.lux +++ b/stdlib/source/library/lux/target/jvm/type/signature.lux @@ -71,7 +71,7 @@ (template [ ] [(def: .public - (-> (Signature Class) (Signature Parameter)) + (-> (Signature Parameter) (Signature Parameter)) (|>> :representation (format ) :abstraction))] [lower ..lower_prefix] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux index 0ac407738..e8f045d1e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux @@ -111,8 +111,9 @@ ))) (def: .public (with_var it) - (All (_ a) (-> (-> [check.Var Type] (Operation a)) - (Operation a))) + (All (_ a) + (-> (-> [check.Var Type] (Operation a)) + (Operation a))) (do phase.monad [@it,:it: (..check check.var) it (it @it,:it:) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux index 1365d0e1e..118a5da91 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -56,8 +56,8 @@ (def: .public (function analyse function_name arg_name archive body) (-> Phase Text Text Phase) (do [! ///.monad] - [:function: (///extension.lifted meta.expected_type)] - (loop [expectedT :function:] + [expectedT (///extension.lifted meta.expected_type)] + (loop [expectedT expectedT] (/.with_exception ..cannot_analyse [expectedT function_name arg_name body] (case expectedT {.#Function :input: :output:} @@ -73,8 +73,8 @@ (/type.expecting :output:) (analyse archive body)) - {.#Named name unnamedT} - (again unnamedT) + {.#Named name :anonymous:} + (again :anonymous:) {.#Apply argT funT} (case (type.applied (list argT) funT) @@ -84,13 +84,15 @@ {.#None} (/.failure (exception.error ..cannot_analyse [expectedT function_name arg_name body]))) - (^template [ ] - [{ _} - (do ! - [[_ instanceT] (/type.check )] - (again (maybe.trusted (type.applied (list instanceT) expectedT))))]) - ([.#UnivQ check.existential] - [.#ExQ check.var]) + {.#UnivQ _} + (do ! + [[@instance :instance:] (/type.check check.existential)] + (again (maybe.trusted (type.applied (list :instance:) expectedT)))) + + {.#ExQ _} + (<| /type.with_var + (.function (_ [@instance :instance:])) + (again (maybe.trusted (type.applied (list :instance:) expectedT)))) {.#Var id} (do ! @@ -101,27 +103,32 @@ ... Inference _ - (do ! - [[@input :input:] (/type.check check.var) - [@output :output:] (/type.check check.var) - .let [:function: {.#Function :input: :output:}] - functionA (again :function:) - specialization (/type.check (check.try (check.identity (list @output) @input))) - :function: (case specialization - {try.#Success :input:'} - (in :function:) + (<| /type.with_var + (.function (_ [@input :input:])) + /type.with_var + (.function (_ [@output :output:])) + (do ! + [functionA (again {.#Function :input: :output:})]) + /type.check + (do check.monad + [:output: (check.identity (list) @output) + ?:input: (check.try (check.identity (list @output) @input)) + ? (check.linked? @input @output) + _ (<| (check.check expectedT) + (case ?:input: + {try.#Success :input:} + {.#Function :input: (if ? + :input: + :output:)} - {try.#Failure _} - (/type.check - (do [! check.monad] - [? (check.linked? @input @output)] - (# ! each - (|>> {.#Function :input:} (/inference.quantified @input 1) {.#UnivQ (list)}) - (if ? - (in :input:) - (check.identity (list @input) @output)))))) - _ (/type.check (check.check expectedT :function:))] - (in functionA)))) + {try.#Failure _} + (|> (if ? + :input: + :output:) + {.#Function :input:} + (/inference.quantified @input 1) + {.#UnivQ (list)})))] + (in functionA))))) _ (/.failure "") 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 22e29dd08..132ceca10 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 @@ -8,7 +8,7 @@ ["[0]" predicate]] [control pipe - ["[0]" maybe] + ["[0]" maybe ("[1]#[0]" functor)] ["[0]" try {"+" Try} ("[1]#[0]" monad)] ["[0]" exception {"+" exception:}] ["<>" parser @@ -255,13 +255,17 @@ ) (template [] - [(exception: .public ( [class External + [(exception: .public ( [class_variables (List (Type Var)) + class External method Text + method_variables (List (Type Var)) inputsJT (List (Type Value)) hints (List Method_Signature)]) (exception.report + ["Class Variables" (exception.listing ..signature class_variables)] ["Class" class] ["Method" method] + ["Method Variables" (exception.listing ..signature method_variables)] ["Arguments" (exception.listing ..signature inputsJT)] ["Hints" (exception.listing %.type (list#each product.left hints))]))] @@ -1127,6 +1131,34 @@ {#Special} {#Interface})) +(def: (de_aliased aliasing) + (-> Aliasing (Type Value) (Type Value)) + (function (again it) + (`` (<| (case (parser.var? it) + {.#Some name} + (|> aliasing + (dictionary.value name) + (maybe#each jvm.var) + (maybe.else it)) + {.#None}) + (case (parser.class? it) + {.#Some [name parameters]} + (|> parameters + (list#each (|>> again (:as (Type Parameter)))) + (jvm.class name)) + {.#None}) + (~~ (template [ ] + [(case ( it) + {.#Some :sub:} + ( (:as (Type ) (again :sub:))) + {.#None})] + + [parser.array? Value jvm.array] + [parser.lower? Class jvm.lower] + [parser.upper? Class jvm.upper] + )) + it)))) + (def: (check_method aliasing class method_name method_style inputsJT method) (-> Aliasing (java/lang/Class java/lang/Object) Text Method_Style (List (Type Value)) java/lang/reflect/Method (Operation Bit)) (do phase.monad @@ -1137,41 +1169,28 @@ .let [modifiers (java/lang/reflect/Method::getModifiers method) correct_class? (java/lang/Object::equals class (java/lang/reflect/Method::getDeclaringClass method)) correct_method? (text#= method_name (java/lang/reflect/Method::getName method)) - static_matches? (case method_style - {#Static} - (java/lang/reflect/Modifier::isStatic modifiers) - - _ - true) - special_matches? (case method_style - {#Special} - (not (or (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class)) - (java/lang/reflect/Modifier::isAbstract modifiers))) - - _ - true) - arity_matches? (n.= (list.size inputsJT) (list.size parameters)) - inputs_match? (and arity_matches? - (list#mix (function (_ [expectedJC actualJC] prev) - (and prev - (jvm#= expectedJC (: (Type Value) - (case (parser.var? actualJC) - {.#Some name} - (|> aliasing - (dictionary.value name) - (maybe.else name) - jvm.var) - - {.#None} - actualJC))))) - true - (list.zipped/2 parameters inputsJT)))]] + same_static? (case method_style + {#Static} + (java/lang/reflect/Modifier::isStatic modifiers) + + _ + true) + same_special? (case method_style + {#Special} + (not (or (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class)) + (java/lang/reflect/Modifier::isAbstract modifiers))) + + _ + true) + same_inputs? (and (n.= (list.size inputsJT) (list.size parameters)) + (list.every? (function (_ [expectedJC actualJC]) + (jvm#= expectedJC (de_aliased aliasing actualJC))) + (list.zipped/2 parameters inputsJT)))]] (in (and correct_class? correct_method? - static_matches? - special_matches? - arity_matches? - inputs_match?)))) + same_static? + same_special? + same_inputs?)))) (def: (check_constructor aliasing class inputsJT constructor) (-> Aliasing (java/lang/Class java/lang/Object) (List (Type Value)) (java/lang/reflect/Constructor java/lang/Object) (Operation Bit)) @@ -1183,16 +1202,7 @@ (in (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor)) (n.= (list.size inputsJT) (list.size parameters)) (list.every? (function (_ [expectedJC actualJC]) - (jvm#= expectedJC (: (Type Value) - (case (parser.var? actualJC) - {.#Some name} - (|> aliasing - (dictionary.value name) - (maybe.else name) - jvm.var) - - {.#None} - actualJC)))) + (jvm#= expectedJC (de_aliased aliasing actualJC))) (list.zipped/2 parameters inputsJT)))))) (def: index_parameter @@ -1380,10 +1390,10 @@ (in method) {.#End} - (/////analysis.except ..no_candidates [class_name method_name inputsJT (list.all hint! candidates)]) + (/////analysis.except ..no_candidates [actual_class_tvars class_name method_name actual_method_tvars inputsJT (list.all hint! candidates)]) candidates - (/////analysis.except ..too_many_candidates [class_name method_name inputsJT candidates])))) + (/////analysis.except ..too_many_candidates [actual_class_tvars class_name method_name actual_method_tvars inputsJT candidates])))) (def: constructor_method "") @@ -1412,10 +1422,10 @@ (in constructor) {.#End} - (/////analysis.except ..no_candidates [class_name ..constructor_method inputsJT (list.all hint! candidates)]) + (/////analysis.except ..no_candidates [actual_class_tvars class_name ..constructor_method actual_method_tvars inputsJT (list.all hint! candidates)]) candidates - (/////analysis.except ..too_many_candidates [class_name ..constructor_method inputsJT candidates])))) + (/////analysis.except ..too_many_candidates [actual_class_tvars class_name ..constructor_method actual_method_tvars inputsJT candidates])))) (template [ ] [(def: .public @@ -2175,7 +2185,7 @@ [[/////analysis.#when {pattern.#Complex {complex.#Tuple - (|> arity + (|> (-- arity) list.indices (list#each (|>> (n.+ 2) {pattern.#Bind})))}} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux index ffd226015..da2a15d70 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux @@ -179,25 +179,22 @@ body! (_.when_continuous (_.goto @end))))) - (^template [ ] - [(^ ( lefts)) - (operation#in - (do _.monad - [@success _.new_label] - ($_ _.composite - ..peek - (_.checkcast //type.variant) - (//structure.lefts lefts) - (//structure.right? ) - //runtime.case - _.dup - (_.ifnonnull @success) - _.pop - (_.goto @else) - (_.set_label @success) - //runtime.push)))]) - ([#0 synthesis.side/left] - [#1 synthesis.side/right]) + (^ (synthesis.side lefts right?)) + (operation#in + (do _.monad + [@success _.new_label] + ($_ _.composite + ..peek + (_.checkcast //type.variant) + (//structure.lefts lefts) + (//structure.right? right?) + //runtime.case + _.dup + (_.ifnonnull @success) + _.pop + (_.goto @else) + (_.set_label @success) + //runtime.push))) (^template [ ] [(^ ( lefts)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 522da7f04..589de1abc 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -20,11 +20,12 @@ ["[0]" frac]]]]] ["[0]" /// "_" [// - ["/" synthesis {"+" Path Synthesis Operation Phase}] ["[1][0]" analysis {"+" Match Analysis} ["[2][0]" simple] ["[2][0]" complex] ["[2][0]" pattern {"+" Pattern}]] + ["/" synthesis {"+" Path Synthesis Operation Phase} + ["[1][0]" side]] [/// ["[1]" phase ("[1]#[0]" monad)] ["[1][0]" reference @@ -66,9 +67,8 @@ thenC) {///pattern.#Complex {///complex.#Variant [lefts right? value_pattern]}} - (<| (///#each (|>> {/.#Seq {/.#Access {/.#Side (if right? - {.#Right lefts} - {.#Left lefts})}}})) + (<| (///#each (|>> {/.#Seq {/.#Access {/.#Side [/side.#lefts lefts + /side.#right? right?]}}})) (path' value_pattern end?) (when> [(new> (not end?) [])] [(///#each ..clean_up)]) thenC) @@ -174,15 +174,22 @@ [/.#F64_Fork frac.equivalence] [/.#Text_Fork text.equivalence]) + (^template [ ] + [[{/.#Access { [/side.#lefts newL /side.#right? ]}} + {/.#Access { [/side.#lefts oldL /side.#right? ]}}] + (if (n.= newL oldL) + old + )]) + ([/.#Side #0] + [/.#Side #1]) + (^template [ ] [[{/.#Access { { newL}}} {/.#Access { { oldL}}}] (if (n.= newL oldL) old )]) - ([/.#Side .#Left] - [/.#Side .#Right] - [/.#Member .#Left] + ([/.#Member .#Left] [/.#Member .#Right]) [{/.#Bind newR} {/.#Bind oldR}] 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 99d99dbc6..409e97353 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux @@ -26,6 +26,7 @@ ["f" frac]]]]] ["[0]" / "_" ["[1][0]" simple {"+" Simple}] + ["[1][0]" side {"+" Side}] [// ["[0]" analysis {"+" Environment Analysis} ["[1]/[0]" complex {"+" Complex}]] @@ -55,9 +56,6 @@ [#locals 0 #currying? false]) -(type: .public Side - (Either Nat Nat)) - (type: .public Member (Either Nat Nat)) @@ -72,14 +70,14 @@ (type: .public (Path' s) (Variant {#Pop} - {#Access Access} {#Bind Register} + {#Access Access} {#Bit_Fork Bit (Path' s) (Maybe (Path' s))} {#I64_Fork (Fork (I64 Any) (Path' s))} {#F64_Fork (Fork Frac (Path' s))} {#Text_Fork (Fork Text (Path' s))} - {#Alt (Path' s) (Path' s)} {#Seq (Path' s) (Path' s)} + {#Alt (Path' s) (Path' s)} {#Then s})) (type: .public (Abstraction' s) @@ -160,6 +158,20 @@ [path/member ..#Member] ) +(template: .public (side lefts right?) + [(.<| {..#Access} + {..#Side} + [/side.#lefts lefts + /side.#right? right?])]) + +(template [ ] + [(template: .public ( lefts) + [(..side lefts )])] + + [#0 side/left] + [#1 side/right] + ) + (template [ ] [(template: .public ( content) [(.<| {..#Access} @@ -167,8 +179,6 @@ {} content)])] - [side/left ..#Side .#Left] - [side/right ..#Side .#Right] [member/left ..#Member .#Left] [member/right ..#Member .#Right] ) @@ -230,9 +240,9 @@ (template [ ] [(template: .public ( content) - [(<| {..#Structure} - {} - content)])] + [(.<| {..#Structure} + {} + content)])] [variant analysis/complex.#Variant] [tuple analysis/complex.#Tuple] @@ -300,13 +310,8 @@ {#Access access} (case access - {#Side side} - (case side - {.#Left lefts} - (format "{" (%.nat lefts) " #0" "}") - - {.#Right lefts} - (format "{" (%.nat lefts) " #1" "}")) + {#Side it} + (/side.format it) {#Member member} (case member @@ -421,18 +426,14 @@ (Format Path) (%path' %synthesis)) -(def: side_equivalence - (Equivalence Side) - (sum.equivalence n.equivalence n.equivalence)) - -(def: member_equivalence - (Equivalence Member) - (sum.equivalence n.equivalence n.equivalence)) - (def: member_hash (Hash Member) (sum.hash n.hash n.hash)) +(def: member_equivalence + (Equivalence Member) + (# ..member_hash &equivalence)) + (implementation: .public access_equivalence (Equivalence Access) @@ -441,7 +442,7 @@ (^template [ ] [[{ reference} { sample}] (# = reference sample)]) - ([#Side ..side_equivalence] + ([#Side /side.equivalence] [#Member ..member_equivalence]) _ @@ -453,13 +454,12 @@ (def: &equivalence ..access_equivalence) (def: (hash value) - (let [sub_hash (sum.hash n.hash n.hash)] - (case value - (^template [] - [{ value} - (# sub_hash hash value)]) - ([#Side] - [#Member]))))) + (case value + (^template [ ] + [{ value} + (# hash value)]) + ([#Side /side.hash] + [#Member ..member_hash])))) (implementation: .public (path'_equivalence equivalence) (All (_ a) (-> (Equivalence a) (Equivalence (Path' a)))) @@ -615,7 +615,7 @@ (# (..path'_hash super) hash path)) ))) -(implementation: (loop_equivalence (^open "#[0]")) +(implementation: (loop_equivalence (^open "/#[0]")) (All (_ a) (-> (Equivalence a) (Equivalence (Loop a)))) (def: (= reference sample) @@ -623,11 +623,11 @@ [{#Scope [reference_start reference_inits reference_iteration]} {#Scope [sample_start sample_inits sample_iteration]}] (and (n.= reference_start sample_start) - (# (list.equivalence #=) = reference_inits sample_inits) - (#= reference_iteration sample_iteration)) + (# (list.equivalence /#=) = reference_inits sample_inits) + (/#= reference_iteration sample_iteration)) [{#Again reference} {#Again sample}] - (# (list.equivalence #=) = reference sample) + (# (list.equivalence /#=) = reference sample) _ false))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/side.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/side.lux new file mode 100644 index 000000000..dd9bf4223 --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/side.lux @@ -0,0 +1,34 @@ +(.using + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}] + [hash {"+" Hash}]] + [data + ["[0]" product] + ["[0]" bit] + [text + ["%" format]]] + [math + [number + ["[0]" nat]]]]]) + +(type: .public Side + (Record + [#lefts Nat + #right? Bit])) + +(def: .public (format it) + (%.Format Side) + (%.format "{" (%.nat (value@ #lefts it)) " " (%.bit (value@ #right? it)) "}")) + +(def: .public hash + (Hash Side) + ($_ product.hash + nat.hash + bit.hash + )) + +(def: .public equivalence + (Equivalence Side) + (# ..hash &equivalence)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux index 0b1825953..dbf435a6d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux @@ -64,7 +64,7 @@ (|>> (case> (^template [ ] [{ value'} (n.* (# hash value'))]) - ([1 #Bit bit.hash] - [2 #F64 f.hash] - [3 #Text text.hash] - [5 #I64 i64.hash]))))) + ([2 #Bit bit.hash] + [3 #F64 f.hash] + [5 #Text text.hash] + [7 #I64 i64.hash]))))) diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux index aba318986..346dc5d77 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -5,7 +5,8 @@ [abstract [monad {"+" do}] [\\specification - ["$[0]" equivalence]]] + ["$[0]" equivalence] + ["$[0]" monoid]]] [control ["[0]" maybe ("[1]#[0]" monad)]] [data @@ -47,6 +48,10 @@ (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (..random size gen_key random.nat))) + (_.for [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) + /.monoid + (..random 10 (random.ascii/lower 1) random.nat))) (_.cover [/.size] (n.= size (/.size sample))) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index c1b0a83bd..1009e3239 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -13,7 +13,8 @@ ... ["[1][0]" syntax] ["[1][0]" analysis] ["[1][0]" synthesis "_" - ["[1]/[0]" simple]] + ["[1]/[0]" simple] + ["[1]/[0]" side]] ["[1][0]" phase "_" ["[1]/[0]" extension] ["[1]/[0]" analysis] @@ -37,6 +38,7 @@ /phase.test /analysis.test /synthesis/simple.test + /synthesis/side.test /meta/archive.test /meta/cli.test /meta/export.test diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/side.lux b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/side.lux new file mode 100644 index 000000000..3dccec159 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/side.lux @@ -0,0 +1,43 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash]]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) + +(def: .public random + (Random /.Side) + ($_ random.and + random.nat + random.bit + )) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Side]) + (do [! random.monad] + [left ..random + right ..random] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + + (_.cover [/.format] + (bit#= (# /.equivalence = left right) + (text#= (/.format left) (/.format right)))) + )))) -- cgit v1.2.3