diff options
| author | Eduardo Julian | 2021-01-12 23:09:05 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2021-01-12 23:09:05 -0400 |
| commit | 71de092a045dc70ab1c9eead477cf1512b144a87 (patch) | |
| tree | 1f71aca655d867b748c430996d3687911b7537cc /stdlib/source | |
| parent | 5dbf134346424602b0104d1f749c1a9eac6f21af (diff) | |
Raise error when trying to use deprecated fields/method/classes in JVM.
Diffstat (limited to 'stdlib/source')
36 files changed, 708 insertions, 369 deletions
diff --git a/stdlib/source/lux/data/text/unicode/block.lux b/stdlib/source/lux/data/text/unicode/block.lux index 4e522c8d3..fff262f93 100644 --- a/stdlib/source/lux/data/text/unicode/block.lux +++ b/stdlib/source/lux/data/text/unicode/block.lux @@ -199,6 +199,6 @@ ## Specialized blocks [basic_latin/decimal "0030" "0039"] - [basic_latin/upper_alpha "0041" "005A"] - [basic_latin/lower_alpha "0061" "007A"] + [basic_latin/upper "0041" "005A"] + [basic_latin/lower "0061" "007A"] ) diff --git a/stdlib/source/lux/data/text/unicode/set.lux b/stdlib/source/lux/data/text/unicode/set.lux index 55d7941ca..bf0b55cd7 100644 --- a/stdlib/source/lux/data/text/unicode/set.lux +++ b/stdlib/source/lux/data/text/unicode/set.lux @@ -212,9 +212,9 @@ [(def: #export <name> (..set <blocks>))] - [ascii [//block.basic_latin (list)]] - [ascii/alpha [//block.basic_latin/upper_alpha (list //block.basic_latin/lower_alpha)]] - [ascii/alpha_num [//block.basic_latin/upper_alpha (list //block.basic_latin/lower_alpha //block.basic_latin/decimal)]] - [ascii/upper_alpha [//block.basic_latin/upper_alpha (list)]] - [ascii/lower_alpha [//block.basic_latin/lower_alpha (list)]] + [ascii [//block.basic_latin (list)]] + [ascii/alpha [//block.basic_latin/upper (list //block.basic_latin/lower)]] + [ascii/alpha_num [//block.basic_latin/upper (list //block.basic_latin/lower //block.basic_latin/decimal)]] + [ascii/upper [//block.basic_latin/upper (list)]] + [ascii/lower [//block.basic_latin/lower (list)]] ) diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index 2fc846e18..cc7fe53e4 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -1724,7 +1724,7 @@ (syntax: #export (array {type (..generic_type^ (list))} size) {#.doc (doc "Create an array of the given type, with the given size." - (array Object 10))} + (array java/lang/Object 10))} (case type (^template [<type> <array_op>] [(^ (#GenericClass <type> (list))) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 4b6670de7..c4767d27f 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -175,12 +175,12 @@ (-> Nat (Random Text)) (..text (..char <set>)))] - [unicode unicode.character] - [ascii unicode.ascii] - [ascii/alpha unicode.ascii/alpha] - [ascii/alpha_num unicode.ascii/alpha_num] - [ascii/upper_alpha unicode.ascii/upper_alpha] - [ascii/lower_alpha unicode.ascii/lower_alpha] + [unicode unicode.character] + [ascii unicode.ascii] + [ascii/alpha unicode.ascii/alpha] + [ascii/alpha_num unicode.ascii/alpha_num] + [ascii/upper unicode.ascii/upper] + [ascii/lower unicode.ascii/lower] ) (template [<name> <type> <ctor> <gen>] diff --git a/stdlib/source/lux/target/jvm/reflection.lux b/stdlib/source/lux/target/jvm/reflection.lux index 6305e361f..bb0a388e9 100644 --- a/stdlib/source/lux/target/jvm/reflection.lux +++ b/stdlib/source/lux/target/jvm/reflection.lux @@ -66,11 +66,16 @@ (#static isInterface [int] boolean) (#static isAbstract [int] boolean)]) +(import: java/lang/annotation/Annotation) + +(import: java/lang/Deprecated) + (import: java/lang/reflect/Field ["#::." (getDeclaringClass [] (java/lang/Class java/lang/Object)) (getModifiers [] int) - (getGenericType [] java/lang/reflect/Type)]) + (getGenericType [] java/lang/reflect/Type) + (getDeclaredAnnotations [] [java/lang/annotation/Annotation])]) (import: java/lang/reflect/Method ["#::." @@ -350,9 +355,16 @@ (#try.Failure _) (exception.throw ..unknown_field [field target]))) +(def: #export deprecated? + (-> (array.Array java/lang/annotation/Annotation) Bit) + (|>> array.to_list + (list.all (|>> (host.check java/lang/Deprecated))) + list.empty? + not)) + (template [<name> <exception> <then?> <else?>] [(def: #export (<name> field class) - (-> Text (java/lang/Class java/lang/Object) (Try [Bit (/.Type Value)])) + (-> Text (java/lang/Class java/lang/Object) (Try [Bit Bit (/.Type Value)])) (do {! try.monad} [fieldJ (..field field class) #let [modifiers (java/lang/reflect/Field::getModifiers fieldJ)]] @@ -360,7 +372,8 @@ <then?> (|> fieldJ java/lang/reflect/Field::getGenericType ..type - (\ ! map (|>> [(java/lang/reflect/Modifier::isFinal modifiers)]))) + (\ ! map (|>> [(java/lang/reflect/Modifier::isFinal modifiers) + (..deprecated? (java/lang/reflect/Field::getDeclaredAnnotations fieldJ))]))) <else?> (exception.throw <exception> [field class]))))] [static_field ..not_a_static_field #1 #0] diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux index 3f0211e33..6edba8f89 100644 --- a/stdlib/source/lux/target/python.lux +++ b/stdlib/source/lux/target/python.lux @@ -1,6 +1,8 @@ (.module: [lux (#- Location Code not or and list if cond int comment) [abstract + [equivalence (#+ Equivalence)] + [hash (#+ Hash)] ["." enum]] [control [pipe (#+ new> case> cond>)] @@ -34,6 +36,18 @@ (abstract: #export (Code brand) Text + (structure: #export equivalence + (All [brand] (Equivalence (Code brand))) + + (def: (= reference subject) + (\ text.equivalence = (:representation reference) (:representation subject)))) + + (structure: #export hash + (All [brand] (Hash (Code brand))) + + (def: &equivalence ..equivalence) + (def: hash (|>> :representation (\ text.hash hash)))) + (def: #export manual (-> Text Code) (|>> :abstraction)) diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux index 3ea941935..cd591a8a1 100644 --- a/stdlib/source/lux/time/duration.lux +++ b/stdlib/source/lux/time/duration.lux @@ -18,7 +18,9 @@ ["i" int] ["." nat ("#\." decimal)]]] [type - abstract]]) + abstract]] + ["." // #_ + ["#." year]]) (abstract: #export Duration Int @@ -93,13 +95,13 @@ [(def: #export <name> (..up <scale> <base>))] - [second 1,000 milli_second] - [minute 60 second] - [hour 60 minute] - [day 24 hour] + [second 1,000 milli_second] + [minute 60 second] + [hour 60 minute] + [day 24 hour] - [week 7 day] - [normal_year 365 day] + [week 7 day] + [normal_year //year.days day] ) (def: #export leap_year diff --git a/stdlib/source/lux/time/year.lux b/stdlib/source/lux/time/year.lux index a65d4eb01..3c61756f9 100644 --- a/stdlib/source/lux/time/year.lux +++ b/stdlib/source/lux/time/year.lux @@ -45,15 +45,15 @@ (def: #export value (-> Year Int) (|>> :representation ..external)) + + (def: #export epoch + Year + (:abstraction +1970)) ) (def: #export days 365) -(def: #export epoch - Year - (try.assume (..year +1970))) - (type: #export Period Nat) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 2502d8325..1b29ee2e1 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -57,6 +57,90 @@ [archive (#+ Archive) [descriptor (#+ Module)]]]]]]]]) +(import: java/lang/Object + ["#::." + (equals [java/lang/Object] boolean)]) + +(import: java/lang/reflect/Type) + +(import: (java/lang/reflect/TypeVariable d) + ["#::." + (getName [] java/lang/String) + (getBounds [] [java/lang/reflect/Type])]) + +(import: java/lang/reflect/Modifier + ["#::." + (#static isStatic [int] boolean) + (#static isFinal [int] boolean) + (#static isInterface [int] boolean) + (#static isAbstract [int] boolean)]) + +(import: java/lang/annotation/Annotation) + +(import: java/lang/reflect/Method + ["#::." + (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]) + (getDeclaredAnnotations [] [java/lang/annotation/Annotation])]) + +(import: (java/lang/reflect/Constructor c) + ["#::." + (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]) + (getDeclaredAnnotations [] [java/lang/annotation/Annotation])]) + +(import: (java/lang/Class c) + ["#::." + (#static forName [java/lang/String] #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]) + (getDeclaredAnnotations [] [java/lang/annotation/Annotation])]) + +(template [<name>] + [(exception: #export (<name> {class External} {field Text}) + (exception.report + ["Class" (%.text class)] + ["Field" (%.text field)]))] + + [cannot_set_a_final_field] + [deprecated_field] + ) + +(exception: #export (deprecated_method {class External} {method Text} {type .Type}) + (exception.report + ["Class" (%.text class)] + ["Method" (%.text method)] + ["Type" (%.type type)])) + +(exception: #export (deprecated_class {class External}) + (exception.report + ["Class" (%.text class)])) + +(def: (ensure_fresh_class! name) + (-> External (Operation Any)) + (do phase.monad + [class (phase.lift (reflection!.load name))] + (phase.assert ..deprecated_class [name] + (|> class + java/lang/Class::getDeclaredAnnotations + reflection!.deprecated? + not)))) + (def: reflection (All [category] (-> (Type (<| Return' Value' category)) Text)) @@ -64,7 +148,9 @@ (def: signature (|>> jvm.signature signature.signature)) -(def: object_class External "java.lang.Object") +(def: object_class + External + "java.lang.Object") (def: inheritance_relationship_type_name "_jvm_inheritance") (def: #export (inheritance_relationship_type class super_class super_interfaces) @@ -109,6 +195,7 @@ (type: Method_Signature {#method .Type + #deprecated? Bit #exceptions (List .Type)}) (template [<name>] @@ -132,11 +219,6 @@ [primitives_are_not_objects] ) -(exception: #export (cannot_set_a_final_field {field Text} {class External}) - (exception.report - ["Field" (%.text field)] - ["Class" (%.text class)])) - (template [<name>] [(exception: #export (<name> {class External} {method Text} @@ -730,7 +812,8 @@ (case classC [_ (#.Text class)] (do phase.monad - [_ (typeA.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list))))) + [_ (..ensure_fresh_class! class) + _ (typeA.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list))))) _ (phase.lift (reflection!.load class))] (wrap (#/////analysis.Extension extension_name (list (/////analysis.text class))))) @@ -746,7 +829,8 @@ [($_ <>.and <c>.text <c>.any) (function (_ extension_name analyse archive [sub_class objectC]) (do phase.monad - [_ (typeA.infer Bit) + [_ (..ensure_fresh_class! sub_class) + _ (typeA.infer Bit) [objectT objectA] (typeA.with_inference (analyse archive objectC)) object_class (check_object objectT) @@ -755,55 +839,6 @@ (wrap (#/////analysis.Extension extension_name (list (/////analysis.text sub_class) objectA))) (/////analysis.throw cannot_possibly_be_an_instance (format sub_class " !<= " object_class)))))])) -(import: java/lang/Object - ["#::." - (equals [java/lang/Object] boolean)]) - -(import: java/lang/reflect/Type) - -(import: (java/lang/reflect/TypeVariable d) - ["#::." - (getName [] java/lang/String) - (getBounds [] [java/lang/reflect/Type])]) - -(import: java/lang/reflect/Modifier - ["#::." - (#static isStatic [int] boolean) - (#static isFinal [int] boolean) - (#static isInterface [int] boolean) - (#static isAbstract [int] boolean)]) - -(import: java/lang/reflect/Method - ["#::." - (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) - ["#::." - (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/Class c) - ["#::." - (#static forName [java/lang/String] #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])]) - (template [<name> <category> <parser>] [(def: (<name> mapping typeJ) (-> Mapping (Type <category>) (Operation .Type)) @@ -856,7 +891,7 @@ (list& super_classT super_interfacesT+)) _ - (/////analysis.throw cannot_cast [fromT toT fromC]))) + (/////analysis.throw ..cannot_cast [fromT toT fromC]))) (def: object::cast Handler @@ -916,13 +951,13 @@ (recur [next_name nextT]) #.Nil - (/////analysis.throw cannot_cast [fromT toT fromC])) + (/////analysis.throw ..cannot_cast [fromT toT fromC])) )))))))] (if can_cast? (wrap (#/////analysis.Extension extension_name (list (/////analysis.text from_name) (/////analysis.text to_name) fromA))) - (/////analysis.throw cannot_cast [fromT toT fromC]))) + (/////analysis.throw ..cannot_cast [fromT toT fromC]))) _ (/////analysis.throw ///.invalid_syntax [extension_name %.code args])))) @@ -946,10 +981,13 @@ [..member (function (_ extension_name analyse archive [class field]) (do phase.monad - [[final? fieldJT] (phase.lift - (do try.monad - [class (reflection!.load class)] - (reflection!.static_field field class))) + [_ (..ensure_fresh_class! class) + [final? deprecated? fieldJT] (phase.lift + (do try.monad + [class (reflection!.load class)] + (reflection!.static_field field class))) + _ (phase.assert ..deprecated_field [class field] + (not deprecated?)) fieldT (reflection_type luxT.fresh fieldJT) _ (typeA.infer fieldT)] (wrap (<| (#/////analysis.Extension extension_name) @@ -963,14 +1001,17 @@ [($_ <>.and ..member <c>.any) (function (_ extension_name analyse archive [[class field] valueC]) (do phase.monad - [_ (typeA.infer Any) - [final? fieldJT] (phase.lift - (do try.monad - [class (reflection!.load class)] - (reflection!.static_field field class))) - fieldT (reflection_type luxT.fresh fieldJT) + [_ (..ensure_fresh_class! class) + _ (typeA.infer Any) + [final? deprecated? fieldJT] (phase.lift + (do try.monad + [class (reflection!.load class)] + (reflection!.static_field field class))) + _ (phase.assert ..deprecated_field [class field] + (not deprecated?)) _ (phase.assert ..cannot_set_a_final_field [class field] (not final?)) + fieldT (reflection_type luxT.fresh fieldJT) valueA (typeA.with_type fieldT (analyse archive valueC))] (wrap (<| (#/////analysis.Extension extension_name) @@ -984,14 +1025,17 @@ [($_ <>.and ..member <c>.any) (function (_ extension_name analyse archive [[class field] objectC]) (do phase.monad - [[objectT objectA] (typeA.with_inference + [_ (..ensure_fresh_class! class) + [objectT objectA] (typeA.with_inference (analyse archive objectC)) - [mapping fieldJT] (phase.lift - (do try.monad - [class (reflection!.load class) - [final? fieldJT] (reflection!.virtual_field field class) - mapping (reflection!.correspond class objectT)] - (wrap [mapping fieldJT]))) + [deprecated? mapping fieldJT] (phase.lift + (do try.monad + [class (reflection!.load class) + [final? deprecated? fieldJT] (reflection!.virtual_field field class) + mapping (reflection!.correspond class objectT)] + (wrap [deprecated? mapping fieldJT]))) + _ (phase.assert ..deprecated_field [class field] + (not deprecated?)) fieldT (reflection_type mapping fieldJT) _ (typeA.infer fieldT)] (wrap (<| (#/////analysis.Extension extension_name) @@ -1005,18 +1049,21 @@ [($_ <>.and ..member <c>.any <c>.any) (function (_ extension_name analyse archive [[class field] valueC objectC]) (do phase.monad - [[objectT objectA] (typeA.with_inference + [_ (..ensure_fresh_class! class) + [objectT objectA] (typeA.with_inference (analyse archive objectC)) _ (typeA.infer objectT) - [final? mapping fieldJT] (phase.lift - (do try.monad - [class (reflection!.load class) - [final? fieldJT] (reflection!.virtual_field field class) - mapping (reflection!.correspond class objectT)] - (wrap [final? mapping fieldJT]))) - fieldT (reflection_type mapping fieldJT) - _ (phase.assert cannot_set_a_final_field [class field] + [final? deprecated? mapping fieldJT] (phase.lift + (do try.monad + [class (reflection!.load class) + [final? deprecated? fieldJT] (reflection!.virtual_field field class) + mapping (reflection!.correspond class objectT)] + (wrap [final? deprecated? mapping fieldJT]))) + _ (phase.assert ..deprecated_field [class field] + (not deprecated?)) + _ (phase.assert ..cannot_set_a_final_field [class field] (not final?)) + fieldT (reflection_type mapping fieldJT) valueA (typeA.with_type fieldT (analyse archive valueC))] (wrap (<| (#/////analysis.Extension extension_name) @@ -1161,7 +1208,9 @@ (list& (#.Primitive (java/lang/Class::getName owner) owner_tvarsT) inputsT))) outputT)]] - (wrap [methodT exceptionsT])))) + (wrap [methodT + (reflection!.deprecated? (java/lang/reflect/Method::getDeclaredAnnotations method)) + exceptionsT])))) (def: (constructor_signature constructor) (-> (java/lang/reflect/Constructor java/lang/Object) (Operation Method_Signature)) @@ -1188,7 +1237,9 @@ constructorT (<| (type.univ_q (dictionary.size mapping)) (type.function inputsT) objectT)]] - (wrap [constructorT exceptionsT])))) + (wrap [constructorT + (reflection!.deprecated? (java/lang/reflect/Constructor::getDeclaredAnnotations constructor)) + exceptionsT])))) (type: Evaluation (#Pass Method_Signature) @@ -1255,7 +1306,8 @@ candidates (/////analysis.throw ..too_many_candidates [class_name method_name inputsJT candidates])))) -(def: constructor_method "<init>") +(def: constructor_method + "<init>") (def: (constructor_candidate actual_class_tvars class_name actual_method_tvars inputsJT) (-> (List (Type Var)) External (List (Type Var)) (List (Type Value)) (Operation Method_Signature)) @@ -1314,8 +1366,11 @@ [($_ <>.and ..type_vars ..member ..type_vars (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars argsTC]) (do phase.monad - [#let [argsT (list\map product.left argsTC)] - [methodT exceptionsT] (method_candidate class_tvars class method_tvars method #Static argsT) + [_ (..ensure_fresh_class! class) + #let [argsT (list\map product.left argsTC)] + [methodT deprecated? exceptionsT] (..method_candidate class_tvars class method_tvars method #Static argsT) + _ (phase.assert ..deprecated_method [class method methodT] + (not deprecated?)) [outputT argsA] (inferenceA.general archive analyse methodT (list\map product.right argsTC)) outputJT (check_return outputT)] (wrap (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) @@ -1329,8 +1384,11 @@ [($_ <>.and ..type_vars ..member ..type_vars <c>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars objectC argsTC]) (do phase.monad - [#let [argsT (list\map product.left argsTC)] - [methodT exceptionsT] (method_candidate class_tvars class method_tvars method #Virtual argsT) + [_ (..ensure_fresh_class! class) + #let [argsT (list\map product.left argsTC)] + [methodT deprecated? exceptionsT] (..method_candidate class_tvars class method_tvars method #Virtual argsT) + _ (phase.assert ..deprecated_method [class method methodT] + (not deprecated?)) [outputT allA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) #let [[objectA argsA] (case allA (#.Cons objectA argsA) @@ -1351,8 +1409,11 @@ [($_ <>.and ..type_vars ..member ..type_vars <c>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars objectC argsTC]) (do phase.monad - [#let [argsT (list\map product.left argsTC)] - [methodT exceptionsT] (method_candidate class_tvars class method_tvars method #Special argsT) + [_ (..ensure_fresh_class! class) + #let [argsT (list\map product.left argsTC)] + [methodT deprecated? exceptionsT] (..method_candidate class_tvars class method_tvars method #Special argsT) + _ (phase.assert ..deprecated_method [class method methodT] + (not deprecated?)) [outputT argsA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) outputJT (check_return outputT)] (wrap (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) @@ -1366,11 +1427,14 @@ [($_ <>.and ..type_vars ..member ..type_vars <c>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class_name method] method_tvars objectC argsTC]) (do phase.monad - [#let [argsT (list\map product.left argsTC)] + [_ (..ensure_fresh_class! class_name) + #let [argsT (list\map product.left argsTC)] class (phase.lift (reflection!.load class_name)) _ (phase.assert non_interface class_name (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class))) - [methodT exceptionsT] (method_candidate class_tvars class_name method_tvars method #Interface argsT) + [methodT deprecated? exceptionsT] (..method_candidate class_tvars class_name method_tvars method #Interface argsT) + _ (phase.assert ..deprecated_method [class_name method methodT] + (not deprecated?)) [outputT allA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) #let [[objectA argsA] (case allA (#.Cons objectA argsA) @@ -1391,8 +1455,11 @@ [($_ <>.and ..type_vars <c>.text ..type_vars (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars class method_tvars argsTC]) (do phase.monad - [#let [argsT (list\map product.left argsTC)] - [methodT exceptionsT] (constructor_candidate class_tvars class method_tvars argsT) + [_ (..ensure_fresh_class! class) + #let [argsT (list\map product.left argsTC)] + [methodT deprecated? exceptionsT] (..constructor_candidate class_tvars class method_tvars argsT) + _ (phase.assert ..deprecated_method [class ..constructor_method methodT] + (not deprecated?)) [outputT argsA] (inferenceA.general archive analyse methodT (list\map product.right argsTC))] (wrap (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) (decorate_inputs argsT argsA))))))])) @@ -1928,7 +1995,9 @@ constructor_args methods]) (do {! phase.monad} - [parameters (typeA.with_env + [_ (..ensure_fresh_class! (..reflection super_class)) + _ (monad.map ! (|>> ..reflection ..ensure_fresh_class!) super_interfaces) + parameters (typeA.with_env (..parameter_types parameters)) #let [mapping (list\fold (function (_ [parameterJ parameterT] mapping) (dictionary.put (jvm_parser.name parameterJ) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux index 14cc5f338..b1da3c425 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux @@ -49,9 +49,9 @@ (/.install "char" (unary _.chr/1)) ))) -(def: frac_procs +(def: f64_procs Bundle - (<| (/.prefix "frac") + (<| (/.prefix "f64") (|> /.empty (/.install "+" (binary (product.uncurry _.+))) (/.install "-" (binary (product.uncurry _.-))) @@ -60,9 +60,9 @@ (/.install "%" (binary (product.uncurry _.%))) (/.install "=" (binary (product.uncurry _.=))) (/.install "<" (binary (product.uncurry _.<))) - (/.install "int" (unary _.int/1)) + (/.install "i64" (unary _.int/1)) (/.install "encode" (unary _.repr/1)) - (/.install "decode" (unary //runtime.frac//decode))))) + (/.install "decode" (unary //runtime.f64//decode))))) (def: (text//clip [paramO extraO subjectO]) (Trinary (Expression Any)) @@ -91,7 +91,6 @@ (|> /.empty (/.install "log" (unary //runtime.io//log!)) (/.install "error" (unary //runtime.io//throw!)) - (/.install "exit" (unary //runtime.io//exit!)) (/.install "current-time" (nullary (function.constant (//runtime.io//current_time! //runtime.unit))))))) (def: #export bundle @@ -99,7 +98,7 @@ (<| (/.prefix "lux") (|> lux_procs (dictionary.merge i64_procs) - (dictionary.merge frac_procs) + (dictionary.merge f64_procs) (dictionary.merge text_procs) (dictionary.merge io_procs) ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux index 4ba85c9b5..1c45a95b5 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux @@ -308,13 +308,14 @@ (-> Phase! (Generator [Synthesis Path])) (do ///////phase.monad [stack_init (expression archive valueS) - path! (pattern_matching statement expression archive pathP) + pattern_matching! (pattern_matching statement expression archive pathP) #let [closure (<| (_.closure (list)) ($_ _.then (_.declare @temp) (_.define @cursor (_.array (list stack_init))) (_.define @savepoint (_.array (list))) - path!))]] + pattern_matching! + ))]] (wrap (_.apply/* closure (list))))) (def: #export (case! statement expression archive [valueS pathP]) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux index 36700cf0c..dfc327985 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -252,6 +252,19 @@ (-> Text (Operation SVar)) (///////phase\map (|>> %.nat (format prefix) _.var) /////generation.next)) +(def: #export dependencies + (-> Path (List SVar)) + (|>> case.storage + (get@ #case.dependencies) + set.to_list + (list\map (function (_ variable) + (.case variable + (#///////variable.Local register) + (..register register) + + (#///////variable.Foreign register) + (..capture register)))))) + (def: #export (case generate archive [valueS pathP]) (Generator [Synthesis Path]) (do ///////phase.monad @@ -259,21 +272,13 @@ pattern_matching! (pattern_matching generate archive pathP) @case (..gensym "case") @init (..gensym "init") - #let [@dependencies+ (|> (case.storage pathP) - (get@ #case.dependencies) - set.to_list - (list\map (function (_ variable) - (.case variable - (#///////variable.Local register) - (..register register) - - (#///////variable.Foreign register) - (..capture register)))))] - #let [directive (_.def @case (list& @init @dependencies+) + #let [@dependencies+ (..dependencies pathP) + directive (_.def @case (list& @init @dependencies+) ($_ _.then (_.set (list @cursor) (_.list (list @init))) (_.set (list @savepoint) (_.list (list))) - pattern_matching!))] + pattern_matching! + ))] _ (/////generation.execute! directive) _ (/////generation.save! (_.code @case) directive)] (wrap (_.apply/* @case (list& initG @dependencies+))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux index a4149f120..8c97fec96 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux @@ -55,23 +55,19 @@ ($_ _.then function_definition (_.return (_.var function_name))))] - _ (/////generation.execute! function_definition) + _ (/////generation.execute! directive) _ (/////generation.save! (_.code @closure) directive)] (wrap (_.apply/* @closure inits))))) (def: input (|>> inc //case.register)) -(def: (@scope function_name) - (-> Context Text) - (format (///reference.artifact function_name) "_scope")) - (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) (do {! ///////phase.monad} [[function_name bodyO] (/////generation.with_new_context archive (do ! - [function_name (\ ! map ..@scope + [function_name (\ ! map ///reference.artifact (/////generation.context archive))] (/////generation.with_anchor (_.var function_name) (generate archive bodyS)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index d8914d1e6..7e92ddb74 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux @@ -7,7 +7,8 @@ [text ["%" format (#+ format)]] [collection - ["." list ("#\." functor)]]] + ["." list ("#\." functor)] + ["." set]]] [math [number ["n" nat]]] @@ -16,11 +17,16 @@ ["." // #_ [runtime (#+ Operation Phase Generator)] ["#." case] - ["///#" //// #_ - [synthesis (#+ Scope Synthesis)] - ["#." generation] - ["//#" /// #_ - ["#." phase]]]]) + ["//#" /// #_ + [synthesis + ["." case]] + ["/#" // #_ + ["." synthesis (#+ Scope Synthesis)] + ["#." generation] + ["//#" /// #_ + ["#." phase] + [reference + ["#." variable]]]]]]) (def: loop_name (-> Nat SVar) @@ -28,18 +34,44 @@ (def: #export (scope generate archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) - (do {! ///////phase.monad} - [@loop (\ ! map ..loop_name /////generation.next) - initsO+ (monad.map ! (generate archive) initsS+) - bodyO (/////generation.with_anchor @loop - (generate archive bodyS)) - #let [directive (_.def @loop (|> initsS+ - list.enumeration - (list\map (|>> product.left (n.+ start) //case.register))) - (_.return bodyO))] - _ (/////generation.execute! directive) - _ (/////generation.save! (_.code @loop) directive)] - (wrap (_.apply/* @loop initsO+)))) + (case initsS+ + ## function/false/non-independent loop + #.Nil + (generate archive bodyS) + + ## true loop + _ + (do {! ///////phase.monad} + [@loop (\ ! map ..loop_name /////generation.next) + initsO+ (monad.map ! (generate archive) initsS+) + bodyO (/////generation.with_anchor @loop + (generate archive bodyS)) + #let [locals (|> initsS+ + list.enumeration + (list\map (|>> product.left (n.+ start) //case.register))) + [directive instantiation] (case (|> (synthesis.path/then bodyS) + //case.dependencies + (set.from_list _.hash) + (set.difference (set.from_list _.hash locals)) + set.to_list) + #.Nil + [(_.def @loop locals + (_.return bodyO)) + (_.apply/* @loop initsO+)] + + foreigns + [(_.def @loop foreigns + ($_ _.then + (_.def @loop locals + (_.return bodyO)) + (_.return @loop) + )) + (_.apply/* (_.apply/* @loop + foreigns) + initsO+)])] + _ (/////generation.execute! directive) + _ (/////generation.save! (_.code @loop) directive)] + (wrap instantiation)))) (def: #export (recur generate archive argsS+) (Generator (List Synthesis)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index 876fab6a9..5ed9e7d2a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -177,12 +177,6 @@ (_.raise (_.Exception/1 message)) (_.return ..unit))) -(runtime: (io//exit! code) - ($_ _.then - (_.import "sys") - (_.statement (|> (_.var "sys") (_.do "exit" (list code)))) - (_.return ..unit))) - (runtime: (io//current_time! _) ($_ _.then (_.import "time") @@ -196,7 +190,6 @@ ($_ _.then @io//log! @io//throw! - @io//exit! @io//current_time! )) @@ -296,17 +289,17 @@ @i64//logic_right_shift )) -(runtime: (frac//decode input) +(runtime: (f64//decode input) (with_vars [ex] (_.try (_.return (..some (_.float/1 input))) (list [(list (_.var "Exception")) ex (_.return ..none)])))) -(def: runtime//frac +(def: runtime//f64 (Statement Any) ($_ _.then - @frac//decode + @f64//decode )) (runtime: (text//index subject param start) @@ -346,7 +339,7 @@ runtime//lux runtime//adt runtime//i64 - runtime//frac + runtime//f64 runtime//text runtime//io )) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux index f0bd340b1..b303a258d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -336,10 +336,29 @@ [path path path_storage ..empty] (case path + (^or #/.Pop (#/.Access Access)) + path_storage + (^ (/.path/bind register)) (update@ #bindings (set.add (#///reference/variable.Local register)) path_storage) + (#/.Bit_Fork _ default otherwise) + (|> (case otherwise + #.None + path_storage + + (#.Some otherwise) + (for_path otherwise path_storage)) + (for_path default)) + + (^or (#/.I64_Fork forks) + (#/.F64_Fork forks) + (#/.Text_Fork forks)) + (|> (#.Cons forks) + (list\map product.right) + (list\fold for_path path_storage)) + (^or (^ (/.path/seq left right)) (^ (/.path/alt left right))) (list\fold for_path path_storage (list left right)) @@ -366,6 +385,9 @@ (^ (/.function/abstraction [environment arity bodyS])) (list\fold for_synthesis synthesis_storage environment) + (^ (/.branch/case [inputS pathS])) + (|> synthesis_storage (for_synthesis inputS) (for_path pathS)) + (^ (/.branch/let [inputS register exprS])) (list\fold for_synthesis (update@ #bindings (set.add (#///reference/variable.Local register)) @@ -375,8 +397,8 @@ (^ (/.branch/if [testS thenS elseS])) (list\fold for_synthesis synthesis_storage (list testS thenS elseS)) - (^ (/.branch/case [inputS pathS])) - (|> synthesis_storage (for_synthesis inputS) (for_path pathS)) + (^ (/.branch/get [access whole])) + (for_synthesis whole synthesis_storage) (^ (/.loop/scope [start initsS+ iterationS])) (list\fold for_synthesis synthesis_storage (#.Cons iterationS initsS+)) @@ -389,7 +411,4 @@ _ synthesis_storage)) - - _ - path_storage ))) diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index 0f4e6405f..e5b17b7d6 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -10,7 +10,7 @@ ["." io (#+ IO io)] [concurrency ["." promise (#+ Promise)] - ["." stm]] + ["." atom]] [security ["!" capability (#+ capability:)]]] [data @@ -130,24 +130,23 @@ on_close)) (def: #export (mock simulation init) - (All [s] (-> (Simulation s) s (Console Promise))) - (let [state (stm.var init)] + (All [s] (-> (Simulation s) s (Console IO))) + (let [state (atom.atom init)] (`` (structure (~~ (template [<method> <simulation>] [(def: <method> (..can_read (function (_ _) - (stm.commit - (do {! stm.monad} - [|state| (stm.read state)] - (case (\ simulation <simulation> |state|) - (#try.Success [|state| output]) - (do ! - [_ (stm.write |state| state)] - (wrap (#try.Success output))) - - (#try.Failure error) - (wrap (#try.Failure error))))))))] + (do {! io.monad} + [|state| (atom.read state)] + (case (\ simulation <simulation> |state|) + (#try.Success [|state| output]) + (do ! + [_ (atom.write |state| state)] + (wrap (#try.Success output))) + + (#try.Failure error) + (wrap (#try.Failure error)))))))] [read on_read] [read_line on_read_line] @@ -156,30 +155,28 @@ (def: write (..can_write (function (_ input) - (stm.commit - (do {! stm.monad} - [|state| (stm.read state)] - (case (\ simulation on_write input |state|) - (#try.Success |state|) - (do ! - [_ (stm.write |state| state)] - (wrap (#try.Success []))) - - (#try.Failure error) - (wrap (#try.Failure error)))))))) + (do {! io.monad} + [|state| (atom.read state)] + (case (\ simulation on_write input |state|) + (#try.Success |state|) + (do ! + [_ (atom.write |state| state)] + (wrap (#try.Success []))) + + (#try.Failure error) + (wrap (#try.Failure error))))))) (def: close (..can_close (function (_ _) - (stm.commit - (do {! stm.monad} - [|state| (stm.read state)] - (case (\ simulation on_close |state|) - (#try.Success |state|) - (do ! - [_ (stm.write |state| state)] - (wrap (#try.Success []))) - - (#try.Failure error) - (wrap (#try.Failure error)))))))) + (do {! io.monad} + [|state| (atom.read state)] + (case (\ simulation on_close |state|) + (#try.Success |state|) + (do ! + [_ (atom.write |state| state)] + (wrap (#try.Success []))) + + (#try.Failure error) + (wrap (#try.Failure error))))))) )))) diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index 1b1fd7bbe..10c3f4718 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -12,8 +12,8 @@ ["!" capability (#+ capability:)] ["?" policy (#+ Context Safety Safe)]] [concurrency - ["." stm (#+ Var STM)] - ["." promise (#+ Promise) ("#\." monad)]] + ["." atom (#+ Atom)] + ["." promise (#+ Promise)]] [parser [environment (#+ Environment)]]] [data @@ -350,23 +350,22 @@ on_await)) (`` (structure: (mock_process simulation state) - (All [s] (-> (Simulation s) (Var s) (Process Promise))) + (All [s] (-> (Simulation s) (Atom s) (Process IO))) (~~ (template [<name> <capability> <simulation>] [(def: <name> (<capability> (function (_ _) - (stm.commit - (do {! stm.monad} - [|state| (stm.read state)] - (case (\ simulation <simulation> |state|) - (#try.Success [|state| output]) - (do ! - [_ (stm.write |state| state)] - (wrap (#try.Success output))) - - (#try.Failure error) - (wrap (#try.Failure error))))))))] + (do {! io.monad} + [|state| (atom.read state)] + (case (\ simulation <simulation> |state|) + (#try.Success [|state| output]) + (do ! + [_ (atom.write |state| state)] + (wrap (#try.Success output))) + + (#try.Failure error) + (wrap (#try.Failure error)))))))] [read ..can_read on_read] [error ..can_read on_error] @@ -375,43 +374,40 @@ (def: write (..can_write (function (_ message) - (stm.commit - (do {! stm.monad} - [|state| (stm.read state)] - (case (\ simulation on_write message |state|) - (#try.Success |state|) - (do ! - [_ (stm.write |state| state)] - (wrap (#try.Success []))) - - (#try.Failure error) - (wrap (#try.Failure error)))))))) + (do {! io.monad} + [|state| (atom.read state)] + (case (\ simulation on_write message |state|) + (#try.Success |state|) + (do ! + [_ (atom.write |state| state)] + (wrap (#try.Success []))) + + (#try.Failure error) + (wrap (#try.Failure error))))))) (def: destroy (..can_destroy (function (_ _) - (stm.commit - (do {! stm.monad} - [|state| (stm.read state)] - (case (\ simulation on_destroy |state|) - (#try.Success |state|) - (do ! - [_ (stm.write |state| state)] - (wrap (#try.Success []))) - - (#try.Failure error) - (wrap (#try.Failure error)))))))))) + (do {! io.monad} + [|state| (atom.read state)] + (case (\ simulation on_destroy |state|) + (#try.Success |state|) + (do ! + [_ (atom.write |state| state)] + (wrap (#try.Success []))) + + (#try.Failure error) + (wrap (#try.Failure error))))))))) (structure: #export (mock simulation init) (All [s] (-> (-> [Environment Path Command (List Argument)] (Try (Simulation s))) s - (Shell Promise))) + (Shell IO))) (def: execute (..can_execute (function (_ input) - (promise\wrap - (do try.monad - [simulation (simulation input)] - (wrap (..mock_process simulation (stm.var init))))))))) + (io.io (do try.monad + [simulation (simulation input)] + (wrap (..mock_process simulation (atom.atom init))))))))) diff --git a/stdlib/source/program/aedifex/artifact/time.lux b/stdlib/source/program/aedifex/artifact/time.lux new file mode 100644 index 000000000..19eb417a5 --- /dev/null +++ b/stdlib/source/program/aedifex/artifact/time.lux @@ -0,0 +1,35 @@ +(.module: + [lux #* + [abstract + [equivalence (#+ Equivalence)] + [monad (#+ do)]] + [control + ["<>" parser + ["<.>" text (#+ Parser)]]] + [data + [text + ["%" format (#+ Format)]]] + [time + ["." instant (#+ Instant)]]] + ["." / #_ + ["#." date] + ["#." time]]) + +(type: #export Time + Instant) + +(def: #export equivalence + (Equivalence Time) + instant.equivalence) + +(def: #export (format value) + (Format Time) + (%.format (/date.format (instant.date value)) + (/time.format (instant.time value)))) + +(def: #export parser + (Parser Time) + (do <>.monad + [date /date.parser + time /time.parser] + (wrap (instant.from_date_time date time)))) diff --git a/stdlib/source/program/aedifex/artifact/time_stamp/date.lux b/stdlib/source/program/aedifex/artifact/time/date.lux index 18df2900b..18df2900b 100644 --- a/stdlib/source/program/aedifex/artifact/time_stamp/date.lux +++ b/stdlib/source/program/aedifex/artifact/time/date.lux diff --git a/stdlib/source/program/aedifex/artifact/time_stamp/time.lux b/stdlib/source/program/aedifex/artifact/time/time.lux index d14f0a435..d14f0a435 100644 --- a/stdlib/source/program/aedifex/artifact/time_stamp/time.lux +++ b/stdlib/source/program/aedifex/artifact/time/time.lux diff --git a/stdlib/source/test/aedifex/artifact/time.lux b/stdlib/source/test/aedifex/artifact/time.lux new file mode 100644 index 000000000..880bc1f83 --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/time.lux @@ -0,0 +1,42 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try ("#\." functor)] + [parser + ["<.>" text]]] + [math + ["." random]] + [time + ["." instant]]] + {#program + ["." /]} + ["." / #_ + ["#." date] + ["#." time]]) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Time]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.instant)) + + (do random.monad + [expected random.instant] + (_.cover [/.format /.parser] + (|> expected + /.format + (<text>.run /.parser) + (try\map (\ instant.equivalence = expected)) + (try.default false)))) + + /date.test + /time.test + ))) diff --git a/stdlib/source/test/aedifex/artifact/time_stamp/date.lux b/stdlib/source/test/aedifex/artifact/time/date.lux index 0f4b5b7d3..0f4b5b7d3 100644 --- a/stdlib/source/test/aedifex/artifact/time_stamp/date.lux +++ b/stdlib/source/test/aedifex/artifact/time/date.lux diff --git a/stdlib/source/test/aedifex/artifact/time_stamp/time.lux b/stdlib/source/test/aedifex/artifact/time/time.lux index bd9bbe071..bd9bbe071 100644 --- a/stdlib/source/test/aedifex/artifact/time_stamp/time.lux +++ b/stdlib/source/test/aedifex/artifact/time/time.lux diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index dd8ce8ceb..6b2152320 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -82,15 +82,15 @@ (and (..should_pass expected (/.range offset limit)) (..should_fail out_of_range (/.range offset limit))))) (do {! random.monad} - [expected (random.char unicode.ascii/upper_alpha) - invalid (random.filter (|>> (unicode/block.within? unicode/block.basic_latin/upper_alpha) not) + [expected (random.char unicode.ascii/upper) + invalid (random.filter (|>> (unicode/block.within? unicode/block.basic_latin/upper) not) (random.char unicode.character))] (_.cover [/.upper] (and (..should_pass (text.from_code expected) /.upper) (..should_fail (text.from_code invalid) /.upper)))) (do {! random.monad} - [expected (random.char unicode.ascii/lower_alpha) - invalid (random.filter (|>> (unicode/block.within? unicode/block.basic_latin/lower_alpha) not) + [expected (random.char unicode.ascii/lower) + invalid (random.filter (|>> (unicode/block.within? unicode/block.basic_latin/lower) not) (random.char unicode.character))] (_.cover [/.lower] (and (..should_pass (text.from_code expected) /.lower) @@ -116,8 +116,8 @@ (do {! random.monad} [expected (random.char unicode.ascii/alpha) invalid (random.filter (function (_ char) - (not (or (unicode/block.within? unicode/block.basic_latin/upper_alpha char) - (unicode/block.within? unicode/block.basic_latin/lower_alpha char)))) + (not (or (unicode/block.within? unicode/block.basic_latin/upper char) + (unicode/block.within? unicode/block.basic_latin/lower char)))) (random.char unicode.character))] (_.cover [/.alpha] (and (..should_pass (text.from_code expected) /.alpha) @@ -125,8 +125,8 @@ (do {! random.monad} [expected (random.char unicode.ascii/alpha_num) invalid (random.filter (function (_ char) - (not (or (unicode/block.within? unicode/block.basic_latin/upper_alpha char) - (unicode/block.within? unicode/block.basic_latin/lower_alpha char) + (not (or (unicode/block.within? unicode/block.basic_latin/upper char) + (unicode/block.within? unicode/block.basic_latin/lower char) (unicode/block.within? unicode/block.basic_latin/decimal char)))) (random.char unicode.character))] (_.cover [/.alpha_num] @@ -395,8 +395,8 @@ (!expect (^multi (#try.Success actual) (text\= expected actual)))))) (do {! random.monad} - [invalid (random.ascii/upper_alpha 1) - expected (random.filter (|>> (unicode/block.within? unicode/block.basic_latin/upper_alpha) + [invalid (random.ascii/upper 1) + expected (random.filter (|>> (unicode/block.within? unicode/block.basic_latin/upper) not) (random.char unicode.character)) #let [upper! (/.one_of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ")]] @@ -413,11 +413,11 @@ (!expect (^multi (#try.Failure error) (exception.match? /.expected_to_fail error))))))) (do {! random.monad} - [upper (random.ascii/upper_alpha 1) - lower (random.ascii/lower_alpha 1) + [upper (random.ascii/upper 1) + lower (random.ascii/lower 1) invalid (random.filter (function (_ char) - (not (or (unicode/block.within? unicode/block.basic_latin/upper_alpha char) - (unicode/block.within? unicode/block.basic_latin/lower_alpha char)))) + (not (or (unicode/block.within? unicode/block.basic_latin/upper char) + (unicode/block.within? unicode/block.basic_latin/lower char)))) (random.char unicode.character)) #let [upper! (/.one_of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ") lower! (/.one_of! "abcdefghijklmnopqrstuvwxyz")]] diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index 753130ea2..bfe18fa5b 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -29,7 +29,7 @@ (def: deadline (Random Date) random.date) (def: message (Random Text) (random\map %.nat random.nat)) -(def: focus (Random Code) (random\map code.text (random.ascii/upper_alpha 10))) +(def: focus (Random Code) (random\map code.text (random.ascii/upper 10))) (def: (to_remember macro deadline message focus) (-> Name Date Text (Maybe Code) Code) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 9d576b93a..1300012dd 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -38,8 +38,8 @@ Test (_.for [/.Path] (do {! random.monad} - [expected (random.ascii/lower_alpha /.path_size) - invalid (random.ascii/lower_alpha (inc /.path_size)) + [expected (random.ascii/lower /.path_size) + invalid (random.ascii/lower (inc /.path_size)) not_ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) /.path_size)] (`` ($_ _.and @@ -71,8 +71,8 @@ Test (_.for [/.Name] (do {! random.monad} - [expected (random.ascii/lower_alpha /.name_size) - invalid (random.ascii/lower_alpha (inc /.name_size)) + [expected (random.ascii/lower /.name_size) + invalid (random.ascii/lower (inc /.name_size)) not_ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) /.name_size)] (`` ($_ _.and @@ -153,10 +153,10 @@ (def: entry Test (do {! random.monad} - [expected_path (random.ascii/lower_alpha (dec /.path_size)) + [expected_path (random.ascii/lower (dec /.path_size)) expected_moment (\ ! map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from_millis) random.nat) - chunk (random.ascii/lower_alpha chunk_size) + chunk (random.ascii/lower chunk_size) chunks (\ ! map (n.% 100) random.nat) #let [content (|> chunk (list.repeat chunks) @@ -239,7 +239,7 @@ Test (_.for [/.Mode /.mode] (do {! random.monad} - [path (random.ascii/lower_alpha 10) + [path (random.ascii/lower 10) modes (random.list 4 ..random_mode) #let [expected_mode (list\fold /.and /.none modes)]] (`` ($_ _.and @@ -311,9 +311,9 @@ (def: ownership Test (do {! random.monad} - [path (random.ascii/lower_alpha /.path_size) - expected (random.ascii/lower_alpha /.name_size) - invalid (random.ascii/lower_alpha (inc /.name_size)) + [path (random.ascii/lower /.path_size) + expected (random.ascii/lower /.name_size) + invalid (random.ascii/lower (inc /.name_size)) not_ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) /.name_size)] (_.for [/.Ownership /.Owner /.ID] diff --git a/stdlib/source/test/lux/data/text/unicode/block.lux b/stdlib/source/test/lux/data/text/unicode/block.lux index 316bbe516..d822a69d3 100644 --- a/stdlib/source/test/lux/data/text/unicode/block.lux +++ b/stdlib/source/test/lux/data/text/unicode/block.lux @@ -140,8 +140,8 @@ ## Specialized blocks /.basic_latin/decimal - /.basic_latin/upper_alpha - /.basic_latin/lower_alpha]] + /.basic_latin/upper + /.basic_latin/lower]] ) <named> (template [<definition> <part>] [((: (-> Any (List /.Block)) diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux index a219bff51..c63239cad 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -84,8 +84,8 @@ [/.ascii] [/.ascii/alpha] [/.ascii/alpha_num] - [/.ascii/lower_alpha] - [/.ascii/upper_alpha] + [/.ascii/lower] + [/.ascii/upper] [/.character] [/.non_character] [/.full] diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index 0b1077526..d4e3e9ae4 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -58,7 +58,7 @@ (Random [Nat Text .Lux]) (do {! random.monad} [seed random.nat - gensym_prefix (random.ascii/upper_alpha 1) + gensym_prefix (random.ascii/upper 1) #let [macro_module (name.module (name_of /._)) current_module (name.module (name_of .._))]] (wrap [seed diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index c1e0e8e03..ec76184cd 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -41,11 +41,11 @@ (def: compiler_related Test (do random.monad - [target (random.ascii/upper_alpha 1) - version (random.ascii/upper_alpha 1) - source_code (random.ascii/upper_alpha 1) - expected_current_module (random.ascii/upper_alpha 1) - primitive_type (random.ascii/upper_alpha 1) + [target (random.ascii/upper 1) + version (random.ascii/upper 1) + source_code (random.ascii/upper 1) + expected_current_module (random.ascii/upper 1) + primitive_type (random.ascii/upper 1) expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) @@ -87,15 +87,15 @@ (def: error_handling Test (do random.monad - [target (random.ascii/upper_alpha 1) - version (random.ascii/upper_alpha 1) - source_code (random.ascii/upper_alpha 1) - expected_current_module (random.ascii/upper_alpha 1) - primitive_type (random.ascii/upper_alpha 1) + [target (random.ascii/upper 1) + version (random.ascii/upper 1) + source_code (random.ascii/upper 1) + expected_current_module (random.ascii/upper 1) + primitive_type (random.ascii/upper 1) expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected_error (random.ascii/upper_alpha 1) + expected_error (random.ascii/upper 1) #let [expected_lux {#.info {#.target target #.version version #.mode #.Build} @@ -161,21 +161,21 @@ (def: module_related Test (do random.monad - [target (random.ascii/upper_alpha 1) - version (random.ascii/upper_alpha 1) - source_code (random.ascii/upper_alpha 1) - expected_current_module (random.ascii/upper_alpha 1) + [target (random.ascii/upper 1) + version (random.ascii/upper 1) + source_code (random.ascii/upper 1) + expected_current_module (random.ascii/upper 1) imported_module_name (random.filter (|>> (text\= expected_current_module) not) - (random.ascii/upper_alpha 1)) - primitive_type (random.ascii/upper_alpha 1) + (random.ascii/upper 1)) + primitive_type (random.ascii/upper 1) expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected_short (random.ascii/upper_alpha 1) + expected_short (random.ascii/upper 1) dummy_module (random.filter (function (_ module) (not (or (text\= expected_current_module module) (text\= imported_module_name module)))) - (random.ascii/upper_alpha 1)) + (random.ascii/upper 1)) #let [imported_module {#.module_hash 0 #.module_aliases (list) #.definitions (list) @@ -275,19 +275,19 @@ (def: random_location (Random Location) ($_ random.and - (random.ascii/upper_alpha 1) + (random.ascii/upper 1) random.nat random.nat)) (def: context_related (do {! random.monad} - [target (random.ascii/upper_alpha 1) - version (random.ascii/upper_alpha 1) - source_code (random.ascii/upper_alpha 1) - expected_current_module (random.ascii/upper_alpha 1) + [target (random.ascii/upper 1) + version (random.ascii/upper 1) + source_code (random.ascii/upper 1) + expected_current_module (random.ascii/upper 1) expected_type (\ ! map (function (_ name) (#.Primitive name (list))) - (random.ascii/upper_alpha 1)) + (random.ascii/upper 1)) expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) @@ -339,13 +339,13 @@ (def: definition_related Test (do {! random.monad} - [expected_current_module (random.ascii/upper_alpha 1) + [expected_current_module (random.ascii/upper 1) expected_macro_module (random.filter (|>> (text\= expected_current_module) not) - (random.ascii/upper_alpha 1)) - expected_short (random.ascii/upper_alpha 1) + (random.ascii/upper 1)) + expected_short (random.ascii/upper 1) expected_type (\ ! map (function (_ name) (#.Primitive name (list))) - (random.ascii/upper_alpha 1)) + (random.ascii/upper 1)) expected_value (random.either (wrap .def:) (wrap .macro:)) #let [expected_lux @@ -459,13 +459,13 @@ Test (do {! random.monad} [expected_exported? random.bit - expected_current_module (random.ascii/upper_alpha 1) + expected_current_module (random.ascii/upper 1) expected_macro_module (random.filter (|>> (text\= expected_current_module) not) - (random.ascii/upper_alpha 1)) - expected_short (random.ascii/upper_alpha 1) + (random.ascii/upper 1)) + expected_short (random.ascii/upper 1) expected_type (\ ! map (function (_ name) (#.Primitive name (list))) - (random.ascii/upper_alpha 1)) + (random.ascii/upper 1)) #let [expected_annotations (' [])] expected_value (random.either (wrap .def:) (wrap .macro:)) @@ -638,16 +638,16 @@ (def: tags_related Test (do {! random.monad} - [current_module (random.ascii/upper_alpha 1) + [current_module (random.ascii/upper 1) tag_module (random.filter (|>> (text\= current_module) not) - (random.ascii/upper_alpha 1)) + (random.ascii/upper 1)) - name_0 (random.ascii/upper_alpha 1) + name_0 (random.ascii/upper 1) name_1 (random.filter (|>> (text\= name_0) not) - (random.ascii/upper_alpha 1)) + (random.ascii/upper 1)) #let [random_tag (\ ! map (|>> [tag_module]) - (random.ascii/upper_alpha 1))] + (random.ascii/upper 1))] all_tags (|> random_tag (random.set name.hash 10) (\ ! map set.to_list)) @@ -762,13 +762,13 @@ (<| (_.covering /._) ($_ _.and (do {! random.monad} - [target (random.ascii/upper_alpha 1) - version (random.ascii/upper_alpha 1) - source_code (random.ascii/upper_alpha 1) - expected_current_module (random.ascii/upper_alpha 1) + [target (random.ascii/upper 1) + version (random.ascii/upper 1) + source_code (random.ascii/upper 1) + expected_current_module (random.ascii/upper 1) expected_type (\ ! map (function (_ name) (#.Primitive name (list))) - (random.ascii/upper_alpha 1)) + (random.ascii/upper 1)) expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) @@ -799,7 +799,7 @@ (do random.monad [expected_value random.nat - expected_error (random.ascii/upper_alpha 1)] + expected_error (random.ascii/upper 1)] (_.cover [/.lift] (and (|> expected_error #try.Failure diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index a04371340..f2c8963d3 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -86,9 +86,9 @@ (def: class_name (Random Text) (do random.monad - [super_package (random.ascii/lower_alpha 10) - package (random.ascii/lower_alpha 10) - name (random.ascii/upper_alpha 10)] + [super_package (random.ascii/lower 10) + package (random.ascii/lower 10) + name (random.ascii/upper 10)] (wrap (format super_package /name.external_separator package /name.external_separator name)))) @@ -105,7 +105,7 @@ (-> (-> Any Bit) (Bytecode Any) (Random Bit)) (do random.monad [class_name ..class_name - method_name (random.ascii/upper_alpha 10)] + method_name (random.ascii/upper 10)] (wrap (case (do try.monad [class (/class.class /version.v6_0 /class.public (/name.internal class_name) @@ -1319,9 +1319,9 @@ (function (_ primitive return substitute test) (do random.monad [class_name ..class_name - primitive_method_name (random.ascii/upper_alpha 10) + primitive_method_name (random.ascii/upper 10) #let [primitive_method_type (/type.method [(list) (get@ #unboxed primitive) (list)])] - object_method_name (|> (random.ascii/upper_alpha 10) + object_method_name (|> (random.ascii/upper 10) (random.filter (|>> (text\= primitive_method_name) not))) expected (get@ #random primitive) #let [$Self (/type.class class_name (list))]] diff --git a/stdlib/source/test/lux/time.lux b/stdlib/source/test/lux/time.lux index 5fd13dbe9..cc18c20e0 100644 --- a/stdlib/source/test/lux/time.lux +++ b/stdlib/source/test/lux/time.lux @@ -2,18 +2,20 @@ [lux #* ["_" test (#+ Test)]] ["." / #_ + ["#." date] + ["#." day] ["#." duration] ["#." instant] - ["#." day] ["#." month] - ["#." date]]) + ["#." year]]) (def: #export test Test ($_ _.and + /date.test + /day.test /duration.test /instant.test - /day.test /month.test - /date.test + /year.test )) diff --git a/stdlib/source/test/lux/time/year.lux b/stdlib/source/test/lux/time/year.lux new file mode 100644 index 000000000..3e29f0ffb --- /dev/null +++ b/stdlib/source/test/lux/time/year.lux @@ -0,0 +1,97 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence] + ["$." order] + ["$." codec]]}] + [control + ["." try] + ["." exception]] + [data + ["." bit ("#\." equivalence)] + [text + ["%" format (#+ format)]]] + [math + ["." random (#+ Random)] + [number + ["n" nat] + ["i" int]]]] + {1 + ["." / + ["/#" // + ["#." duration] + ["#." instant] + ["#." date]]]}) + +(def: #export random + (Random /.Year) + (random.one (|>> /.year try.to_maybe) random.int)) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Year]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.order] + ($order.spec /.order ..random)) + (_.for [/.codec /.parser] + ($codec.spec /.equivalence /.codec ..random)) + + (do random.monad + [expected random.int] + ($_ _.and + (_.cover [/.year] + (bit\= (i.= +0 expected) + (case (/.year expected) + (#try.Success _) + false + + (#try.Failure _) + true))) + (_.cover [/.value] + (case (/.year expected) + (#try.Success year) + (i.= expected (/.value year)) + + (#try.Failure _) + (i.= +0 expected))) + )) + (_.cover [/.there-is-no-year-0] + (case (/.year +0) + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.there-is-no-year-0 error))) + (_.cover [/.days] + (n.= (.nat (//duration.query //duration.day //duration.normal_year)) + /.days)) + (_.cover [/.epoch] + (\ /.equivalence = + (//date.year (//instant.date //instant.epoch)) + /.epoch)) + (_.for [/.Period] + (_.cover [/.leap /.century /.era] + (n.= /.leap (n./ /.century /.era)))) + (let [leap (try.assume (/.year (.int /.leap))) + century (try.assume (/.year (.int /.century))) + era (try.assume (/.year (.int /.era)))] + ($_ _.and + (_.cover [/.leap?] + (and (/.leap? leap) + (not (/.leap? century)) + (/.leap? era))) + (_.cover [/.leaps] + (and (i.= +1 (/.leaps leap)) + (i.= (.int (n./ /.leap /.century)) + (/.leaps century)) + (i.= (inc (i.* +4 (dec (/.leaps century)))) + (/.leaps era)))) + )) + ))) diff --git a/stdlib/source/test/lux/world/console.lux b/stdlib/source/test/lux/world/console.lux index b7c7d3a50..6c71f913c 100644 --- a/stdlib/source/test/lux/world/console.lux +++ b/stdlib/source/test/lux/world/console.lux @@ -6,7 +6,14 @@ [control ["." io] ["." try (#+ Try)] - ["." exception (#+ exception:)]]] + ["." exception (#+ exception:)] + [security + ["!" capability]]] + [data + ["." text ("#\." equivalence) + ["%" format (#+ format)]]] + [math + ["." random]]] {1 ["." /]} {[1 #spec] @@ -15,30 +22,50 @@ (exception: dead) (def: simulation - (/.Simulation Bit) + (/.Simulation [Bit Text]) (structure - (def: (on_read dead?) - (if dead? - (exception.throw ..dead []) - (#try.Success [dead? (char "a")]))) + (def: (on_read [dead? content]) + (do try.monad + [char (try.from_maybe (text.nth 0 content)) + [_ content] (try.from_maybe (text.split 1 content))] + (if dead? + (exception.throw ..dead []) + (wrap [[dead? content] char])))) - (def: (on_read_line dead?) - (if dead? - (exception.throw ..dead []) - (#try.Success [dead? "YOLO"]))) + (def: (on_read_line [dead? content]) + (do try.monad + [[line content] (try.from_maybe (text.split_with text.new_line content))] + (if dead? + (exception.throw ..dead []) + (wrap [[dead? content] line])))) - (def: (on_write message dead?) + (def: (on_write message [dead? content]) (if dead? (exception.throw ..dead []) - (#try.Success dead?))) + (#try.Success [dead? (format content message)]))) - (def: (on_close dead?) + (def: (on_close [dead? content]) (if dead? (exception.throw ..dead []) - (#try.Success true))))) + (#try.Success [true content]))))) (def: #export test Test (<| (_.covering /._) - (_.for [/.mock /.Simulation] - ($/.spec (io.io (/.mock ..simulation false)))))) + ($_ _.and + (_.for [/.async /.mock /.Simulation] + ($/.spec (io.io (/.async (/.mock ..simulation [false ""]))))) + (do random.monad + [expected (random.ascii/alpha 10) + #let [console (/.mock ..simulation [false ""])]] + (_.cover [/.write_line] + (io.run + (do io.monad + [?_ (/.write_line expected console) + ?actual (!.use (\ console read_line) [])] + (wrap (<| (try.default false) + (do try.monad + [_ ?_ + actual ?actual] + (wrap (text\= expected actual))))))))) + ))) diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index a336de350..fa7d77f22 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -98,9 +98,9 @@ Test (<| (_.covering /._) ($_ _.and - (_.for [/.mock /.Simulation] - ($/.spec (/.mock (|>> ..simulation #try.Success) - false))) + (_.for [/.async /.mock /.Simulation] + ($/.spec (/.async (/.mock (|>> ..simulation #try.Success) + false)))) (_.cover [/.error] (not (i.= /.normal /.error))) (do random.monad @@ -137,6 +137,6 @@ wrote! destroyed! (i.= exit await))))] - (_.cover' [/.async /.Can_Write] + (_.cover' [/.Can_Write] (try.default false verdict))))) ))) |