From c98d05fcb43714dc7e2ce07ab3fa17b78f21b3bf Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 19 Jan 2022 22:30:05 -0400 Subject: Fixes for the pure-Lux JVM compiler machinery. [Part 9] --- .../source/library/lux/control/parser/analysis.lux | 4 +- stdlib/source/library/lux/target/jvm/attribute.lux | 109 ++++++++----- stdlib/source/library/lux/target/jvm/class.lux | 87 +++++----- stdlib/source/library/lux/target/jvm/method.lux | 78 ++++----- .../source/library/lux/target/jvm/reflection.lux | 25 +-- .../source/library/lux/target/jvm/type/parser.lux | 12 +- .../library/lux/target/jvm/type/signature.lux | 12 +- .../lux/tool/compiler/language/lux/analysis.lux | 22 +-- .../tool/compiler/language/lux/phase/analysis.lux | 14 +- .../language/lux/phase/analysis/function.lux | 56 +++---- .../language/lux/phase/analysis/primitive.lux | 34 ---- .../language/lux/phase/analysis/simple.lux | 34 ++++ .../language/lux/phase/analysis/structure.lux | 4 +- .../language/lux/phase/extension/analysis/jvm.lux | 88 +++++++--- .../language/lux/phase/extension/directive/jvm.lux | 1 + .../lux/phase/extension/generation/jvm/host.lux | 1 + .../language/lux/phase/generation/jvm/function.lux | 1 + .../language/lux/phase/generation/jvm/host.lux | 1 + .../language/lux/phase/generation/jvm/program.lux | 1 + .../language/lux/phase/generation/jvm/runtime.lux | 2 + .../language/lux/phase/synthesis/function.lux | 58 +++---- stdlib/source/test/lux/control/parser/analysis.lux | 4 +- stdlib/source/test/lux/target/jvm.lux | 6 + stdlib/source/test/lux/target/ruby.lux | 179 ++++++++++++++++----- stdlib/source/test/lux/tool.lux | 5 +- .../lux/tool/compiler/language/lux/analysis.lux | 16 +- .../language/lux/phase/analysis/primitive.lux | 115 ------------- .../language/lux/phase/analysis/simple.lux | 88 ++++++++++ 28 files changed, 598 insertions(+), 459 deletions(-) delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/simple.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux create mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux (limited to 'stdlib') diff --git a/stdlib/source/library/lux/control/parser/analysis.lux b/stdlib/source/library/lux/control/parser/analysis.lux index fbe5f943c..31bc63a43 100644 --- a/stdlib/source/library/lux/control/parser/analysis.lux +++ b/stdlib/source/library/lux/control/parser/analysis.lux @@ -117,8 +117,8 @@ [rev rev! /.rev Rev rev.equivalence] [frac frac! /.frac Frac frac.equivalence] [text text! /.text Text text.equivalence] - [local local! /.variable/local Nat nat.equivalence] - [foreign foreign! /.variable/foreign Nat nat.equivalence] + [local local! /.local Nat nat.equivalence] + [foreign foreign! /.foreign Nat nat.equivalence] [constant constant! /.constant Symbol symbol.equivalence] ) diff --git a/stdlib/source/library/lux/target/jvm/attribute.lux b/stdlib/source/library/lux/target/jvm/attribute.lux index 029f7f0fd..e070c6326 100644 --- a/stdlib/source/library/lux/target/jvm/attribute.lux +++ b/stdlib/source/library/lux/target/jvm/attribute.lux @@ -1,29 +1,31 @@ (.using - [library - [lux {"-" Info Code} - [abstract - [monad {"+" do}] - ["[0]" equivalence {"+" Equivalence}]] - [control - ["[0]" try] - ["[0]" exception {"+" exception:}]] - [data - ["[0]" sum] - ["[0]" product] - [format - ["[0]F" binary {"+" Writer}]]] - [math - [number - ["n" nat]]]]] - ["[0]" // "_" - ["[1][0]" index {"+" Index}] - [encoding - ["[1][0]" unsigned {"+" U2 U4}]] - ["[1][0]" constant {"+" UTF8 Class Value} - ["[1]/[0]" pool {"+" Pool Resource}]]] - ["[0]" / "_" - ["[1][0]" constant {"+" Constant}] - ["[1][0]" code]]) + [library + [lux {"-" Info Code Type} + [abstract + [monad {"+" do}] + ["[0]" equivalence {"+" Equivalence}]] + [control + ["[0]" try] + ["[0]" exception {"+" exception:}]] + [data + ["[0]" sum] + ["[0]" product] + [format + ["[0]F" binary {"+" Writer}]]] + [math + [number + ["n" nat]]]]] + ["[0]" // "_" + ["[1][0]" index {"+" Index}] + ["[1][0]" type {"+" Type} + ["[2][0]" signature {"+" Signature}]] + [encoding + ["[1][0]" unsigned {"+" U2 U4}]] + ["[1][0]" constant {"+" UTF8 Class Value} + ["[2][0]" pool {"+" Pool Resource} ("[1]#[0]" monad)]]] + ["[0]" / "_" + ["[1][0]" constant {"+" Constant}] + ["[1][0]" code]]) (type: .public (Info about) (Record @@ -56,7 +58,8 @@ (Rec Attribute (Variant {#Constant (Info (Constant Any))} - {#Code (Info )}))) + {#Code (Info )} + {#Signature (Info (Index UTF8))}))) (type: .public Code ) @@ -68,7 +71,9 @@ (function (_ equivalence) ($_ sum.equivalence (info_equivalence /constant.equivalence) - (info_equivalence (/code.equivalence equivalence)))))) + (info_equivalence (/code.equivalence equivalence)) + (info_equivalence //index.equivalence) + )))) (def: common_attribute_length ($_ n.+ @@ -85,24 +90,24 @@ [{ [name length info]} (|> length //unsigned.value (n.+ ..common_attribute_length))]) ([#Constant] - [#Code]))) + [#Code] + [#Signature]))) ... TODO: Inline ASAP -(def: (constant' @name index) - (-> (Index UTF8) (Constant Any) Attribute) +(def: (constant' index @name) + (-> (Constant Any) (Index UTF8) Attribute) {#Constant [#name @name + ... https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html#jvms-4.7.2 #length (|> /constant.length //unsigned.u4 try.trusted) #info index]}) (def: .public (constant index) (-> (Constant Any) (Resource Attribute)) - (do //constant/pool.monad - [@name (//constant/pool.utf8 "ConstantValue")] - (in (constant' @name index)))) + (//pool#each (constant' index) (//pool.utf8 "ConstantValue"))) ... TODO: Inline ASAP -(def: (code' @name specification) - (-> (Index UTF8) Code Attribute) +(def: (code' specification @name) + (-> Code (Index UTF8) Attribute) {#Code [#name @name ... https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3 #length (|> specification @@ -113,15 +118,31 @@ (def: .public (code specification) (-> Code (Resource Attribute)) - (do //constant/pool.monad - [@name (//constant/pool.utf8 "Code")] - (in (code' @name specification)))) + (//pool#each (code' specification) (//pool.utf8 "Code"))) -(def: .public (writer value) +... TODO: Inline ASAP +(def: (signature' it @name) + (-> (Index UTF8) (Index UTF8) Attribute) + {#Signature [#name @name + ... https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html#jvms-4.7.9 + #length (|> //index.length //unsigned.u4 try.trusted) + #info it]}) + +(def: .public (signature it) + (All (_ category) + (-> (Type category) (Resource Attribute))) + (do [! //pool.monad] + [it (|> it //type.signature //signature.signature //pool.utf8)] + (# ! each (signature' it) (//pool.utf8 "Signature")))) + +(def: .public (writer it) (Writer Attribute) - (case value - {#Constant attribute} - ((info_writer /constant.writer) attribute) + (case it + {#Constant it} + ((info_writer /constant.writer) it) - {#Code attribute} - ((info_writer (/code.writer writer)) attribute))) + {#Code it} + ((info_writer (/code.writer writer)) it) + + {#Signature it} + ((info_writer //index.writer) it))) diff --git a/stdlib/source/library/lux/target/jvm/class.lux b/stdlib/source/library/lux/target/jvm/class.lux index 1ba0ae62d..7a342dd54 100644 --- a/stdlib/source/library/lux/target/jvm/class.lux +++ b/stdlib/source/library/lux/target/jvm/class.lux @@ -1,31 +1,33 @@ (.using - [library - [lux {"-" public private} - [abstract - [equivalence {"+" Equivalence}] - ["[0]" monad {"+" do}]] - [control - ["[0]" state] - ["[0]" try {"+" Try}]] - [data - ["[0]" product] - [format - ["[0]F" binary {"+" Writer} ("[1]#[0]" monoid)]] - [collection - ["[0]" sequence {"+" Sequence}]]]]] - ["[0]" // "_" - ["[1][0]" modifier {"+" Modifier modifiers:}] - ["[1][0]" version {"+" Version Minor Major}] - ["[1][0]" magic {"+" Magic}] - ["[1][0]" index {"+" Index}] - ["[1][0]" attribute {"+" Attribute}] - ["[1][0]" field {"+" Field}] - ["[1][0]" method {"+" Method}] - [encoding - ["[1][0]" unsigned] - ["[1][0]" name {"+" Internal}]] - ["[1][0]" constant {"+" Constant} - ["[1]/[0]" pool {"+" Pool Resource}]]]) + [library + [lux {"-" Type public private} + [abstract + [equivalence {"+" Equivalence}] + ["[0]" monad {"+" do}]] + [control + ["[0]" state] + ["[0]" try {"+" Try}]] + [data + ["[0]" product] + [format + ["[0]F" binary {"+" Writer} ("[1]#[0]" monoid)]] + [collection + ["[0]" sequence {"+" Sequence}]]]]] + ["[0]" // "_" + ["[1][0]" modifier {"+" Modifier modifiers:}] + ["[1][0]" version {"+" Version Minor Major}] + ["[1][0]" magic {"+" Magic}] + ["[1][0]" index {"+" Index}] + ["[1][0]" attribute {"+" Attribute}] + ["[1][0]" field {"+" Field}] + ["[1][0]" method {"+" Method}] + [encoding + ["[1][0]" unsigned] + ["[1][0]" name {"+" Internal}]] + ["[1][0]" type {"+" Type} + [category {"+" Declaration}]] + ["[1][0]" constant {"+" Constant} + ["[2][0]" pool {"+" Pool Resource}]]]) (type: .public Class (Rec Class @@ -59,7 +61,7 @@ //unsigned.equivalence //unsigned.equivalence //unsigned.equivalence - //constant/pool.equivalence + //pool.equivalence //modifier.equivalence //index.equivalence //index.equivalence @@ -71,35 +73,36 @@ (def: (install_classes this super interfaces) (-> Internal Internal (List Internal) (Resource [(Index //constant.Class) (Index //constant.Class) (Sequence (Index //constant.Class))])) - (do [! //constant/pool.monad] - [@this (//constant/pool.class this) - @super (//constant/pool.class super) + (do [! //pool.monad] + [@this (//pool.class this) + @super (//pool.class super) @interfaces (: (Resource (Sequence (Index //constant.Class))) (monad.mix ! (function (_ interface @interfaces) (do ! - [@interface (//constant/pool.class interface)] + [@interface (//pool.class interface)] (in (sequence.suffix @interface @interfaces)))) sequence.empty interfaces))] (in [@this @super @interfaces]))) (def: .public (class version modifier - this super interfaces + this type super interfaces fields methods attributes) (-> Major (Modifier Class) - Internal Internal (List Internal) + Internal (Type Declaration) Internal (List Internal) (List (Resource Field)) (List (Resource Method)) (Sequence Attribute) (Try Class)) (do try.monad - [[pool [@this @super @interfaces] =fields =methods] - (<| (state.result' //constant/pool.empty) - (do //constant/pool.monad + [[pool [@this @super @interfaces] =fields =methods @signature] + (<| (state.result' //pool.empty) + (do [! //pool.monad] [classes (install_classes this super interfaces) - =fields (monad.all //constant/pool.monad fields) - =methods (monad.all //constant/pool.monad methods)] - (in [classes =fields =methods])))] + =fields (monad.all ! fields) + =methods (monad.all ! methods) + @signature (//attribute.signature type)] + (in [classes =fields =methods @signature])))] (in [#magic //magic.code #minor_version //version.default_minor #major_version version @@ -110,7 +113,7 @@ #interfaces @interfaces #fields (sequence.of_list =fields) #methods (sequence.of_list =methods) - #attributes attributes]))) + #attributes (sequence.suffix @signature attributes)]))) (def: .public (writer class) (Writer Class) @@ -121,7 +124,7 @@ [//magic.writer #magic] [//version.writer #minor_version] [//version.writer #major_version] - [//constant/pool.writer #constant_pool] + [//pool.writer #constant_pool] [//modifier.writer #modifier] [//index.writer #this] [//index.writer #super])) diff --git a/stdlib/source/library/lux/target/jvm/method.lux b/stdlib/source/library/lux/target/jvm/method.lux index 2e0daf01b..48bd523e8 100644 --- a/stdlib/source/library/lux/target/jvm/method.lux +++ b/stdlib/source/library/lux/target/jvm/method.lux @@ -1,37 +1,38 @@ (.using - [library - [lux {"-" Type static public private} - [abstract - [equivalence {"+" Equivalence}] - ["[0]" monad {"+" do}]] - [control - ["[0]" try]] - [data - ["[0]" product] - ["[0]" format "_" - ["[1]" binary {"+" Writer} ("[1]#[0]" monoid)]] - [collection - ["[0]" sequence {"+" Sequence}]]]]] - ["[0]" // "_" - ["[1][0]" modifier {"+" Modifier modifiers:}] - ["[1][0]" index {"+" Index}] - ["[1][0]" attribute {"+" Attribute} - ["[1]/[0]" code]] - ["[1][0]" constant {"+" UTF8} - ["[1]/[0]" pool {"+" Pool Resource}]] - ["[1][0]" bytecode {"+" Bytecode} - ["[1]/[0]" environment {"+" Environment}] - ["[1]/[0]" instruction]] - ["[1][0]" type {"+" Type} - ["[1]/[0]" category] - ["[1][0]" descriptor {"+" Descriptor}]]]) + [library + [lux {"-" Type static public private} + [abstract + [equivalence {"+" Equivalence}] + ["[0]" monad {"+" do}]] + [control + ["[0]" try]] + [data + ["[0]" product] + ["[0]" format "_" + ["[1]" binary {"+" Writer} ("[1]#[0]" monoid)]] + [collection + ["[0]" sequence {"+" Sequence}]]]]] + ["[0]" // "_" + ["[1][0]" modifier {"+" Modifier modifiers:}] + ["[1][0]" index {"+" Index}] + ["[1][0]" attribute {"+" Attribute} + ["[2][0]" code]] + ["[1][0]" constant {"+" UTF8} + ["[2][0]" pool {"+" Pool Resource}]] + ["[1][0]" bytecode {"+" Bytecode} + ["[2][0]" environment {"+" Environment}] + ["[2][0]" instruction]] + ["[1][0]" type {"+" Type} + [descriptor {"+" Descriptor}] + ["[2][0]" category] + ["[2][0]" signature]]]) (type: .public Method (Rec Method (Record [#modifier (Modifier Method) #name (Index UTF8) - #descriptor (Index (Descriptor //type/category.Method)) + #descriptor (Index (Descriptor //category.Method)) #attributes (Sequence Attribute)]))) (modifiers: Method @@ -50,31 +51,32 @@ ) (def: .public (method modifier name type attributes code) - (-> (Modifier Method) UTF8 (Type //type/category.Method) (List (Resource Attribute)) (Maybe (Bytecode Any)) + (-> (Modifier Method) UTF8 (Type //category.Method) (List (Resource Attribute)) (Maybe (Bytecode Any)) (Resource Method)) - (do [! //constant/pool.monad] - [@name (//constant/pool.utf8 name) - @descriptor (//constant/pool.descriptor (//type.descriptor type)) + (do [! //pool.monad] + [@name (//pool.utf8 name) + @descriptor (//pool.descriptor (//type.descriptor type)) attributes (|> attributes + (list& (//attribute.signature type)) (monad.all !) (# ! each sequence.of_list)) attributes (case code {.#Some code} (do ! [environment (case (if (//modifier.has? static modifier) - (//bytecode/environment.static type) - (//bytecode/environment.virtual type)) + (//environment.static type) + (//environment.virtual type)) {try.#Success environment} (in environment) {try.#Failure error} (function (_ _) {try.#Failure error})) [environment exceptions instruction output] (//bytecode.resolve environment code) - .let [bytecode (|> instruction //bytecode/instruction.result format.instance)] - @code (//attribute.code [//attribute/code.#limit (value@ //bytecode/environment.#limit environment) - //attribute/code.#code bytecode - //attribute/code.#exception_table exceptions - //attribute/code.#attributes (sequence.sequence)])] + .let [bytecode (|> instruction //instruction.result format.instance)] + @code (//attribute.code [//code.#limit (value@ //environment.#limit environment) + //code.#code bytecode + //code.#exception_table exceptions + //code.#attributes (sequence.sequence)])] (in (sequence.suffix @code attributes))) {.#None} diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux index 9496a9906..1462acd76 100644 --- a/stdlib/source/library/lux/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/reflection.lux @@ -78,38 +78,15 @@ (getGenericType [] java/lang/reflect/Type) (getDeclaredAnnotations [] [java/lang/annotation/Annotation])]) -(import: java/lang/reflect/Method - ["[1]::[0]" - (getName [] java/lang/String) - (getModifiers [] int) - (getDeclaringClass [] (java/lang/Class java/lang/Object)) - (getTypeParameters [] [(java/lang/reflect/TypeVariable java/lang/reflect/Method)]) - (getGenericParameterTypes [] [java/lang/reflect/Type]) - (getGenericReturnType [] java/lang/reflect/Type) - (getGenericExceptionTypes [] [java/lang/reflect/Type])]) - -(import: (java/lang/reflect/Constructor c) - ["[1]::[0]" - (getModifiers [] int) - (getDeclaringClass [] (java/lang/Class c)) - (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/reflect/Constructor c))]) - (getGenericParameterTypes [] [java/lang/reflect/Type]) - (getGenericExceptionTypes [] [java/lang/reflect/Type])]) - (import: java/lang/ClassLoader) (import: (java/lang/Class c) ["[1]::[0]" ("static" forName [java/lang/String boolean java/lang/ClassLoader] "try" (java/lang/Class java/lang/Object)) (getName [] java/lang/String) - (getModifiers [] int) (isAssignableFrom [(java/lang/Class java/lang/Object)] boolean) (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/Class c))]) - (getGenericInterfaces [] [java/lang/reflect/Type]) - (getGenericSuperclass [] "?" java/lang/reflect/Type) - (getDeclaredField [java/lang/String] "try" java/lang/reflect/Field) - (getConstructors [] [(java/lang/reflect/Constructor java/lang/Object)]) - (getDeclaredMethods [] [java/lang/reflect/Method])]) + (getDeclaredField [java/lang/String] "try" java/lang/reflect/Field)]) (exception: .public (unknown_class [class External]) (exception.report diff --git a/stdlib/source/library/lux/target/jvm/type/parser.lux b/stdlib/source/library/lux/target/jvm/type/parser.lux index 5aa5fc3f1..76289b082 100644 --- a/stdlib/source/library/lux/target/jvm/type/parser.lux +++ b/stdlib/source/library/lux/target/jvm/type/parser.lux @@ -200,9 +200,17 @@ (def: exception (Parser (Type Class)) - (|> (..class' ..parameter) + (|> ..class (<>.after (.this //signature.exception_prefix)))) +(def: .public var_declaration + (Parser [(Type Var) (Type Class)]) + (do <>.monad + [name ..var_name + _ (.this //signature.format_type_parameter_infix) + type ..class] + (in [(//.var name) type]))) + (def: .public method (-> (Type Method) [(List (Type Var)) @@ -214,7 +222,7 @@ (Type Return) (List (Type Class))]) ($_ <>.and - (|> (<>.some ..var) + (|> (<>.some (<>#each product.left ..var_declaration)) (<>.after (.this //signature.parameters_start)) (<>.before (.this //signature.parameters_end)) (<>.else (list))) diff --git a/stdlib/source/library/lux/target/jvm/type/signature.lux b/stdlib/source/library/lux/target/jvm/type/signature.lux index b19087691..f38e433b5 100644 --- a/stdlib/source/library/lux/target/jvm/type/signature.lux +++ b/stdlib/source/library/lux/target/jvm/type/signature.lux @@ -109,15 +109,19 @@ (-> (Signature Declaration) (Signature Class)) (|>> :transmutation)) - (def: .public arguments_start "(") - (def: .public arguments_end ")") + (template [ ] + [(def: .public )] - (def: .public exception_prefix "^") + ["(" arguments_start] + [")" arguments_end] + ["^" exception_prefix] + [":" format_type_parameter_infix] + ) (def: class_bound (|> (..class "java.lang.Object" (list)) ..signature - (format ":"))) + (format ..format_type_parameter_infix))) (def: .public (method [type_variables inputs output exceptions]) (-> [(List (Signature Var)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux index 0f1d59581..643a1b428 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux @@ -1,6 +1,6 @@ (.using [library - [lux {"-" Tuple Variant nat int rev case} + [lux {"-" Tuple Variant nat int rev case local} [abstract [equivalence {"+" Equivalence}] [hash {"+" Hash}] @@ -138,7 +138,7 @@ (type: .public (Abstraction c) [(Environment c) Arity c]) -(type: .public (Application c) +(type: .public (Reification c) [c (List c)]) (template: .public (no_op value) @@ -149,15 +149,15 @@ {..#Function (list)} {..#Apply value})]) -(def: .public (apply [abstraction inputs]) - (-> (Application Analysis) Analysis) +(def: .public (reified [abstraction inputs]) + (-> (Reification Analysis) Analysis) (list#mix (function (_ input abstraction') {#Apply input abstraction'}) abstraction inputs)) -(def: .public (application analysis) - (-> Analysis (Application Analysis)) +(def: .public (reification analysis) + (-> Analysis (Reification Analysis)) (loop [abstraction analysis inputs (list)] (.case abstraction @@ -173,11 +173,11 @@ (~ content))))))] - [variable {reference.#Variable}] - [constant {reference.#Constant}] + [variable {reference.#Variable}] + [constant {reference.#Constant}] - [variable/local ((~! reference.local))] - [variable/foreign ((~! reference.foreign))] + [local ((~! reference.local))] + [foreign ((~! reference.foreign))] ) (template [ ] @@ -223,7 +223,7 @@ {#Apply _} (|> analysis - ..application + ..reification {.#Item} (list#each format) (text.interposed " ") diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux index 9db69a2c3..fb64abaf3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux @@ -17,7 +17,7 @@ ["[0]" location]]]] ["[0]" / "_" ["[1][0]" type] - ["[1][0]" primitive] + ["[1][0]" simple] ["[1][0]" structure] ["[1][0]" reference] ["[1][0]" case] @@ -49,12 +49,12 @@ (^template [ ] [{ value} ( value)]) - ([.#Bit /primitive.bit] - [.#Nat /primitive.nat] - [.#Int /primitive.int] - [.#Rev /primitive.rev] - [.#Frac /primitive.frac] - [.#Text /primitive.text]) + ([.#Bit /simple.bit] + [.#Nat /simple.nat] + [.#Int /simple.int] + [.#Rev /simple.rev] + [.#Frac /simple.frac] + [.#Text /simple.text]) (^ {.#Variant (list& [_ {.#Symbol tag}] values)}) 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 4bca170c3..1b4b38a7c 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 @@ -1,31 +1,31 @@ (.using - [library - [lux {"-" function} - [abstract - monad] - [control - ["[0]" maybe] - ["ex" exception {"+" exception:}]] - [data - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" monoid monad)]]] - ["[0]" type - ["[0]" check]] - ["[0]" meta]]] - ["[0]" // "_" - ["[1][0]" scope] - ["[1][0]" type] - ["[1][0]" inference] - ["/[1]" // "_" - ["[1][0]" extension] - [// - ["/" analysis {"+" Analysis Operation Phase}] - [/// - ["[1]" phase] - [reference {"+"} - [variable {"+"}]]]]]]) + [library + [lux {"-" function} + [abstract + monad] + [control + ["[0]" maybe] + ["ex" exception {"+" exception:}]] + [data + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" monoid monad)]]] + ["[0]" type + ["[0]" check]] + ["[0]" meta]]] + ["[0]" // "_" + ["[1][0]" scope] + ["[1][0]" type] + ["[1][0]" inference] + ["/[1]" // "_" + ["[1][0]" extension] + [// + ["/" analysis {"+" Analysis Operation Phase}] + [/// + ["[1]" phase] + [reference {"+"} + [variable {"+"}]]]]]]) (exception: .public (cannot_analyse [expected Type function Text @@ -114,4 +114,4 @@ (<| (/.with_stack ..cannot_apply [functionT functionC argsC+]) (do ///.monad [[applyT argsA+] (//inference.general archive analyse functionT argsC+)]) - (in (/.apply [functionA argsA+])))) + (in (/.reified [functionA argsA+])))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux deleted file mode 100644 index 69984ab22..000000000 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux +++ /dev/null @@ -1,34 +0,0 @@ -(.using - [library - [lux {"-" nat int rev} - [abstract - monad]]] - ["[0]" // "_" - ["[1][0]" type] - ["/[1]" // "_" - [// - ["/" analysis {"+" Analysis Operation} - ["[1][0]" simple]] - [/// - ["[1]" phase]]]]]) - -(template [ ] - [(def: .public ( value) - (-> (Operation Analysis)) - (do ///.monad - [_ (//type.infer )] - (in {/.#Simple { value}})))] - - [bit .Bit /simple.#Bit] - [nat .Nat /simple.#Nat] - [int .Int /simple.#Int] - [rev .Rev /simple.#Rev] - [frac .Frac /simple.#Frac] - [text .Text /simple.#Text] - ) - -(def: .public unit - (Operation Analysis) - (do ///.monad - [_ (//type.infer .Any)] - (in {/.#Simple {/simple.#Unit}}))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/simple.lux new file mode 100644 index 000000000..7d65b62cf --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/simple.lux @@ -0,0 +1,34 @@ +(.using + [library + [lux {"-" nat int rev} + [abstract + [monad {"+" do}]]]] + ["[0]" // "_" + ["[1][0]" type] + ["/[1]" // "_" + [// + ["/" analysis {"+" Analysis Operation} + ["[1][0]" simple]] + [/// + ["[1]" phase]]]]]) + +(template [ ] + [(def: .public ( value) + (-> (Operation Analysis)) + (do ///.monad + [_ (//type.infer )] + (in {/.#Simple { value}})))] + + [bit .Bit /simple.#Bit] + [nat .Nat /simple.#Nat] + [int .Int /simple.#Int] + [rev .Rev /simple.#Rev] + [frac .Frac /simple.#Frac] + [text .Text /simple.#Text] + ) + +(def: .public unit + (Operation Analysis) + (do ///.monad + [_ (//type.infer .Any)] + (in {/.#Simple {/simple.#Unit}}))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux index bcc0a82fe..12f00a8aa 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -27,7 +27,7 @@ ["[0]" check]]]] ["[0]" // "_" ["[1][0]" type] - ["[1][0]" primitive] + ["[1][0]" simple] ["[1][0]" inference] ["/[1]" // "_" ["[1][0]" extension] @@ -398,7 +398,7 @@ (-> Archive Phase (List Code) (Operation Analysis)) (case members (^ (list)) - //primitive.unit + //simple.unit (^ (list singletonC)) (analyse archive singletonC) 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 1e6c6af8e..0f076e04a 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 @@ -21,6 +21,8 @@ ["[0]" list ("[1]#[0]" mix monad monoid)] ["[0]" array] ["[0]" dictionary {"+" Dictionary}]]] + [macro + ["[0]" template]] [math [number ["n" nat]]] @@ -89,9 +91,13 @@ (getDeclaringClass [] (java/lang/Class java/lang/Object)) (getTypeParameters [] [(java/lang/reflect/TypeVariable java/lang/reflect/Method)]) (getGenericParameterTypes [] [java/lang/reflect/Type]) - (getGenericReturnType [] java/lang/reflect/Type) - (getGenericExceptionTypes [] [java/lang/reflect/Type]) - (getDeclaredAnnotations [] [java/lang/annotation/Annotation])]) + (getDeclaredAnnotations [] [java/lang/annotation/Annotation]) + + (getReturnType [] (java/lang/Class java/lang/Object)) + (getGenericReturnType [] "?" java/lang/reflect/Type) + + (getExceptionTypes [] [(java/lang/Class java/lang/Object)]) + (getGenericExceptionTypes [] [java/lang/reflect/Type])]) (import: (java/lang/reflect/Constructor c) ["[1]::[0]" @@ -99,6 +105,7 @@ (getDeclaringClass [] (java/lang/Class c)) (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/reflect/Constructor c))]) (getGenericParameterTypes [] [java/lang/reflect/Type]) + (getExceptionTypes [] [(java/lang/Class java/lang/Object)]) (getGenericExceptionTypes [] [java/lang/reflect/Type]) (getDeclaredAnnotations [] [java/lang/annotation/Annotation])]) @@ -1183,6 +1190,31 @@ mapping (dictionary.of_list text.hash lux_tvars)] [owner_tvarsT mapping])) +(def: (lux_class it) + (-> (java/lang/Class java/lang/Object) (Type Class)) + (jvm.class (java/lang/Class::getName it) (list))) + +(template [ ] + [(`` (def: + (-> ( (~~ (template.spliced ))) (List (Type Class))) + (|>> (~~ (template.symbol [ "::getExceptionTypes"])) + (array.list {.#None}) + (list#each ..lux_class))))] + + [concrete_method_exceptions java/lang/reflect/Method []] + [concrete_constructor_exceptions java/lang/reflect/Constructor [java/lang/Object]] + ) + +(def: (return_type it) + (-> java/lang/reflect/Method (Try (Type Return))) + (reflection!.return + (case (java/lang/reflect/Method::getGenericReturnType it) + {.#Some it} + it + + {.#None} + (java/lang/reflect/Method::getReturnType it)))) + (def: (method_signature method_style method) (-> Method_Style java/lang/reflect/Method (Operation Method_Signature)) (let [owner (java/lang/reflect/Method::getDeclaringClass method) @@ -1205,16 +1237,17 @@ (phase#each (monad.each ! (..reflection_type mapping))) phase#conjoint) outputT (|> method - java/lang/reflect/Method::getGenericReturnType - reflection!.return + ..return_type phase.lifted (phase#each (..reflection_return mapping)) phase#conjoint) - exceptionsT (|> (java/lang/reflect/Method::getGenericExceptionTypes method) - (array.list {.#None}) - (monad.each ! (|>> reflection!.type phase.lifted)) - (phase#each (monad.each ! (..reflection_type mapping))) - phase#conjoint) + .let [concrete_exceptions (..concrete_method_exceptions method)] + concrete_exceptions (monad.each ! (..reflection_type mapping) concrete_exceptions) + generic_exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method) + (array.list {.#None}) + (monad.each ! (|>> reflection!.type phase.lifted)) + (phase#each (monad.each ! (..reflection_type mapping))) + phase#conjoint) .let [methodT (<| (type.univ_q (dictionary.size mapping)) (type.function (case method_style {#Static} @@ -1226,7 +1259,9 @@ outputT)]] (in [methodT (reflection!.deprecated? (java/lang/reflect/Method::getDeclaredAnnotations method)) - exceptionsT])))) + (if (list.empty? generic_exceptions) + concrete_exceptions + generic_exceptions)])))) (def: (constructor_signature constructor) (-> (java/lang/reflect/Constructor java/lang/Object) (Operation Method_Signature)) @@ -1244,18 +1279,22 @@ (monad.each ! (|>> reflection!.type phase.lifted)) (phase#each (monad.each ! (reflection_type mapping))) phase#conjoint) - exceptionsT (|> (java/lang/reflect/Constructor::getGenericExceptionTypes constructor) - (array.list {.#None}) - (monad.each ! (|>> reflection!.type phase.lifted)) - (phase#each (monad.each ! (reflection_type mapping))) - phase#conjoint) + .let [concrete_exceptions (..concrete_constructor_exceptions constructor)] + concrete_exceptions (monad.each ! (..reflection_type mapping) concrete_exceptions) + generic_exceptions (|> (java/lang/reflect/Constructor::getGenericExceptionTypes constructor) + (array.list {.#None}) + (monad.each ! (|>> reflection!.type phase.lifted)) + (phase#each (monad.each ! (reflection_type mapping))) + phase#conjoint) .let [objectT {.#Primitive (java/lang/Class::getName owner) owner_tvarsT} constructorT (<| (type.univ_q (dictionary.size mapping)) (type.function inputsT) objectT)]] (in [constructorT (reflection!.deprecated? (java/lang/reflect/Constructor::getDeclaredAnnotations constructor)) - exceptionsT])))) + (if (list.empty? generic_exceptions) + concrete_exceptions + generic_exceptions)])))) (type: Evaluation (Variant @@ -1572,14 +1611,15 @@ inputs (|> (java/lang/reflect/Method::getGenericParameterTypes method) (array.list {.#None}) (monad.each ! reflection!.type)) - return (|> method - java/lang/reflect/Method::getGenericReturnType - reflection!.return) - exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method) - (array.list {.#None}) - (monad.each ! reflection!.class))] + return (..return_type method) + .let [concrete_exceptions (..concrete_method_exceptions method)] + generic_exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method) + (array.list {.#None}) + (monad.each ! reflection!.class))] (in [(java/lang/reflect/Method::getName method) - (jvm.method [type_variables inputs return exceptions])]))))))] + (jvm.method [type_variables inputs return (if (list.empty? generic_exceptions) + concrete_exceptions + generic_exceptions)])]))))))] [abstract_methods (list.only (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract))] [methods (<|)] 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 5442fafdb..72f978083 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 @@ -351,6 +351,7 @@ class.abstract class.interface) (name.internal name) + (type.declaration name parameters) (name.internal "java.lang.Object") (list#each (|>> parser.read_class product.left name.internal) supers) 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 9f461699f..7a3c93014 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 @@ -1224,6 +1224,7 @@ //////.lifted (class.class version.v6_0 ($_ modifier#composite class.public class.final) (name.internal anonymous_class_name) + (type.declaration anonymous_class_name (list)) (name.internal (..reflection super_class)) (list#each (|>> ..reflection name.internal) super_interfaces) (foreign.variables total_environment) 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 343aa7f1f..357337927 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 @@ -110,6 +110,7 @@ class (phase.lifted (class.class version.v6_0 ..modifier (name.internal function_class) + (type.declaration function_class (list)) (..internal /abstract.class) (list) fields methods 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 b15832011..79c72c425 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 @@ -122,6 +122,7 @@ bytecode (class.class version.v6_0 class.public (encoding/name.internal bytecode_name) + (type.declaration bytecode_name (list)) (encoding/name.internal "java.lang.Object") (list) (list (field.field ..value::modifier ..value::field ..value::type (sequence.sequence))) (list (method.method ..init::modifier "" ..init::type 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 d8ab2d2d6..bf0bb032d 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 @@ -157,6 +157,7 @@ (class.class version.v6_0 ..program::modifier (name.internal class) + (type.declaration class (list)) super_class (list) (list) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index e9f88652c..74956a7e5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -545,6 +545,7 @@ (class.class jvm/version.v6_0 modifier (name.internal class) + (type.declaration class (list)) (name.internal (..reflection ^Object)) (list) (list) (let [[left_projection::method right_projection::method] projection::method2] @@ -614,6 +615,7 @@ (class.class jvm/version.v6_0 modifier (name.internal class) + (type.declaration class (list)) (name.internal (..reflection ^Object)) (list) (list partial_count) (list& ::method apply::method+) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux index d7fa84bfd..d6fe2a3ea 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -1,32 +1,32 @@ (.using - [library - [lux "*" - [abstract - ["[0]" monad {"+" do}] - ["[0]" enum]] - [control - [pipe {"+" case>}] - ["[0]" maybe ("[1]#[0]" functor)] - ["[0]" exception {"+" exception:}]] - [data - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor monoid)]]] - [math - [number - ["n" nat]]]]] - ["[0]" // "_" - ["[1][0]" loop {"+" Transform}] - ["//[1]" /// "_" - ["[1][0]" analysis {"+" Environment Analysis} - ["[1]/[0]" complex]] - ["/" synthesis {"+" Path Abstraction Synthesis Operation Phase}] - [/// - [arity {"+" Arity}] - ["[1][0]" reference - ["[1]/[0]" variable {"+" Register Variable}]] - ["[0]" phase ("[1]#[0]" monad)]]]]) + [library + [lux "*" + [abstract + ["[0]" monad {"+" do}] + ["[0]" enum]] + [control + [pipe {"+" case>}] + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" exception {"+" exception:}]] + [data + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor monoid)]]] + [math + [number + ["n" nat]]]]] + ["[0]" // "_" + ["[1][0]" loop {"+" Transform}] + ["//[1]" /// "_" + ["[1][0]" analysis {"+" Environment Analysis} + ["[1]/[0]" complex]] + ["/" synthesis {"+" Path Abstraction Synthesis Operation Phase}] + [/// + [arity {"+" Arity}] + ["[1][0]" reference + ["[1]/[0]" variable {"+" Register Variable}]] + ["[0]" phase ("[1]#[0]" monad)]]]]) (exception: .public (cannot_find_foreign_variable_in_environment [foreign Register environment (Environment Synthesis)]) @@ -50,7 +50,7 @@ (def: .public (apply phase) (-> Phase Phase) (function (_ archive exprA) - (let [[funcA argsA] (////analysis.application exprA)] + (let [[funcA argsA] (////analysis.reification exprA)] (do [! phase.monad] [funcS (phase archive funcA) argsS (monad.each ! (phase archive) argsA)] diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux index 7caae5fdd..a3f401643 100644 --- a/stdlib/source/test/lux/control/parser/analysis.lux +++ b/stdlib/source/test/lux/control/parser/analysis.lux @@ -87,8 +87,8 @@ [/.frac /.frac! random.safe_frac analysis.frac f.=] [/.rev /.rev! random.rev analysis.rev r.=] [/.text /.text! (random.unicode 10) analysis.text text#=] - [/.local /.local! random.nat analysis.variable/local n.=] - [/.foreign /.foreign! random.nat analysis.variable/foreign n.=] + [/.local /.local! random.nat analysis.local n.=] + [/.foreign /.foreign! random.nat analysis.foreign n.=] [/.constant /.constant! ..constant analysis.constant symbol#=] )) (do [! random.monad] diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 3a10b530d..62ef895da 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -110,6 +110,7 @@ (in (case (do try.monad [class (/class.class /version.v6_0 /class.public (/name.internal class_name) + (/type.declaration class_name (list)) (/name.internal "java.lang.Object") (list) (list) @@ -853,6 +854,7 @@ static_method "static_method" bytecode (|> (/class.class /version.v6_0 /class.public (/name.internal class_name) + (/type.declaration class_name (list)) (/name.internal "java.lang.Object") (list) (list (/field.field /field.static class_field /type.long (sequence.sequence)) @@ -1330,6 +1332,7 @@ (in (case (do try.monad [class (/class.class /version.v6_0 /class.public (/name.internal class_name) + (/type.declaration class_name (list)) (/name.internal "java.lang.Object") (list) (list) @@ -1629,6 +1632,7 @@ interface_bytecode (|> (/class.class /version.v6_0 ($_ /modifier#composite /class.public /class.abstract /class.interface) (/name.internal interface_class) + (/type.declaration interface_class (list)) (/name.internal "java.lang.Object") (list) (list) @@ -1639,6 +1643,7 @@ (format.result /class.writer)) abstract_bytecode (|> (/class.class /version.v6_0 ($_ /modifier#composite /class.public /class.abstract) (/name.internal abstract_class) + (/type.declaration abstract_class (list)) (/name.internal "java.lang.Object") (list) (list) @@ -1664,6 +1669,7 @@ (/.invokevirtual class method method::type)))) concrete_bytecode (|> (/class.class /version.v6_0 /class.public (/name.internal concrete_class) + (/type.declaration concrete_class (list)) (/name.internal abstract_class) (list (/name.internal interface_class)) (list) diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux index 2a2f9667d..516037ea9 100644 --- a/stdlib/source/test/lux/target/ruby.lux +++ b/stdlib/source/test/lux/target/ruby.lux @@ -3,6 +3,7 @@ [lux "*" ["_" test {"+" Test}] ["[0]" ffi] + ["[0]" debug] [abstract [monad {"+" do}] ["[0]" predicate] @@ -340,12 +341,103 @@ ..test|computation) )))) -(def: test/location +(def: test|local_var + Test + (do [! random.monad] + [float/0 random.safe_frac + $foreign (# ! each /.local (random.ascii/lower 10))] + ($_ _.and + (_.cover [/.local] + (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0))) + (|> (/.return (/.+ $foreign $foreign)) + [(list $foreign)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.float float/0)))))) + (_.cover [/.set] + (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0))) + (|> ($_ /.then + (/.set (list $foreign) (/.float float/0)) + (/.return (/.+ $foreign $foreign))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + ))) + +(def: test|instance_var + Test + (do [! random.monad] + [float/0 random.safe_frac + instance (# ! each (|>> %.nat (format "instance_")) + random.nat) + .let [$instance (/.instance instance)] + $method (# ! each (|>> %.nat (format "method_") /.local) + random.nat) + $class (# ! each (|>> %.nat (format "class_") /.local) + random.nat) + $object (# ! each (|>> %.nat (format "object_") /.local) + random.nat)] + ($_ _.and + (_.cover [/.instance] + (expression (|>> (:as Frac) (f.= float/0)) + (|> ($_ /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body ($_ /.then + (/.function /.initialize (list) + (/.set (list $instance) (/.float float/0))) + (/.function $method (list) + (/.return $instance)) + )])) + (/.return (|> $class + (/.new (list) {.#None}) + (/.do (/.code $method) (list) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.attr_reader/*] + (expression (|>> (:as Frac) (f.= float/0)) + (|> ($_ /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body ($_ /.then + (/.attr_reader/* (list instance)) + (/.function /.initialize (list) + (/.set (list $instance) (/.float float/0))) + )])) + (/.return (|> $class + (/.new (list) {.#None}) + (/.the instance)))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.attr_writer/*] + (expression (|>> (:as Frac) (f.= float/0)) + (|> ($_ /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body ($_ /.then + (/.attr_writer/* (list instance)) + (/.function $method (list) + (/.return $instance)) + )])) + (/.set (list $object) (|> $class + (/.new (list) {.#None}))) + (/.set (list (/.the instance $object)) (/.float float/0)) + (/.return (|> $object + (/.do (/.code $method) (list) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.attr_accessor/*] + (expression (|>> (:as Frac) (f.= float/0)) + (|> ($_ /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (/.attr_accessor/* (list instance))])) + (/.set (list $object) (|> $class + (/.new (list) {.#None}))) + (/.set (list (/.the instance $object)) (/.float float/0)) + (/.return (/.the instance $object))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + ))) + +(def: test|var Test (do [! random.monad] [float/0 random.safe_frac $foreign (# ! each /.local (random.ascii/lower 10)) - field (# ! each /.string (random.ascii/upper 10)) $inputs (# ! each /.local (random.ascii/lower 10)) arity (# ! each (n.% 10) random.nat) @@ -356,44 +448,49 @@ (random.set text.hash arity) (# ! each (|>> set.list (list#each /.string))))] ($_ _.and - (<| (_.for [/.Var]) + (_.cover [/.defined?/1] + (and (expression (|>> (:as Bit)) + (|> (/.defined?/1 $foreign) + (/.= /.nil))) + (expression (|>> (:as Text) (text#= "local-variable")) + (|> ($_ /.then + (/.set (list $foreign) (/.float float/0)) + (/.return (/.defined?/1 $foreign))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list)))))) + (_.for [/.LVar] + ..test|local_var) + (_.for [/.IVar] + ..test|instance_var) + (<| (_.for [/.LVar*]) ($_ _.and - (_.cover [/.defined?/1] - (and (expression (|>> (:as Bit)) - (|> (/.defined?/1 $foreign) - (/.= /.nil))) - (expression (|>> (:as Text) (text#= "local-variable")) - (|> ($_ /.then - (/.set (list $foreign) (/.float float/0)) - (/.return (/.defined?/1 $foreign))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list)))))) - (_.cover [/.LVar /.local /.set] - (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0))) - (|> ($_ /.then - (/.set (list $foreign) (/.+ $foreign $foreign)) - (/.return $foreign)) - [(list $foreign)] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.float float/0)))))) - (<| (_.for [/.LVar*]) - ($_ _.and - (_.cover [/.variadic] - (expression (|>> (:as Int) .nat (n.= arity)) - (|> (/.return (/.the "length" $inputs)) - [(list (/.variadic $inputs))] (/.lambda {.#None}) - (/.apply_lambda/* vals)))) - (_.cover [/.splat] - (expression (|>> (:as Int) .nat (n.= arity)) - (|> (/.return (/.the "length" (/.array (list (/.splat $inputs))))) - [(list (/.variadic $inputs))] (/.lambda {.#None}) - (/.apply_lambda/* vals)))))) - (<| (_.for [/.LVar**]) - (_.cover [/.variadic_kv /.double_splat] - (expression (|>> (:as Int) .nat (n.= arity)) - (|> (/.return (/.the "length" $inputs)) - [(list (/.variadic_kv $inputs))] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.double_splat (/.hash (list.zipped/2 keys vals))))))))) - )) + (_.cover [/.variadic] + (expression (|>> (:as Int) .nat (n.= arity)) + (|> (/.return (/.the "length" $inputs)) + [(list (/.variadic $inputs))] (/.lambda {.#None}) + (/.apply_lambda/* vals)))) + (_.cover [/.splat] + (expression (|>> (:as Int) .nat (n.= arity)) + (|> (/.return (/.the "length" (/.array (list (/.splat $inputs))))) + [(list (/.variadic $inputs))] (/.lambda {.#None}) + (/.apply_lambda/* vals)))))) + (<| (_.for [/.LVar**]) + (_.cover [/.variadic_kv /.double_splat] + (expression (|>> (:as Int) .nat (n.= arity)) + (|> (/.return (/.the "length" $inputs)) + [(list (/.variadic_kv $inputs))] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.double_splat (/.hash (list.zipped/2 keys vals))))))))) + ))) + +(def: test|location + Test + (do [! random.monad] + [float/0 random.safe_frac + $foreign (# ! each /.local (random.ascii/lower 10)) + field (# ! each /.string (random.ascii/upper 10))] + ($_ _.and + (<| (_.for [/.Var]) + ..test|var) (_.cover [/.Access] (and (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0))) (let [@ (/.item (/.int +0) $foreign)] @@ -483,7 +580,7 @@ (def: test|loop Test (do [! random.monad] - [input random.int + [input (# ! each (i.right_shifted 32) random.int) iterations (# ! each (n.% 10) random.nat) .let [$input (/.local "input") $output (/.local "output") @@ -728,7 +825,7 @@ (_.for [/.Block] ..test|function) (_.for [/.Location] - ..test/location) + ..test|location) ))) (def: test|global diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 635322a92..78aaee40e 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -14,7 +14,8 @@ ["[1][0]" analysis] ["[1][0]" phase "_" ["[1]/[0]" extension] - ... ["[1]/[0]" analysis] + ["[1]/[0]" analysis "_" + ["[1]/[0]" simple]] ... ["[1]/[0]" synthesis] ]]] ["[1][0]" meta "_" @@ -38,7 +39,7 @@ /meta/archive/key.test /meta/archive/document.test /phase/extension.test + /phase/analysis/simple.test ... /syntax.test - ... /analysis.test ... /synthesis.test )) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux index 210d6d29a..69c608fda 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux @@ -169,8 +169,8 @@ _ false))] - [/.variable/local expected_register] - [/.variable/foreign expected_register] + [/.local expected_register] + [/.foreign expected_register] [/.constant expected_constant] [/.variable expected_variable] )) @@ -184,7 +184,7 @@ _ false)]) -(def: test|application +(def: test|reification Test (do random.monad [expected_abstraction (random.only (|>> (..tagged? /.#Apply) not) @@ -192,10 +192,10 @@ expected_parameter/0 (..random 2) expected_parameter/1 (..random 2)] ($_ _.and - (_.cover [/.apply /.application] + (_.cover [/.reified /.reification] (case (|> [expected_abstraction (list expected_parameter/0 expected_parameter/1)] - /.apply - /.application) + /.reified + /.reification) (^ [actual_abstraction (list actual_parameter/0 actual_parameter/1)]) (and (same? expected_abstraction actual_abstraction) (same? expected_parameter/0 actual_parameter/0) @@ -421,8 +421,8 @@ ..test|simple ..test|complex ..test|reference - (_.for [/.Application] - ..test|application) + (_.for [/.Reification] + ..test|reification) (_.for [/.Branch /.Branch' /.Match /.Match'] ..test|case) (_.for [/.Operation /.Phase /.Handler /.Bundle] diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux deleted file mode 100644 index 252148fb5..000000000 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux +++ /dev/null @@ -1,115 +0,0 @@ -(.using - [lux {"-" primitive} - ["@" target] - [abstract - ["[0]" monad {"+" do}]] - [data - ["%" text/format {"+" format}]] - ["r" math/random {"+" Random} ("[1]#[0]" monad)] - ["_" test {"+" Test}] - [control - pipe - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}]] - [macro - ["[0]" code]] - [meta - ["[0]" symbol]]] - [\\ - ["[0]" / - ["/[1]" // - ["[1][0]" type] - ["/[1]" // "_" - [extension - ["[0]" bundle] - ["[1][0]" analysis]] - ["/[1]" // "_" - ["[0]" version] - ["[1][0]" analysis {"+" Analysis Operation} - [macro {"+" Expander}] - [evaluation {"+" Eval}]] - [/// - ["[0]" phase] - [meta - ["[0]" archive]]]]]]]]) - -(def: .public (expander macro inputs state) - Expander - {try.#Failure "NOPE"}) - -(def: .public (eval archive count type expression) - Eval - (function (_ state) - {try.#Failure "NO!"})) - -(def: .public phase - ////analysis.Phase - (//.phase ..expander)) - -(def: .public state - ////analysis.State+ - [(///analysis.bundle ..eval bundle.empty) - (////analysis.state (////analysis.info version.version @.jvm))]) - -(def: .public primitive - (Random [Type Code]) - (`` ($_ r.either - (~~ (template [ ] - [(r.and (r#in ) (r#each ))] - - [Any code.tuple (r.list 0 (r#in (' [])))] - [Bit code.bit r.bit] - [Nat code.nat r.nat] - [Int code.int r.int] - [Rev code.rev r.rev] - [Frac code.frac r.frac] - [Text code.text (r.unicode 5)] - ))))) - -(exception: (wrong_inference [expected Type - inferred Type]) - (exception.report - ["Expected" (%.type expected)] - ["Inferred" (%.type inferred)])) - -(def: (infer expected_type analysis) - (-> Type (Operation Analysis) (Try Analysis)) - (|> analysis - //type.with_inference - (phase.result ..state) - (case> {try.#Success [inferred_type output]} - (if (same? expected_type inferred_type) - {try.#Success output} - (exception.except wrong_inference [expected_type inferred_type])) - - {try.#Failure error} - {try.#Failure error}))) - -(def: .public test - (<| (_.context (symbol.module (symbol /._))) - (`` ($_ _.and - (_.test (%.symbol (symbol ////analysis.#Unit)) - (|> (infer Any (..phase archive.empty (' []))) - (case> (^ {try.#Success {////analysis.#Primitive {////analysis.#Unit output}}}) - (same? [] output) - - _ - false))) - (~~ (template [ ] - [(do r.monad - [sample ] - (_.test (%.symbol (symbol )) - (|> (infer (..phase archive.empty ( sample))) - (case> {try.#Success {////analysis.#Primitive { output}}} - (same? sample output) - - _ - false))))] - - [Bit ////analysis.#Bit r.bit code.bit] - [Nat ////analysis.#Nat r.nat code.nat] - [Int ////analysis.#Int r.int code.int] - [Rev ////analysis.#Rev r.rev code.rev] - [Frac ////analysis.#Frac r.frac code.frac] - [Text ////analysis.#Text (r.unicode 5) code.text] - )))))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux new file mode 100644 index 000000000..015c9d362 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux @@ -0,0 +1,88 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + ["[0]" type ("[1]#[0]" equivalence)] + [abstract + [monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" try]] + [math + ["[0]" random]]]] + [\\library + ["[0]" / + [// + ["[1][0]" type] + [// + ["[1][0]" extension] + [// + ["[1][0]" analysis {"+" Analysis Operation}] + [/// + ["[1][0]" phase]]]]]]]) + +(def: (analysis state type it ?) + (-> Lux Type (Operation Analysis) (-> Analysis Bit) Bit) + (and (|> (/type.with_type type + it) + (/phase.result [/extension.#bundle /extension.empty + /extension.#state state]) + (case> (^ {try.#Success analysis}) + (? analysis) + + _ + false)) + (|> (/type.with_type .Nothing + it) + (/phase.result [/extension.#bundle /extension.empty + /extension.#state state]) + (case> (^ {try.#Failure error}) + true + + _ + false)) + (|> (/type.with_inference + it) + (/phase.result [/extension.#bundle /extension.empty + /extension.#state state]) + (case> (^ {try.#Success [inferred analysis]}) + (and (type#= type inferred) + (? analysis)) + + _ + false)))) + +(template: (analysis? ) + [(: (-> Analysis Bit) + (function (_ expected) + (|>> (case> (^ ( actual)) + (same? expected actual) + + _ + false))))]) + +(def: .public test + (<| (_.covering /._) + (do [! random.monad] + [version random.nat + host (random.ascii/lower 5) + .let [state (/analysis.state (/analysis.info version host))]] + (`` ($_ _.and + (_.cover [/.unit] + (..analysis state .Any /.unit + (|>> (case> (^ (/analysis.unit)) true _ false)))) + (~~ (template [ ] + [(do ! + [sample ] + (_.cover [] + (..analysis state ( sample) + ((..analysis? ) sample))))] + + [/.bit .Bit random.bit /analysis.bit] + [/.nat .Nat random.nat /analysis.nat] + [/.int .Int random.int /analysis.int] + [/.rev .Rev random.rev /analysis.rev] + [/.frac .Frac random.frac /analysis.frac] + [/.text .Text (random.unicode 1) /analysis.text] + )) + ))))) -- cgit v1.2.3