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 +++++------ 21 files changed, 353 insertions(+), 291 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 (limited to 'stdlib/source/library') 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)] -- cgit v1.2.3