aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/data/text/unicode/block.lux4
-rw-r--r--stdlib/source/lux/data/text/unicode/set.lux10
-rw-r--r--stdlib/source/lux/host.old.lux2
-rw-r--r--stdlib/source/lux/math/random.lux12
-rw-r--r--stdlib/source/lux/target/jvm/reflection.lux19
-rw-r--r--stdlib/source/lux/target/python.lux14
-rw-r--r--stdlib/source/lux/time/duration.lux16
-rw-r--r--stdlib/source/lux/time/year.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux269
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux11
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux29
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux68
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux15
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux29
-rw-r--r--stdlib/source/lux/world/console.lux69
-rw-r--r--stdlib/source/lux/world/shell.lux78
-rw-r--r--stdlib/source/program/aedifex/artifact/time.lux35
-rw-r--r--stdlib/source/program/aedifex/artifact/time/date.lux (renamed from stdlib/source/program/aedifex/artifact/time_stamp/date.lux)0
-rw-r--r--stdlib/source/program/aedifex/artifact/time/time.lux (renamed from stdlib/source/program/aedifex/artifact/time_stamp/time.lux)0
-rw-r--r--stdlib/source/test/aedifex/artifact/time.lux42
-rw-r--r--stdlib/source/test/aedifex/artifact/time/date.lux (renamed from stdlib/source/test/aedifex/artifact/time_stamp/date.lux)0
-rw-r--r--stdlib/source/test/aedifex/artifact/time/time.lux (renamed from stdlib/source/test/aedifex/artifact/time_stamp/time.lux)0
-rw-r--r--stdlib/source/test/lux/control/parser/text.lux28
-rw-r--r--stdlib/source/test/lux/control/remember.lux2
-rw-r--r--stdlib/source/test/lux/data/format/tar.lux20
-rw-r--r--stdlib/source/test/lux/data/text/unicode/block.lux4
-rw-r--r--stdlib/source/test/lux/data/text/unicode/set.lux4
-rw-r--r--stdlib/source/test/lux/macro.lux2
-rw-r--r--stdlib/source/test/lux/meta.lux88
-rw-r--r--stdlib/source/test/lux/target/jvm.lux12
-rw-r--r--stdlib/source/test/lux/time.lux10
-rw-r--r--stdlib/source/test/lux/time/year.lux97
-rw-r--r--stdlib/source/test/lux/world/console.lux59
-rw-r--r--stdlib/source/test/lux/world/shell.lux8
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)))))
)))