diff options
Diffstat (limited to '')
22 files changed, 573 insertions, 181 deletions
diff --git a/stdlib/source/library/lux/target/jvm/attribute.lux b/stdlib/source/library/lux/target/jvm/attribute.lux index e070c6326..ffef45083 100644 --- a/stdlib/source/library/lux/target/jvm/attribute.lux +++ b/stdlib/source/library/lux/target/jvm/attribute.lux @@ -130,9 +130,9 @@ (def: .public (signature it) (All (_ category) - (-> (Type category) (Resource Attribute))) + (-> (Signature category) (Resource Attribute))) (do [! //pool.monad] - [it (|> it //type.signature //signature.signature //pool.utf8)] + [it (|> it //signature.signature //pool.utf8)] (# ! each (signature' it) (//pool.utf8 "Signature")))) (def: .public (writer it) diff --git a/stdlib/source/library/lux/target/jvm/class.lux b/stdlib/source/library/lux/target/jvm/class.lux index 7a342dd54..2235046e9 100644 --- a/stdlib/source/library/lux/target/jvm/class.lux +++ b/stdlib/source/library/lux/target/jvm/class.lux @@ -25,7 +25,8 @@ ["[1][0]" unsigned] ["[1][0]" name {"+" Internal}]] ["[1][0]" type {"+" Type} - [category {"+" Declaration}]] + [category {"+" Inheritance}] + ["[2][0]" signature {"+" Signature}]] ["[1][0]" constant {"+" Constant} ["[2][0]" pool {"+" Pool Resource}]]]) @@ -86,10 +87,10 @@ (in [@this @super @interfaces]))) (def: .public (class version modifier - this type super interfaces + this signature super interfaces fields methods attributes) (-> Major (Modifier Class) - Internal (Type Declaration) Internal (List Internal) + Internal (Maybe (Signature Inheritance)) Internal (List Internal) (List (Resource Field)) (List (Resource Method)) (Sequence Attribute) @@ -101,7 +102,12 @@ [classes (install_classes this super interfaces) =fields (monad.all ! fields) =methods (monad.all ! methods) - @signature (//attribute.signature type)] + @signature (case signature + {.#Some signature} + (# ! each (|>> {.#Some}) (//attribute.signature signature)) + + {.#None} + (in {.#None}))] (in [classes =fields =methods @signature])))] (in [#magic //magic.code #minor_version //version.default_minor @@ -113,7 +119,12 @@ #interfaces @interfaces #fields (sequence.of_list =fields) #methods (sequence.of_list =methods) - #attributes (sequence.suffix @signature attributes)]))) + #attributes (case @signature + {.#Some @signature} + (sequence.suffix @signature attributes) + + {.#None} + attributes)]))) (def: .public (writer class) (Writer Class) diff --git a/stdlib/source/library/lux/target/jvm/method.lux b/stdlib/source/library/lux/target/jvm/method.lux index 48bd523e8..00647a199 100644 --- a/stdlib/source/library/lux/target/jvm/method.lux +++ b/stdlib/source/library/lux/target/jvm/method.lux @@ -25,7 +25,7 @@ ["[1][0]" type {"+" Type} [descriptor {"+" Descriptor}] ["[2][0]" category] - ["[2][0]" signature]]]) + ["[2][0]" signature {"+" Signature}]]]) (type: .public Method (Rec Method @@ -57,7 +57,7 @@ [@name (//pool.utf8 name) @descriptor (//pool.descriptor (//type.descriptor type)) attributes (|> attributes - (list& (//attribute.signature type)) + (list& (//attribute.signature (//type.signature type))) (monad.all !) (# ! each sequence.of_list)) attributes (case code diff --git a/stdlib/source/library/lux/target/jvm/type/category.lux b/stdlib/source/library/lux/target/jvm/type/category.lux index 660ec9962..207c304a5 100644 --- a/stdlib/source/library/lux/target/jvm/type/category.lux +++ b/stdlib/source/library/lux/target/jvm/type/category.lux @@ -34,3 +34,4 @@ ) (abstract: .public Declaration Any) +(abstract: .public Inheritance Any) diff --git a/stdlib/source/library/lux/target/jvm/type/signature.lux b/stdlib/source/library/lux/target/jvm/type/signature.lux index f38e433b5..ee93afa32 100644 --- a/stdlib/source/library/lux/target/jvm/type/signature.lux +++ b/stdlib/source/library/lux/target/jvm/type/signature.lux @@ -4,6 +4,8 @@ [abstract [equivalence {"+" Equivalence}] [hash {"+" Hash}]] + [control + [pipe {"+" case>}]] [data ["[0]" text ("[1]#[0]" hash) ["%" format {"+" format}]] @@ -12,7 +14,7 @@ [type abstract]]] ["[0]" // "_" - [category {"+" Void Value Return Method Primitive Object Class Array Var Parameter Declaration}] + [category {"+" Void Value Return Method Primitive Object Class Array Var Parameter Declaration Inheritance}] ["[1][0]" descriptor] ["/[1]" // "_" [encoding @@ -51,21 +53,21 @@ (Signature Parameter) (:abstraction "*")) - (def: .public var_prefix "T") - - (def: .public var - (-> Text (Signature Var)) - (|>> (text.enclosed [..var_prefix //descriptor.class_suffix]) - :abstraction)) + (template [<char> <name>] + [(def: .public <name> <char>)] - (def: .public var_name - (-> (Signature Var) Text) - (|>> :representation - (text.replaced ..var_prefix "") - (text.replaced //descriptor.class_suffix ""))) + ["T" var_prefix] + ["-" lower_prefix] + ["+" upper_prefix] + + ["<" parameters_start] + [">" parameters_end] + [":" format_type_parameter_infix] - (def: .public lower_prefix "-") - (def: .public upper_prefix "+") + ["(" arguments_start] + [")" arguments_end] + ["^" exception_prefix] + ) (template [<name> <prefix>] [(def: .public <name> @@ -76,13 +78,16 @@ [upper ..upper_prefix] ) - (template [<char> <name>] - [(def: .public <name> - <char>)] + (def: .public var + (-> Text (Signature Var)) + (|>> (text.enclosed [..var_prefix //descriptor.class_suffix]) + :abstraction)) - ["<" parameters_start] - [">" parameters_end] - ) + (def: .public var_name + (-> (Signature Var) Text) + (|>> :representation + (text.replaced ..var_prefix "") + (text.replaced //descriptor.class_suffix ""))) (def: .public (class name parameters) (-> External (List (Signature Parameter)) (Signature Class)) @@ -105,24 +110,44 @@ (-> External (List (Signature Var)) (Signature Declaration)) (:transmutation (..class name variables))) - (def: .public as_class - (-> (Signature Declaration) (Signature Class)) - (|>> :transmutation)) - - (template [<char> <name>] - [(def: .public <name> <char>)] - - ["(" arguments_start] - [")" arguments_end] - ["^" exception_prefix] - [":" format_type_parameter_infix] - ) - (def: class_bound (|> (..class "java.lang.Object" (list)) ..signature (format ..format_type_parameter_infix))) + (def: var_declaration/1 + (-> (Signature Var) Text) + (|>> ..var_name + (text.suffix ..class_bound))) + + (def: var_declaration/+ + (-> (List (Signature Var)) Text) + (|>> (list#each ..var_declaration/1) + text.together + (text.enclosed [..parameters_start + ..parameters_end]))) + + (def: var_declaration/* + (-> (List (Signature Var)) Text) + (|>> (case> {.#End} + "" + + it + (..var_declaration/+ it)))) + + (def: .public (inheritance variables super interfaces) + (-> (List (Signature Var)) (Signature Class) (List (Signature Class)) (Signature Inheritance)) + (:abstraction + (format (var_declaration/* variables) + (:representation super) + (|> interfaces + (list#each ..signature) + text.together)))) + + (def: .public as_class + (-> (Signature Declaration) (Signature Class)) + (|>> :transmutation)) + (def: .public (method [type_variables inputs output exceptions]) (-> [(List (Signature Var)) (List (Signature Value)) @@ -130,16 +155,7 @@ (List (Signature Class))] (Signature Method)) (:abstraction - (format (case type_variables - {.#End} - "" - _ - (|> type_variables - (list#each (|>> ..var_name - (text.suffix ..class_bound))) - text.together - (text.enclosed [..parameters_start - ..parameters_end]))) + (format (var_declaration/* type_variables) (|> inputs (list#each ..signature) text.together diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index 1d96e72ff..d243b6046 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -506,3 +506,11 @@ (def: .public (throw/2 tag value) (-> Expression Expression Statement) (..statement (..apply/* (list tag value) {.#None} (..manual "throw")))) + +(def: .public (class_variable_set var value object) + (-> SVar Expression Expression Computation) + (..do "class_variable_set" (list (..string (..code var)) value) {.#None} object)) + +(def: .public (class_variable_get var object) + (-> SVar Expression Computation) + (..do "class_variable_get" (list (..string (..code var))) {.#None} object)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux index 586117fb9..98fb50427 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux @@ -1,17 +1,17 @@ (.using - [library - [lux "*" - [abstract - [monad {"+" do}]] - [control - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}]] - [data - ["[0]" text - ["%" format {"+" format}]]] - ["[0]" meta]]] - [///// - ["[0]" phase]]) + [library + [lux "*" + [abstract + [monad {"+" do}]] + [control + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}]] + [data + ["[0]" text + ["%" format {"+" format}]]] + ["[0]" meta]]] + [///// + ["[0]" phase]]) (exception: .public (expansion_failed [macro Symbol inputs (List Code) @@ -32,22 +32,22 @@ (type: .public Expander (-> Macro (List Code) Lux (Try (Try [Lux (List Code)])))) -(def: .public (expand expander name macro inputs) +(def: .public (expansion expander name macro inputs) (-> Expander Symbol Macro (List Code) (Meta (List Code))) (function (_ state) (do try.monad [output (expander macro inputs state)] (case output - {try.#Success output} - {try.#Success output} - {try.#Failure error} - ((meta.failure (exception.error ..expansion_failed [name inputs error])) state))))) + ((meta.failure (exception.error ..expansion_failed [name inputs error])) state) -(def: .public (expand_one expander name macro inputs) + _ + output)))) + +(def: .public (single_expansion expander name macro inputs) (-> Expander Symbol Macro (List Code) (Meta Code)) (do meta.monad - [expansion (expand expander name macro inputs)] + [expansion (..expansion expander name macro inputs)] (case expansion (^ (list single)) (in single) 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 fb64abaf3..3add55843 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 @@ -113,7 +113,7 @@ (case ?macro {.#Some macro} (do ! - [expansion (//extension.lifted (/macro.expand_one expander def_name macro argsC+))] + [expansion (//extension.lifted (/macro.single_expansion expander def_name macro argsC+))] (compile archive expansion)) _ diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux index fefafe199..6fbc49090 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux @@ -109,7 +109,7 @@ {.#None} (//.except ..macro_was_not_found macro_name))] - (//extension.lifted (///analysis/macro.expand expander macro_name macro inputs))) + (//extension.lifted (///analysis/macro.expansion expander macro_name macro inputs))) _ (//.except ..invalid_macro_call code))))] 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 0f076e04a..ba635d72f 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 @@ -2128,9 +2128,13 @@ not)) sub_set)) -(exception: .public (class_parameter_mismatch [expected (List Text) +(exception: .public (class_parameter_mismatch [name Text + declaration (Type Class) + expected (List Text) actual (List (Type Parameter))]) (exception.report + ["Class" (%.text name)] + ["Declaration" (signature.signature (jvm.signature declaration))] ["Expected (amount)" (%.nat (list.size expected))] ["Expected (parameters)" (exception.listing %.text expected)] ["Actual (amount)" (%.nat (list.size actual))] @@ -2140,11 +2144,11 @@ (-> java/lang/ClassLoader (Type Class) (Operation Aliasing)) (do phase.monad [.let [[name actual_parameters] (jvm_parser.read_class class)] - class (phase.lifted (reflection!.load class_loader name)) - .let [expected_parameters (|> (java/lang/Class::getTypeParameters class) + jvm_class (phase.lifted (reflection!.load class_loader name)) + .let [expected_parameters (|> (java/lang/Class::getTypeParameters jvm_class) (array.list {.#None}) (list#each (|>> java/lang/reflect/TypeVariable::getName)))] - _ (phase.assertion ..class_parameter_mismatch [expected_parameters actual_parameters] + _ (phase.assertion ..class_parameter_mismatch [name class expected_parameters actual_parameters] (n.= (list.size expected_parameters) (list.size actual_parameters)))] (in (|> (list.zipped/2 expected_parameters actual_parameters) 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 72f978083..bdf4d3e11 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 @@ -6,10 +6,12 @@ ["[0]" monad {"+" do}]] [control [pipe {"+" case>}] + ["[0]" try {"+" Try} ("[1]#[0]" functor)] ["<>" parser ("[1]#[0]" monad) ["<[0]>" code {"+" Parser}] ["<[0]>" text]]] [data + [binary {"+" Binary}] ["[0]" product] [text ["%" format {"+" format}]] @@ -82,6 +84,13 @@ (Parser Declaration) (<code>.form (<>.and <code>.text (<>.some jvm.var)))) +(def: method_privacy + (-> ffi.Privacy (Modifier method.Method)) + (|>> (case> {ffi.#PublicP} method.public + {ffi.#PrivateP} method.private + {ffi.#ProtectedP} method.protected + {ffi.#DefaultP} modifier.empty))) + (def: visibility (Parser (Modifier field.Field)) (`` ($_ <>.either @@ -180,11 +189,9 @@ jvm.overriden_method_definition )) -(def: (constraint name) - (-> Text Constraint) - [type.#name name - type.#super_class (type.class "java.lang.Object" (list)) - type.#super_interfaces (list)]) +(def: $Object + (Type Class) + (type.class "java.lang.Object" (list))) (def: constant::modifier (Modifier field.Field) @@ -223,7 +230,7 @@ ... TODO: Handle annotations. {#Variable [name visibility state annotations type]} (field.field (modifier#composite visibility state) - name type (sequence.sequence)))) + name type sequence.empty))) (def: (method_definition archive supers [mapping selfT] [analyse synthesize generate]) (-> Archive @@ -252,11 +259,189 @@ (directive.lifted_synthesis (synthesize archive methodA))))) +(def: (mock_class [name parameters] super interfaces fields methods modifier) + (-> Declaration (Type Class) (List (Type Class)) + (List (Resource field.Field)) (List (Resource method.Method)) (Modifier class.Class) + (Try [External Binary])) + (let [class_name (|>> parser.read_class product.left name.internal) + signature (signature.inheritance (list#each type.signature parameters) + (type.signature super) + (list#each type.signature interfaces))] + (try#each (|>> (format.result class.writer) + [name]) + (class.class version.v6_0 + ($_ modifier#composite + class.public + modifier) + (name.internal name) + {.#Some signature} + (class_name super) + (list#each class_name interfaces) + fields + methods + sequence.empty)))) + +(def: (mock_field it) + (-> ..Field (Resource field.Field)) + (case it + ... TODO: Handle constants + {#Constant [name annotations type term]} + (undefined) + + {#Variable [name visibility state annotations type]} + (field.field ($_ modifier#composite visibility state) name type sequence.empty))) + +(def: (mock_value valueT) + (-> (Type Value) (Bytecode Any)) + (case (type.primitive? valueT) + {.#Left classT} + _.aconst_null + + {.#Right primitiveT} + (cond (# type.equivalence = type.long primitiveT) + _.lconst_0 + + (# type.equivalence = type.float primitiveT) + _.fconst_0 + + (# type.equivalence = type.double primitiveT) + _.dconst_0 + + ... type.boolean type.byte type.short type.int type.char + _.iconst_0))) + +(def: (mock_return returnT) + (-> (Type Return) (Bytecode Any)) + (case (type.void? returnT) + {.#Right returnT} + _.return + + {.#Left valueT} + ($_ _.composite + (mock_value valueT) + (case (type.primitive? valueT) + {.#Left classT} + _.areturn + + {.#Right primitiveT} + (cond (# type.equivalence = type.long primitiveT) + _.lreturn + + (# type.equivalence = type.float primitiveT) + _.freturn + + (# type.equivalence = type.double primitiveT) + _.dreturn + + ... type.boolean type.byte type.short type.int type.char + _.ireturn))))) + +(def: constructor_name + "<init>") + +(def: (mock_method super method) + (-> (Type Class) ..Method_Definition (Resource method.Method)) + (case method + {#Constructor [privacy strict_floating_point? annotations variables exceptions + self arguments constructor_arguments + body]} + (method.method ($_ modifier#composite + (..method_privacy privacy) + (if strict_floating_point? + method.strict + modifier.empty)) + ..constructor_name + (type.method [variables (list#each product.right arguments) type.void exceptions]) + (list) + {.#Some ($_ _.composite + (_.aload 0) + (|> constructor_arguments + (list#each (|>> product.left ..mock_value)) + (monad.all _.monad)) + (|> (type.method [(list) (list#each product.left constructor_arguments) type.void (list)]) + (_.invokespecial super ..constructor_name)) + _.return + )}) + + {#Overriden_Method [super name strict_floating_point? annotations variables + self arguments return exceptions + body]} + (method.method ($_ modifier#composite + method.public + (if strict_floating_point? + method.strict + modifier.empty)) + name + (type.method [variables (list#each product.right arguments) return exceptions]) + (list) + {.#Some (..mock_return return)}) + + {#Virtual_Method [name privacy final? strict_floating_point? annotations variables + self arguments return exceptions + body]} + (method.method ($_ modifier#composite + (..method_privacy privacy) + (if strict_floating_point? + method.strict + modifier.empty) + (if final? + method.final + modifier.empty)) + name + (type.method [variables (list#each product.right arguments) return exceptions]) + (list) + {.#Some (..mock_return return)}) + + {#Static_Method [name privacy strict_floating_point? annotations + variables exceptions arguments return + body]} + (method.method ($_ modifier#composite + method.static + (..method_privacy privacy) + (if strict_floating_point? + method.strict + modifier.empty)) + name + (type.method [variables (list#each product.right arguments) return exceptions]) + (list) + {.#Some (..mock_return return)}) + + ... {#Abstract [name privacy annotations + ... variables arguments return exceptions]} + ... (method.method ($_ modifier#composite + ... method.abstract + ... (..method_privacy privacy)) + ... name + ... (type.method [variables (list#each product.right arguments) return exceptions]) + ... (list) + ... {.#None}) + )) + +(def: (mock declaration super interfaces inheritance fields methods) + (-> Declaration + (Type Class) (List (Type Class)) + (Modifier class.Class) (List ..Field) (List ..Method_Definition) + (Try [External Binary])) + (mock_class declaration super interfaces + (list#each ..mock_field fields) + (list#each (..mock_method super) methods) + inheritance)) + +(template [<name> <type> <parser>] + [(def: <name> + (Parser <type>) + (do [! <>.monad] + [raw <code>.text] + (<>.lifted (<text>.result <parser> raw))))] + + [class_declaration [External (List (Type Var))] parser.declaration'] + ) + (def: jvm::class (Handler Anchor (Bytecode Any) Definition) (/.custom [($_ <>.and - ..declaration + ..class_declaration jvm.class (<code>.tuple (<>.some jvm.class)) ..inheritance @@ -264,38 +449,49 @@ (<code>.tuple (<>.some ..field)) (<code>.tuple (<>.some ..method))) (function (_ extension phase archive - [[name parameters] - super_class - super_interfaces + [class_declaration + super + interfaces inheritance ... TODO: Handle annotations. annotations fields methods]) (do [! phase.monad] - [parameters (directive.lifted_analysis + [.let [[name parameters] class_declaration] + mock (<| phase.lifted + (..mock class_declaration + super + interfaces + inheritance + fields + methods)) + ... Necessary for reflection to work properly during analysis. + _ (directive.lifted_generation + (generation.execute! mock)) + parameters (directive.lifted_analysis (typeA.with_env (jvm.parameter_types parameters))) .let [mapping (list#mix (function (_ [parameterJ parameterT] mapping) (dictionary.has (parser.name parameterJ) parameterT mapping)) luxT.fresh parameters)] - super_classT (directive.lifted_analysis - (typeA.with_env - (luxT.check (luxT.class mapping) (..signature super_class)))) - super_interfaceT+ (directive.lifted_analysis - (typeA.with_env - (monad.each check.monad - (|>> ..signature (luxT.check (luxT.class mapping))) - super_interfaces))) + superT (directive.lifted_analysis + (typeA.with_env + (luxT.check (luxT.class mapping) (..signature super)))) + interfaceT+ (directive.lifted_analysis + (typeA.with_env + (monad.each check.monad + (|>> ..signature (luxT.check (luxT.class mapping))) + interfaces))) .let [selfT (jvm.inheritance_relationship_type {.#Primitive name (list#each product.right parameters)} - super_classT - super_interfaceT+)] + superT + interfaceT+)] state (extension.lifted phase.state) .let [analyse (value@ [directive.#analysis directive.#phase] state) synthesize (value@ [directive.#synthesis directive.#phase] state) generate (value@ [directive.#generation directive.#phase] state)] - methods (monad.each ! (..method_definition archive (list& super_class super_interfaces) [mapping selfT] [analyse synthesize generate]) + methods (monad.each ! (..method_definition archive (list& super interfaces) [mapping selfT] [analyse synthesize generate]) methods) ... _ (directive.lifted_generation ... (generation.save! true ["" name] @@ -303,10 +499,10 @@ ... (class.class version.v6_0 ... (modifier#composite class.public inheritance) ... (name.internal name) (list#each (|>> product.left parser.name ..constraint) parameters) - ... super_class super_interfaces + ... super interfaces ... (list#each ..field_definition fields) ... (list) ... TODO: Add methods - ... (sequence.sequence))])) + ... sequence.empty)])) _ (directive.lifted_generation (generation.log! (format "JVM Class " name)))] (in directive.no_requirements)))])) @@ -322,22 +518,13 @@ (list) {.#None}))) -(template [<name> <type> <parser>] - [(def: <name> - (Parser <type>) - (do [! <>.monad] - [raw <code>.text] - (<>.lifted (<text>.result <parser> raw))))] - - [class_declaration [External (List (Type Var))] parser.declaration'] - ) - (def: jvm::class::interface (Handler Anchor (Bytecode Any) Definition) (/.custom [($_ <>.and ..class_declaration (<code>.tuple (<>.some jvm.class)) + ... TODO: Handle annotations. (<code>.tuple (<>.some ..annotation)) (<>.some jvm.method_declaration)) (function (_ extension_name phase archive [[name parameters] supers annotations method_declarations]) @@ -351,13 +538,15 @@ class.abstract class.interface) (name.internal name) - (type.declaration name parameters) + {.#Some (signature.inheritance (list#each type.signature parameters) + (type.signature $Object) + (list#each type.signature supers))} (name.internal "java.lang.Object") (list#each (|>> parser.read_class product.left name.internal) supers) (list) (list#each ..method_declaration method_declarations) - (sequence.sequence))) + sequence.empty)) ... module generation.module ... module_id (generation.module_id module archive) artifact_id (generation.learn_custom name artifact.no_dependencies) @@ -375,7 +564,6 @@ (-> java/lang/ClassLoader Extender (Bundle Anchor (Bytecode Any) Definition)) (<| (bundle.prefix "jvm") (|> bundle.empty - ... TODO: Finish handling methods and un-comment. - ... (dictionary.has "class" jvm::class) + (dictionary.has "class" jvm::class) (dictionary.has "class interface" ..jvm::class::interface) ))) 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 dda74b0e1..d8dc8d591 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 @@ -1225,7 +1225,7 @@ //////.lifted (class.class version.v6_0 ($_ modifier#composite class.public class.final) (name.internal anonymous_class_name) - (type.declaration anonymous_class_name (list)) + {.#None} (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 2227d9f1d..59206b6fb 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 @@ -111,7 +111,7 @@ class (phase.lifted (class.class version.v6_0 ..modifier (name.internal function_class) - (type.declaration function_class (list)) + {.#None} (..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 79c72c425..6ebc13360 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,7 +122,7 @@ bytecode (class.class version.v6_0 class.public (encoding/name.internal bytecode_name) - (type.declaration bytecode_name (list)) + {.#None} (encoding/name.internal "java.lang.Object") (list) (list (field.field ..value::modifier ..value::field ..value::type (sequence.sequence))) (list (method.method ..init::modifier "<clinit>" ..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 bf0bb032d..357922e6c 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,7 +157,7 @@ (class.class version.v6_0 ..program::modifier (name.internal class) - (type.declaration class (list)) + {.#None} 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 74956a7e5..57a446860 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,7 +545,7 @@ (class.class jvm/version.v6_0 modifier (name.internal class) - (type.declaration class (list)) + {.#None} (name.internal (..reflection ^Object)) (list) (list) (let [[left_projection::method right_projection::method] projection::method2] @@ -615,7 +615,7 @@ (class.class jvm/version.v6_0 modifier (name.internal class) - (type.declaration class (list)) + {.#None} (name.internal (..reflection ^Object)) (list) (list partial_count) (list& <init>::method apply::method+) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux index f2b061315..4f87318aa 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux @@ -120,7 +120,7 @@ (type: .public (Function s) (Variant {#Abstraction (Abstraction' s)} - {#Apply s (List s)})) + {#Apply (Apply' s)})) (type: .public (Control s) (Variant diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index c09aff7e6..35e167067 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -152,8 +152,7 @@ (exception.except ..module_is_only_reserved [module]) {.#None} - (exception.except ..unknown_document [module - (dictionary.keys _#resolver)])))) + (exception.except ..unknown_document [module (dictionary.keys _#resolver)])))) (def: .public (archived? archive module) (-> Archive Module Bit) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 62ef895da..616f3f1f5 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -110,7 +110,7 @@ (in (case (do try.monad [class (/class.class /version.v6_0 /class.public (/name.internal class_name) - (/type.declaration class_name (list)) + {.#None} (/name.internal "java.lang.Object") (list) (list) @@ -854,7 +854,7 @@ static_method "static_method" bytecode (|> (/class.class /version.v6_0 /class.public (/name.internal class_name) - (/type.declaration class_name (list)) + {.#None} (/name.internal "java.lang.Object") (list) (list (/field.field /field.static class_field /type.long (sequence.sequence)) @@ -1332,7 +1332,7 @@ (in (case (do try.monad [class (/class.class /version.v6_0 /class.public (/name.internal class_name) - (/type.declaration class_name (list)) + {.#None} (/name.internal "java.lang.Object") (list) (list) @@ -1632,7 +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)) + {.#None} (/name.internal "java.lang.Object") (list) (list) @@ -1643,7 +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)) + {.#None} (/name.internal "java.lang.Object") (list) (list) @@ -1669,7 +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)) + {.#None} (/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 516037ea9..7ec415b16 100644 --- a/stdlib/source/test/lux/target/ruby.lux +++ b/stdlib/source/test/lux/target/ruby.lux @@ -35,7 +35,7 @@ [world ["[0]" file]]]] [\\library - ["[0]" /]]) + ["[0]" / ("[1]#[0]" equivalence)]]) (ffi.import: (eval [Text] "try" "?" Any)) @@ -238,7 +238,7 @@ random.nat) $method/1 (|> random.nat (# ! each (|>> %.nat (format "method_") /.local)) - (random.only (|>> (# /.equivalence = $method/0) not))) + (random.only (|>> (/#= $method/0) not))) $arg/0 (# ! each (|>> %.nat (format "arg_") /.local) random.nat) $state (# ! each (|>> %.nat (format "instance_") /.instance) @@ -341,6 +341,46 @@ ..test|computation) )))) +(def: test|global + Test + (do [! random.monad] + [float/0 random.safe_frac + $global (# ! each /.global (random.ascii/lower 10))] + ($_ _.and + (_.cover [/.global] + (expression (|>> (:as Text) (text#= "global-variable")) + (|> ($_ /.then + (/.set (list $global) (/.float float/0)) + (/.return (/.defined?/1 $global))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.script_name] + (expression (let [file (format (# file.default separator) packager.main_file)] + (|>> (:as Text) + (text.ends_with? file))) + /.script_name)) + (_.cover [/.script_name] + (expression (let [file (format (# file.default separator) packager.main_file)] + (|>> (:as Text) + (text.ends_with? file))) + /.script_name)) + (_.cover [/.input_record_separator] + (expression (|>> (:as Text) + (text#= text.\n)) + /.input_record_separator)) + (_.cover [/.output_record_separator] + (..nil /.output_record_separator)) + (_.cover [/.process_id] + (expression (|>> (:as Nat) (n.= 0) not) + /.process_id)) + (_.cover [/.case_insensitivity_flag] + (expression (|>> (:as Bit) (bit#= false)) + /.case_insensitivity_flag)) + (_.cover [/.command_line_arguments] + (expression (|>> (:as Int) (i.= +0)) + (/.the "length" /.command_line_arguments))) + ))) + (def: test|local_var Test (do [! random.monad] @@ -433,13 +473,36 @@ (/.apply_lambda/* (list))))) ))) -(def: test|var +(def: test|static_var Test (do [! random.monad] - [float/0 random.safe_frac - $foreign (# ! each /.local (random.ascii/lower 10)) + [int/0 (# ! each (|>> (n.% 10) ++ .int) + random.nat) + $static (# ! each (|>> %.nat (format "static_") /.static) + random.nat) + $arg (# ! each (|>> %.nat /.local) + random.nat) + $method (# ! each (|>> %.nat (format "method_") /.local) + random.nat) + $class (# ! each (|>> %.nat (format "class_") /.local) + random.nat)] + ($_ _.and + (_.cover [/.static /.class_variable_set /.class_variable_get] + (expression (|>> (:as Int) (i.= int/0)) + (|> ($_ /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (/.function $method (list) + (/.return (/.int +0)))])) + (/.statement (/.class_variable_set $static (/.int int/0) $class)) + (/.return (/.class_variable_get $static $class))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + ))) - $inputs (# ! each /.local (random.ascii/lower 10)) +(def: test|variadic + Test + (do [! random.monad] + [$inputs (# ! each /.local (random.ascii/lower 10)) arity (# ! each (n.% 10) random.nat) vals (|> random.int (# ! each /.int) @@ -448,20 +511,6 @@ (random.set text.hash arity) (# ! each (|>> set.list (list#each /.string))))] ($_ _.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)))))) - (_.for [/.LVar] - ..test|local_var) - (_.for [/.IVar] - ..test|instance_var) (<| (_.for [/.LVar*]) ($_ _.and (_.cover [/.variadic] @@ -482,6 +531,43 @@ (/.apply_lambda/* (list (/.double_splat (/.hash (list.zipped/2 keys vals))))))))) ))) +(def: test|var + Test + (do [! random.monad] + [float/0 random.safe_frac + $foreign (# ! each /.local (random.ascii/lower 10)) + + $constant (# ! each /.constant (random.ascii/lower 10))] + ($_ _.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)))))) + (_.for [/.CVar] + (_.cover [/.constant] + (expression (|>> (:as Text) (text#= "constant")) + (|> ($_ /.then + (/.set (list $constant) (/.float float/0)) + (/.return (/.defined?/1 $constant))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list)))))) + (_.for [/.GVar] + ..test|global) + (_.for [/.LVar] + ..test|local_var) + (_.for [/.IVar] + ..test|instance_var) + (_.for [/.SVar] + ..test|static_var) + ..test|variadic + ))) + (def: test|location Test (do [! random.monad] @@ -828,33 +914,6 @@ ..test|location) ))) -(def: test|global - Test - (do random.monad - [_ (in [])] - ($_ _.and - (_.cover [/.script_name] - (expression (let [file (format (# file.default separator) packager.main_file)] - (|>> (:as Text) - (text.ends_with? file))) - /.script_name)) - (_.cover [/.input_record_separator] - (expression (|>> (:as Text) - (text#= text.\n)) - /.input_record_separator)) - (_.cover [/.output_record_separator] - (..nil /.output_record_separator)) - (_.cover [/.process_id] - (expression (|>> (:as Nat) (n.= 0) not) - /.process_id)) - (_.cover [/.case_insensitivity_flag] - (expression (|>> (:as Bit) (bit#= false)) - /.case_insensitivity_flag)) - (_.cover [/.command_line_arguments] - (expression (|>> (:as Int) (i.= +0)) - (/.the "length" /.command_line_arguments))) - ))) - (def: random_expression (Random /.Expression) (let [literal (: (Random /.Literal) @@ -881,11 +940,9 @@ (_.cover [/.code /.manual] (|> (/.manual (/.code expected)) (: /.Expression) - (# /.equivalence = expected))) + (/#= expected))) (_.for [/.Expression] ..test|expression) (_.for [/.Statement] ..test|statement) - (_.for [/.GVar] - ..test|global) )))) 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 69c608fda..c1bc9d62e 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux @@ -27,6 +27,7 @@ ["[1][0]" simple] ["[1][0]" complex] ["[1][0]" pattern] + ["[1][0]" macro] [//// ["[1][0]" reference ["[2][0]" variable]] @@ -436,4 +437,5 @@ /simple.test /complex.test /pattern.test + /macro.test )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux new file mode 100644 index 000000000..b976dab87 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux @@ -0,0 +1,106 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + ["[0]" meta] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + [pipe {"+" case>}] + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] + [collection + ["[0]" list ("[1]#[0]" monad)]]] + [macro + ["[0]" code ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" monad)] + [number + ["n" nat]]]]] + ["$" /////// "_" + [macro + ["[1][0]" code]] + [meta + ["[1][0]" symbol]]] + [\\library + ["[0]" / + ["/[1]" //]]]) + +(def: random_state + (Random Lux) + (do random.monad + [version random.nat + host (random.ascii/lower 1)] + (in (//.state (//.info version host))))) + +(def: (expander macro inputs state) + /.Expander + {try.#Success ((.macro macro) inputs state)}) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Expander]) + (do [! random.monad] + [multiplicity (# ! each (|>> (n.% 8) (n.+ 2)) + random.nat) + choice (# ! each (n.% multiplicity) + random.nat) + expected_error (random.ascii/upper 5) + + name ($symbol.random 2 2) + mono $code.random + poly (random.list multiplicity $code.random) + + lux ..random_state + .let [singular (<| (:as Macro) + (: Macro') + (function (_ inputs state) + (case (list.item choice inputs) + {.#Some it} + {try.#Success [state (list it)]} + + {.#None} + {try.#Failure expected_error}))) + multiple (<| (:as Macro) + (: Macro') + (function (_ inputs state) + {try.#Success [state (|> inputs + (list.repeated multiplicity) + list#conjoint)]}))]]) + ($_ _.and + (_.cover [/.expansion] + (|> (/.expansion ..expander name multiple (list mono)) + (meta.result lux) + (try#each (# (list.equivalence code.equivalence) = + (list.repeated multiplicity mono))) + (try.else false))) + (_.cover [/.expansion_failed] + (|> (/.expansion ..expander name singular (list)) + (meta.result lux) + (case> {try.#Failure it} + (and (text.contains? expected_error it) + (text.contains? (value@ exception.#label /.expansion_failed) it)) + + _ + false))) + (_.cover [/.single_expansion] + (|> (/.single_expansion ..expander name singular poly) + (meta.result lux) + (try#each (code#= (|> poly (list.item choice) maybe.trusted))) + (try.else false))) + (_.cover [/.must_have_single_expansion] + (|> (/.single_expansion ..expander name multiple (list mono)) + (meta.result lux) + (case> {try.#Failure it} + (text.contains? (value@ exception.#label /.must_have_single_expansion) it) + + _ + false))) + ))) |