aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/abstract/hash.lux16
-rw-r--r--stdlib/source/lux/control/exception.lux8
-rw-r--r--stdlib/source/lux/control/parser/cli.lux86
-rw-r--r--stdlib/source/lux/locale.lux22
-rw-r--r--stdlib/source/lux/macro/syntax/common.lux3
-rw-r--r--stdlib/source/lux/macro/syntax/common/reader.lux45
-rw-r--r--stdlib/source/lux/macro/syntax/common/type/variable.lux27
-rw-r--r--stdlib/source/lux/macro/syntax/common/writer.lux4
-rw-r--r--stdlib/source/lux/math/number/complex.lux14
-rw-r--r--stdlib/source/lux/math/number/frac.lux2
-rw-r--r--stdlib/source/lux/math/random.lux6
-rw-r--r--stdlib/source/lux/meta/location.lux12
-rw-r--r--stdlib/source/lux/program.lux88
-rw-r--r--stdlib/source/lux/target/jvm/bytecode.lux10
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux29
-rw-r--r--stdlib/source/lux/world/file/watch.lux2
-rw-r--r--stdlib/source/lux/world/input/keyboard.lux4
-rw-r--r--stdlib/source/program/aedifex.lux4
-rw-r--r--stdlib/source/program/aedifex/artifact/time_stamp.lux35
-rw-r--r--stdlib/source/program/aedifex/artifact/time_stamp/date.lux39
-rw-r--r--stdlib/source/program/aedifex/artifact/time_stamp/time.lux35
-rw-r--r--stdlib/source/program/aedifex/artifact/value.lux53
-rw-r--r--stdlib/source/program/aedifex/artifact/versioning.lux176
-rw-r--r--stdlib/source/program/aedifex/repository/local.lux2
-rw-r--r--stdlib/source/test/aedifex/artifact.lux5
-rw-r--r--stdlib/source/test/aedifex/artifact/time_stamp/date.lux44
-rw-r--r--stdlib/source/test/lux.lux14
-rw-r--r--stdlib/source/test/lux/data/collection/array.lux7
-rw-r--r--stdlib/source/test/lux/host.jvm.lux43
-rw-r--r--stdlib/source/test/lux/macro/code.lux1
-rw-r--r--stdlib/source/test/lux/macro/poly/equivalence.lux16
-rw-r--r--stdlib/source/test/lux/macro/poly/functor.lux6
-rw-r--r--stdlib/source/test/lux/macro/syntax/common.lux17
-rw-r--r--stdlib/source/test/lux/macro/syntax/common/annotations.lux3
-rw-r--r--stdlib/source/test/lux/macro/syntax/common/type/variable.lux37
-rw-r--r--stdlib/source/test/lux/math.lux9
-rw-r--r--stdlib/source/test/lux/math/number/complex.lux62
-rw-r--r--stdlib/source/test/lux/math/number/frac.lux6
-rw-r--r--stdlib/source/test/lux/meta.lux4
-rw-r--r--stdlib/source/test/lux/meta/location.lux50
-rw-r--r--stdlib/source/test/lux/target/jvm.lux8
41 files changed, 757 insertions, 297 deletions
diff --git a/stdlib/source/lux/abstract/hash.lux b/stdlib/source/lux/abstract/hash.lux
index fabe5be6d..9a8b44dfb 100644
--- a/stdlib/source/lux/abstract/hash.lux
+++ b/stdlib/source/lux/abstract/hash.lux
@@ -1,7 +1,9 @@
(.module:
[lux #*]
[//
- [equivalence (#+ Equivalence)]])
+ ["." equivalence (#+ Equivalence)]
+ [functor
+ ["." contravariant]]])
(signature: #export (Hash a)
{#.doc (doc "A way to produce hash-codes for a type's instances."
@@ -10,3 +12,15 @@
&equivalence)
(: (-> a Nat)
hash))
+
+(structure: #export functor
+ (contravariant.Functor Hash)
+
+ (def: (map f super)
+ (structure
+ (def: &equivalence
+ (\ equivalence.functor map f
+ (\ super &equivalence)))
+
+ (def: hash
+ (|>> f (\ super hash))))))
diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index 161597421..63f4a0853 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -18,7 +18,9 @@
["sc" common
["scr" reader]
["scw" writer]
- ["|.|" export]]]]
+ ["|.|" export]
+ ["." type #_
+ ["|#_.|" variable]]]]]
[math
[number
["n" nat ("#\." decimal)]]]]
@@ -86,7 +88,7 @@
(..throw exception message)))
(syntax: #export (exception: {export |export|.parser}
- {t_vars (p.default (list) (s.tuple scr.type_variables))}
+ {t_vars (p.default (list) (s.tuple (p.some |type_variable|.parser)))}
{[name inputs] (p.either (p.and s.local_identifier (wrap (list)))
(s.form (p.and s.local_identifier (p.some scr.typed_input))))}
{body (p.maybe s.any)})
@@ -106,7 +108,7 @@
g!self (code.local_identifier name)]]
(wrap (list (` (def: (~+ (|export|.write export))
(~ g!self)
- (All [(~+ (scw.type_variables t_vars))]
+ (All [(~+ (list\map |type_variable|.format t_vars))]
(..Exception [(~+ (list\map (get@ #sc.input_type) inputs))]))
(let [(~ g!descriptor) (~ (code.text descriptor))]
{#..label (~ g!descriptor)
diff --git a/stdlib/source/lux/control/parser/cli.lux b/stdlib/source/lux/control/parser/cli.lux
index 7df6e448e..b39b4234c 100644
--- a/stdlib/source/lux/control/parser/cli.lux
+++ b/stdlib/source/lux/control/parser/cli.lux
@@ -1,25 +1,13 @@
(.module:
[lux #*
- ["@" target]
[abstract
[monad (#+ do)]]
[control
["." try (#+ Try)]]
[data
- [collection
- ["." list ("#\." monoid monad)]]
["." text ("#\." equivalence)
- ["%" format (#+ format)]]]
- [meta (#+ with_gensyms)]
- [macro
- ["." code]
- [syntax (#+ syntax:)]]]
- ["." //
- ["s" code]
- [//
- ["." io]
- [concurrency
- ["." thread]]]])
+ ["%" format (#+ format)]]]]
+ ["." //])
(type: #export (Parser a)
{#.doc "A command-line interface parser."}
@@ -108,73 +96,3 @@
(|> value
(//.after (//.either (..this short) (..this long)))
..somewhere))
-
-(type: Program_Args
- (#Raw Text)
- (#Parsed (List [Code Code])))
-
-(def: program_args^
- (s.Parser Program_Args)
- (//.or s.local_identifier
- (s.tuple (//.some (//.either (do //.monad
- [name s.local_identifier]
- (wrap [(code.identifier ["" name]) (` any)]))
- (s.record (//.and s.any s.any)))))))
-
-(syntax: #export (program:
- {args program_args^}
- body)
- {#.doc (doc "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)."
- "Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module."
- (program: all_args
- (do io.monad
- [foo init_program
- bar (do_something all_args)]
- (wrap [])))
-
- (program: [name]
- (io (log! (\ text.monoid compose "Hello, " name))))
-
- (program: [{config config^}]
- (do io.monad
- [data (init_program config)]
- (do_something data))))}
- (with_gensyms [g!program g!args g!_ g!output g!message]
- (let [initialization+event_loop
- (` ((~! do) (~! io.monad)
- [(~ g!output) (~ body)
- (~+ (for {@.old
- (list)
-
- @.jvm
- (list)
-
- @.js
- (list)}
- (list g!_
- (` ((~! thread.run!) [])))))]
- ((~' wrap) (~ g!output))))]
- (case args
- (#Raw args)
- (wrap (list (` ("lux def program"
- (.function ((~ g!program) (~ (code.identifier ["" args])))
- (~ initialization+event_loop))))))
-
- (#Parsed args)
- (wrap (list (` ("lux def program"
- (.function ((~ g!program) (~ g!args))
- (case ((: (~! (..Parser (io.IO .Any)))
- ((~! do) (~! //.monad)
- [(~+ (|> args
- (list\map (function (_ [binding parser])
- (list binding parser)))
- list\join))]
- ((~' wrap) (~ initialization+event_loop))))
- (~ g!args))
- (#.Right [(~ g!_) (~ g!output)])
- (~ g!output)
-
- (#.Left (~ g!message))
- (.error! (~ g!message))))))
- ))
- ))))
diff --git a/stdlib/source/lux/locale.lux b/stdlib/source/lux/locale.lux
index 45d29b66d..38b11fd6b 100644
--- a/stdlib/source/lux/locale.lux
+++ b/stdlib/source/lux/locale.lux
@@ -2,7 +2,7 @@
[lux #*
[abstract
[equivalence (#+ Equivalence)]
- [hash (#+ Hash)]]
+ ["." hash (#+ Hash)]]
[data
["." maybe ("#\." functor)]
["." text
@@ -34,19 +34,11 @@
(-> Locale Text)
(|>> :representation))
- (structure: #export equivalence
- (Equivalence Locale)
-
- (def: (= reference sample)
- (\ text.equivalence = (:representation reference) (:representation sample))))
-
- (structure: #export hash
+ (def: #export hash
(Hash Locale)
-
- (def: &equivalence
- ..equivalence)
-
- (def: hash
- (|>> :representation
- (\ text.hash hash))))
+ (\ hash.functor map ..code text.hash))
+
+ (def: #export equivalence
+ (Equivalence Locale)
+ (\ ..hash &equivalence))
)
diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux
index 6b2a84622..8cfbdeddd 100644
--- a/stdlib/source/lux/macro/syntax/common.lux
+++ b/stdlib/source/lux/macro/syntax/common.lux
@@ -5,6 +5,3 @@
(type: #export Typed_Input
{#input_binding Code
#input_type Code})
-
-(type: #export Type_Var
- Text)
diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux
index fcf9ce0d0..cd7ca1dce 100644
--- a/stdlib/source/lux/macro/syntax/common/reader.lux
+++ b/stdlib/source/lux/macro/syntax/common/reader.lux
@@ -14,52 +14,7 @@
["." meta]]
["." //])
-(def: (flat_list^ _)
- (-> Any (Parser (List Code)))
- (p.either (do p.monad
- [_ (s.tag! (name_of #.Nil))]
- (wrap (list)))
- (s.form (do p.monad
- [_ (s.tag! (name_of #.Cons))
- [head tail] (s.tuple (p.and s.any s.any))
- tail (s.local (list tail) (flat_list^ []))]
- (wrap (#.Cons head tail))))))
-
-(template [<name> <type> <tag> <then>]
- [(def: <name>
- (Parser <type>)
- (<| s.tuple
- (p.after s.any)
- s.form
- (do p.monad
- [_ (s.tag! (name_of <tag>))]
- <then>)))]
-
- [tuple_meta^ (List Code) #.Tuple (flat_list^ [])]
- [text_meta^ Text #.Text s.text]
- )
-
-(def: (find_definition_args meta_data)
- (-> (List [Name Code]) (List Text))
- (<| (maybe.default (list))
- (: (Maybe (List Text)))
- (case (list.find (|>> product.left (name\= ["lux" "func-args"])) meta_data)
- (^multi (#.Some [_ value])
- [(p.run tuple_meta^ (list value))
- (#.Right [_ args])]
- [(p.run (p.some text_meta^) args)
- (#.Right [_ args])])
- (#.Some args)
-
- _
- #.None)))
-
(def: #export typed_input
{#.doc "Reader for the common typed-argument syntax used by many macros."}
(Parser //.Typed_Input)
(s.record (p.and s.any s.any)))
-
-(def: #export type_variables
- {#.doc "Reader for the common type var/param used by many macros."}
- (Parser (List Text))
- (p.some s.local_identifier))
diff --git a/stdlib/source/lux/macro/syntax/common/type/variable.lux b/stdlib/source/lux/macro/syntax/common/type/variable.lux
new file mode 100644
index 000000000..22f37a35c
--- /dev/null
+++ b/stdlib/source/lux/macro/syntax/common/type/variable.lux
@@ -0,0 +1,27 @@
+(.module:
+ [lux #*
+ [abstract
+ [equivalence (#+ Equivalence)]]
+ [control
+ [parser
+ ["<.>" code (#+ Parser)]]]
+ [data
+ ["." text]]
+ [macro
+ ["." code]]])
+
+(type: #export Variable
+ Text)
+
+(def: #export equivalence
+ (Equivalence Variable)
+ text.equivalence)
+
+(def: #export format
+ (-> Variable Code)
+ code.local_identifier)
+
+(def: #export parser
+ {#.doc "Parser for the common type variable/parameter used by many macros."}
+ (Parser Variable)
+ <code>.local_identifier)
diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux
index 6657e9b9d..18b6556b8 100644
--- a/stdlib/source/lux/macro/syntax/common/writer.lux
+++ b/stdlib/source/lux/macro/syntax/common/writer.lux
@@ -15,7 +15,3 @@
(-> //.Typed_Input Code)
(code.record (list [(get@ #//.input_binding value)
(get@ #//.input_type value)])))
-
-(def: #export type_variables
- (-> (List //.Type_Var) (List Code))
- (list\map code.local_identifier))
diff --git a/stdlib/source/lux/math/number/complex.lux b/stdlib/source/lux/math/number/complex.lux
index d1a2957f0..32c14f74e 100644
--- a/stdlib/source/lux/math/number/complex.lux
+++ b/stdlib/source/lux/math/number/complex.lux
@@ -304,11 +304,11 @@
{#real real
#imaginary imaginary})))))))
-(def: #export (within? margin_of_error standard value)
+(def: #export (approximately? margin_of_error standard value)
(-> Frac Complex Complex Bit)
- (and (f.within? margin_of_error
- (get@ #..real standard)
- (get@ #..real value))
- (f.within? margin_of_error
- (get@ #..imaginary standard)
- (get@ #..imaginary value))))
+ (and (f.approximately? margin_of_error
+ (get@ #..real standard)
+ (get@ #..real value))
+ (f.approximately? margin_of_error
+ (get@ #..imaginary standard)
+ (get@ #..imaginary value))))
diff --git a/stdlib/source/lux/math/number/frac.lux b/stdlib/source/lux/math/number/frac.lux
index 3e1fadc2e..09c80cd05 100644
--- a/stdlib/source/lux/math/number/frac.lux
+++ b/stdlib/source/lux/math/number/frac.lux
@@ -419,7 +419,7 @@
(def: &equivalence ..equivalence)
(def: hash ..to_bits))
-(def: #export (within? margin_of_error standard value)
+(def: #export (approximately? margin_of_error standard value)
(-> Frac Frac Frac Bit)
(|> value
(..- standard)
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index 0f16553de..5af6de041 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -1,10 +1,10 @@
(.module: {#.doc "Pseudo-random number generation (PRNG) algorithms."}
[lux (#- or and list i64 nat int rev char)
[abstract
+ [hash (#+ Hash)]
[functor (#+ Functor)]
[apply (#+ Apply)]
- ["." monad (#+ do Monad)]
- hash]
+ ["." monad (#+ do Monad)]]
[data
["." product]
["." maybe]
@@ -25,9 +25,9 @@
[number (#+ hex)
["n" nat]
["i" int]
+ ["f" frac]
["r" ratio]
["c" complex]
- ["f" frac]
["." i64]]]
[time
["." instant (#+ Instant)]
diff --git a/stdlib/source/lux/meta/location.lux b/stdlib/source/lux/meta/location.lux
index ec35a83e6..3ddbeac6a 100644
--- a/stdlib/source/lux/meta/location.lux
+++ b/stdlib/source/lux/meta/location.lux
@@ -1,5 +1,15 @@
(.module:
- [lux #*])
+ [lux #*
+ [abstract
+ [equivalence (#+ Equivalence)]]])
+
+(structure: #export equivalence
+ (Equivalence Location)
+
+ (def: (= reference subject)
+ (and ("lux text =" (get@ #.module reference) (get@ #.module subject))
+ ("lux i64 =" (get@ #.line reference) (get@ #.line subject))
+ ("lux i64 =" (get@ #.column reference) (get@ #.column subject)))))
(def: #export dummy
Location
diff --git a/stdlib/source/lux/program.lux b/stdlib/source/lux/program.lux
new file mode 100644
index 000000000..209a95221
--- /dev/null
+++ b/stdlib/source/lux/program.lux
@@ -0,0 +1,88 @@
+(.module:
+ [lux #*
+ [meta (#+ with_gensyms)]
+ ["@" target]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." io]
+ [concurrency
+ ["." thread]]
+ ["<>" parser
+ ["<.>" code]
+ ["<.>" cli]]]
+ [data
+ ["." text]
+ [collection
+ ["." list ("#\." monad)]]]
+ [macro
+ [syntax (#+ syntax:)]
+ ["." code]]])
+
+(type: Arguments
+ (#Raw Text)
+ (#Parsed (List [Code Code])))
+
+(def: arguments^
+ (<code>.Parser Arguments)
+ (<>.or <code>.local_identifier
+ (<code>.tuple (<>.some (<>.either (do <>.monad
+ [name <code>.local_identifier]
+ (wrap [(code.identifier ["" name]) (` (~! <cli>.any))]))
+ (<code>.record (<>.and <code>.any <code>.any)))))))
+
+(syntax: #export (program:
+ {args ..arguments^}
+ body)
+ {#.doc (doc "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)."
+ "Can take a list of all the input parameters to the program."
+ "Or, can destructure them using CLI-option combinators from the lux/control/parser/cli module."
+ (program: all_args
+ (do io.monad
+ [foo init_program
+ bar (do_something all_args)]
+ (wrap [])))
+
+ (program: [name]
+ (io (log! (\ text.monoid compose "Hello, " name))))
+
+ (program: [{config config^}]
+ (do io.monad
+ [data (init_program config)]
+ (do_something data))))}
+ (with_gensyms [g!program g!args g!_ g!output g!message]
+ (let [initialization+event_loop
+ (` ((~! do) (~! io.monad)
+ [(~ g!output) (~ body)
+ (~+ (for {@.old
+ (list)
+
+ @.jvm
+ (list)
+
+ @.js
+ (list)}
+ (list g!_
+ (` ((~! thread.run!) [])))))]
+ ((~' wrap) (~ g!output))))]
+ (wrap (list (` ("lux def program"
+ (~ (case args
+ (#Raw args)
+ (` (.function ((~ g!program) (~ (code.identifier ["" args])))
+ (~ initialization+event_loop)))
+
+ (#Parsed args)
+ (` (.function ((~ g!program) (~ g!args))
+ (case ((: (~! (<cli>.Parser (io.IO .Any)))
+ ((~! do) (~! <>.monad)
+ [(~+ (|> args
+ (list\map (function (_ [binding parser])
+ (list binding parser)))
+ list\join))]
+ ((~' wrap) (~ initialization+event_loop))))
+ (~ g!args))
+ (#.Right [(~ g!_) (~ g!output)])
+ (~ g!output)
+
+ (#.Left (~ g!message))
+ (.error! (~ g!message))))))))))))))
diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux
index 6e24b790a..a319ef2a7 100644
--- a/stdlib/source/lux/target/jvm/bytecode.lux
+++ b/stdlib/source/lux/target/jvm/bytecode.lux
@@ -463,7 +463,7 @@
(import: java/lang/Double
["#::."
- (#static doubleToRawLongBits #manual [double] int)])
+ (#static doubleToRawLongBits #manual [double] long)])
(template [<name> <type> <constructor> <constant> <wide> <to_lux> <specializations>]
[(def: #export (<name> value)
@@ -511,7 +511,7 @@
(:coerce Int)))
(def: negative_zero_float_bits
- (|> -0.0 host.double_to_float ..float_bits))
+ (|> -0.0 (:coerce java/lang/Double) host.double_to_float ..float_bits))
(def: #export (float value)
(-> java/lang/Float (Bytecode Any))
@@ -548,7 +548,7 @@
(def: (arbitrary_double value)
(-> java/lang/Double (Bytecode Any))
(do ..monad
- [index (..lift (//constant/pool.double (//constant.double value)))]
+ [index (..lift (//constant/pool.double (//constant.double (:coerce Frac value))))]
(..bytecode $0 $2 @_ _.ldc2_w/double [index])))
(def: double_bits
@@ -557,14 +557,14 @@
(:coerce Int)))
(def: negative_zero_double_bits
- (..double_bits -0.0))
+ (..double_bits (:coerce java/lang/Double -0.0)))
(def: #export (double value)
(-> java/lang/Double (Bytecode Any))
(if (i.= ..negative_zero_double_bits
(..double_bits value))
(..arbitrary_double value)
- (case value
+ (case (:coerce Frac value)
(^template [<special> <instruction>]
[<special> (..bytecode $0 $2 @_ <instruction> [])])
([+0.0 _.dconst_0]
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 fe753e2cc..2502d8325 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
@@ -1056,20 +1056,21 @@
_
true)
arity_matches? (n.= (list.size inputsJT) (list.size parameters))
- inputs_match? (list\fold (function (_ [expectedJC actualJC] prev)
- (and prev
- (jvm\= expectedJC (: (Type Value)
- (case (jvm_parser.var? actualJC)
- (#.Some name)
- (|> aliasing
- (dictionary.get name)
- (maybe.default name)
- jvm.var)
-
- #.None
- actualJC)))))
- true
- (list.zip/2 parameters inputsJT))]]
+ inputs_match? (and arity_matches?
+ (list\fold (function (_ [expectedJC actualJC] prev)
+ (and prev
+ (jvm\= expectedJC (: (Type Value)
+ (case (jvm_parser.var? actualJC)
+ (#.Some name)
+ (|> aliasing
+ (dictionary.get name)
+ (maybe.default name)
+ jvm.var)
+
+ #.None
+ actualJC)))))
+ true
+ (list.zip/2 parameters inputsJT)))]]
(wrap (and correct_class?
correct_method?
static_matches?
diff --git a/stdlib/source/lux/world/file/watch.lux b/stdlib/source/lux/world/file/watch.lux
index 15ff185b5..948219013 100644
--- a/stdlib/source/lux/world/file/watch.lux
+++ b/stdlib/source/lux/world/file/watch.lux
@@ -290,7 +290,7 @@
(import: java/nio/file/Path
["#::."
- (register [java/nio/file/WatchService [(java/nio/file/WatchEvent$Kind java/lang/Object)]] #io #try java/nio/file/WatchKey)
+ (register [java/nio/file/WatchService [(java/nio/file/WatchEvent$Kind [? < java/lang/Object])]] #io #try java/nio/file/WatchKey)
(toString [] java/lang/String)])
(import: java/nio/file/StandardWatchEventKinds
diff --git a/stdlib/source/lux/world/input/keyboard.lux b/stdlib/source/lux/world/input/keyboard.lux
index b6fdb06ee..ccb90d30c 100644
--- a/stdlib/source/lux/world/input/keyboard.lux
+++ b/stdlib/source/lux/world/input/keyboard.lux
@@ -1,7 +1,5 @@
(.module:
- [lux #*
- [data
- [text (#+ Char)]]])
+ [lux #*])
(type: #export Key
Nat)
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index 52269d053..051bba9b1 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -1,5 +1,6 @@
(.module:
[lux (#- Name)
+ [program (#+ program:)]
[abstract
[monad (#+ do)]]
[control
@@ -8,8 +9,7 @@
["." try (#+ Try) ("#\." functor)]
["." exception (#+ exception:)]
[parser
- [environment (#+ Environment)]
- [cli (#+ program:)]]
+ [environment (#+ Environment)]]
[security
["!" capability]]
[concurrency
diff --git a/stdlib/source/program/aedifex/artifact/time_stamp.lux b/stdlib/source/program/aedifex/artifact/time_stamp.lux
new file mode 100644
index 000000000..0eab45a14
--- /dev/null
+++ b/stdlib/source/program/aedifex/artifact/time_stamp.lux
@@ -0,0 +1,35 @@
+(.module:
+ [lux #*
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["<>" parser
+ ["<.>" text (#+ Parser)]]]
+ [data
+ [text
+ ["%" format]]]
+ [time
+ ["." instant (#+ Instant)]]]
+ ["." / #_
+ ["#." date]
+ ["#." time]])
+
+(type: #export Time_Stamp
+ Instant)
+
+(def: #export separator
+ ".")
+
+(def: #export (format value)
+ (%.Format Time_Stamp)
+ (%.format (/date.format (instant.date value))
+ ..separator
+ (/time.format (instant.time value))))
+
+(def: #export parser
+ (Parser Time_Stamp)
+ (do <>.monad
+ [date /date.parser
+ _ (<text>.this ..separator)
+ 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_stamp/date.lux
new file mode 100644
index 000000000..18df2900b
--- /dev/null
+++ b/stdlib/source/program/aedifex/artifact/time_stamp/date.lux
@@ -0,0 +1,39 @@
+(.module:
+ [lux #*
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["<>" parser
+ ["<.>" text (#+ Parser)]]]
+ [data
+ [text
+ ["%" format]]]
+ [math
+ [number
+ ["n" nat]]]
+ [time
+ ["." date (#+ Date)]
+ ["." year]
+ ["." month]]])
+
+(def: #export (pad value)
+ (-> Nat Text)
+ (if (n.< 10 value)
+ (%.format "0" (%.nat value))
+ (%.nat value)))
+
+(def: #export (format value)
+ (%.Format Date)
+ (%.format (|> value date.year year.value .nat %.nat)
+ (|> value date.month month.number ..pad)
+ (|> value date.day_of_month ..pad)))
+
+(def: #export parser
+ (Parser Date)
+ (do <>.monad
+ [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal))
+ year (<>.lift (year.year (.int year)))
+ month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
+ month (<>.lift (month.by_number month))
+ day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))]
+ (<>.lift (date.date year month day_of_month))))
diff --git a/stdlib/source/program/aedifex/artifact/time_stamp/time.lux b/stdlib/source/program/aedifex/artifact/time_stamp/time.lux
new file mode 100644
index 000000000..d14f0a435
--- /dev/null
+++ b/stdlib/source/program/aedifex/artifact/time_stamp/time.lux
@@ -0,0 +1,35 @@
+(.module:
+ [lux #*
+ ["." time (#+ Time)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["<>" parser
+ ["<.>" text (#+ Parser)]]]
+ [data
+ [text
+ ["%" format]]]
+ [math
+ [number
+ ["n" nat]]]]
+ ["." // #_
+ ["#" date]])
+
+(def: #export (format value)
+ (%.Format Time)
+ (let [(^slots [#time.hour #time.minute #time.second]) (time.clock value)]
+ (%.format (//.pad hour)
+ (//.pad minute)
+ (//.pad second))))
+
+(def: #export parser
+ (<text>.Parser Time)
+ (do <>.monad
+ [hour (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
+ minute (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
+ second (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))]
+ (<>.lift (time.time
+ {#time.hour hour
+ #time.minute minute
+ #time.second second
+ #time.milli_second 0}))))
diff --git a/stdlib/source/program/aedifex/artifact/value.lux b/stdlib/source/program/aedifex/artifact/value.lux
new file mode 100644
index 000000000..eb5c33c22
--- /dev/null
+++ b/stdlib/source/program/aedifex/artifact/value.lux
@@ -0,0 +1,53 @@
+(.module:
+ [lux (#- Name Type)
+ [abstract
+ [equivalence (#+ Equivalence)]]
+ [data
+ ["." product]
+ ["." text
+ ["%" format]]
+ [format
+ ["." xml]]
+ [collection
+ ["." list ("#\." functor)]]]
+ [math
+ [number
+ ["n" nat]]]
+ ["." time (#+ Time)
+ ["." instant (#+ Instant)]
+ ["." date (#+ Date)]
+ ["." year]
+ ["." month]]]
+ [// (#+ Version)
+ [type (#+ Type)]
+ ["." time_stamp (#+ Time_Stamp)]])
+
+(type: #export Build
+ Nat)
+
+(type: #export Value
+ {#version Version
+ #time_stamp Time_Stamp
+ #build Build})
+
+(def: #export equivalence
+ (Equivalence Value)
+ ($_ product.equivalence
+ text.equivalence
+ instant.equivalence
+ n.equivalence
+ ))
+
+(def: separator
+ "-")
+
+(def: snapshot
+ "SNAPSHOT")
+
+(def: #export (format [version time_stamp build])
+ (%.Format Value)
+ (%.format (text.replace_all ..snapshot
+ (time_stamp.format time_stamp)
+ version)
+ ..separator
+ (%.nat build)))
diff --git a/stdlib/source/program/aedifex/artifact/versioning.lux b/stdlib/source/program/aedifex/artifact/versioning.lux
new file mode 100644
index 000000000..df9f7dfa3
--- /dev/null
+++ b/stdlib/source/program/aedifex/artifact/versioning.lux
@@ -0,0 +1,176 @@
+(.module:
+ [lux (#- Name Type)
+ [abstract
+ [equivalence (#+ Equivalence)]
+ [monad (#+ do)]]
+ [control
+ ["." exception (#+ exception:)]
+ ["<>" parser
+ ["<.>" xml (#+ Parser)]
+ ["<.>" text]]]
+ [data
+ ["." product]
+ ["." text
+ ["%" format]]
+ [format
+ ["." xml (#+ XML)]]
+ [collection
+ ["." list ("#\." functor)]]]
+ [math
+ [number
+ ["n" nat]]]
+ ["." time (#+ Time)
+ ["." instant (#+ Instant)]
+ ["." date (#+ Date)]
+ ["." year]
+ ["." month]]]
+ ["." // (#+ Version)
+ [type (#+ Type)]
+ ["#." value (#+ Build Value)]
+ ["#." time_stamp (#+ Time_Stamp)
+ ["#/." date]
+ ["#/." time]]])
+
+(type: #export Versioning
+ {#time_stamp Time_Stamp
+ #build Build
+ #snapshot (List Type)})
+
+(def: #export init
+ {#time_stamp (instant.from_millis +0)
+ #build 0
+ #snapshot (list)})
+
+(def: #export equivalence
+ (Equivalence Versioning)
+ ($_ product.equivalence
+ instant.equivalence
+ n.equivalence
+ (list.equivalence text.equivalence)
+ ))
+
+(template [<definition> <tag>]
+ [(def: <definition> xml.Tag ["" <tag>])]
+
+ [<extension> "extension"]
+ [<value> "value"]
+ [<updated> "updated"]
+
+ [<timestamp> "timestamp"]
+ [<build_number> "buildNumber"]
+ [<last_updated> "lastUpdated"]
+
+ [<snapshot_versions> "snapshotVersions"]
+ [<snapshot_version> "snapshotVersion"]
+
+ [<snapshot> "snapshot"]
+ [<versioning> "versioning"]
+ )
+
+(def: (instant_format value)
+ (%.Format Instant)
+ (%.format (//time_stamp/date.format (instant.date value))
+ (//time_stamp/time.format (instant.time value))))
+
+(template [<name> <type> <tag> <pre>]
+ [(def: <name>
+ (-> <type> XML)
+ (|>> <pre> #xml.Text list (#xml.Node <tag> xml.attributes)))]
+
+ [format_extension Type ..<extension> (|>)]
+ [format_value Value ..<value> //value.format]
+ [format_updated Instant ..<updated> ..instant_format]
+
+ [format_time_stamp Instant ..<timestamp> //time_stamp.format]
+ [format_build_number Nat ..<build_number> %.nat]
+ [format_last_updated Instant ..<last_updated> ..instant_format]
+ )
+
+(def: (format_snapshot value type)
+ (-> Value Type XML)
+ (<| (#xml.Node ..<snapshot_version> xml.attributes)
+ (list (..format_extension type)
+ (..format_value value)
+ (let [[version time_stamp build] value]
+ (..format_updated time_stamp)))))
+
+(def: #export (format version (^slots [#time_stamp #build #snapshot]))
+ (-> Version Versioning XML)
+ (<| (#xml.Node ..<versioning> xml.attributes)
+ (list (<| (#xml.Node ..<snapshot> xml.attributes)
+ (list (..format_time_stamp time_stamp)
+ (..format_build_number build)))
+ (..format_last_updated time_stamp)
+ (<| (#xml.Node ..<snapshot_versions> xml.attributes)
+ (list\map (..format_snapshot [version time_stamp build])
+ snapshot)))))
+
+(exception: #export (time_stamp_mismatch {expected Time_Stamp} {actual Text})
+ (exception.report
+ ["Expected time-stamp" (instant_format expected)]
+ ["Actual time-stamp" actual]))
+
+(exception: #export (value_mismatch {expected Value} {actual Text})
+ (exception.report
+ ["Expected" (//value.format expected)]
+ ["Actual" actual]))
+
+(def: (sub tag parser)
+ (All [a] (-> xml.Tag (Parser a) (Parser a)))
+ (do <>.monad
+ [_ (<xml>.node tag)]
+ (<xml>.children parser)))
+
+(def: (text tag)
+ (-> xml.Tag (Parser Text))
+ (..sub tag <xml>.text))
+
+(def: last_updated_parser
+ (Parser Instant)
+ (<text>.embed (do <>.monad
+ [date //time_stamp/date.parser
+ time //time_stamp/time.parser]
+ (wrap (instant.from_date_time date time)))
+ (..text ..<last_updated>)))
+
+(def: time_stamp_parser
+ (Parser Time_Stamp)
+ (<text>.embed //time_stamp.parser
+ (..text ..<timestamp>)))
+
+(def: build_parser
+ (Parser Build)
+ (<text>.embed (<>.codec n.decimal
+ (<text>.many <text>.decimal))
+ (..text ..<build_number>)))
+
+(def: (snapshot_parser expected)
+ (-> Value (Parser Type))
+ (<| (..sub ..<snapshot_version>)
+ (do <>.monad
+ [#let [[version time_stamp build] expected]
+ updated (<xml>.somewhere (..text ..<updated>))
+ _ (<>.assert (exception.construct ..time_stamp_mismatch [time_stamp updated])
+ (\ text.equivalence = (instant_format time_stamp) updated))
+ actual (<xml>.somewhere (..text ..<value>))
+ _ (<>.assert (exception.construct ..value_mismatch [expected actual])
+ (\ text.equivalence = (//value.format expected) actual))]
+ (<xml>.somewhere (..text ..<extension>)))))
+
+(def: #export (parser version)
+ (-> Version (Parser Versioning))
+ (<| (..sub ..<versioning>)
+ (do <>.monad
+ [[time_stamp build] (<| <xml>.somewhere
+ (..sub ..<snapshot>)
+ (<>.and (<xml>.somewhere ..time_stamp_parser)
+ (<xml>.somewhere ..build_parser)))
+ last_updated (<xml>.somewhere ..last_updated_parser)
+ _ (<>.assert (exception.construct ..time_stamp_mismatch [time_stamp (instant_format last_updated)])
+ (\ instant.equivalence = time_stamp last_updated))
+ snapshot (<| <xml>.somewhere
+ (..sub ..<snapshot_versions>)
+ (<>.some (..snapshot_parser [version time_stamp build])))]
+ (wrap {#time_stamp time_stamp
+ #build build
+ #snapshot snapshot}))))
diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux
index 393861ccf..f313b3176 100644
--- a/stdlib/source/program/aedifex/repository/local.lux
+++ b/stdlib/source/program/aedifex/repository/local.lux
@@ -42,7 +42,7 @@
[_ (: (Promise (Try Path))
(file.make_directories promise.monad system (file.parent system absolute_path)))]
(: (Promise (Try (File Promise)))
- (file.get_file promise.monad system absolute_path)))))
+ (!.use (\ system file) absolute_path)))))
(structure: #export (repository program system)
(-> (Program Promise) (file.System Promise) (//.Repository Promise))
diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux
index 5c694ae74..959b857dd 100644
--- a/stdlib/source/test/aedifex/artifact.lux
+++ b/stdlib/source/test/aedifex/artifact.lux
@@ -20,7 +20,9 @@
["." uri]]]]
["." / #_
["#." type]
- ["#." extension]]
+ ["#." extension]
+ ["#." time_stamp #_
+ ["#/." date]]]
{#program
["." /]})
@@ -42,4 +44,5 @@
/type.test
/extension.test
+ /time_stamp/date.test
))))
diff --git a/stdlib/source/test/aedifex/artifact/time_stamp/date.lux b/stdlib/source/test/aedifex/artifact/time_stamp/date.lux
new file mode 100644
index 000000000..0f4b5b7d3
--- /dev/null
+++ b/stdlib/source/test/aedifex/artifact/time_stamp/date.lux
@@ -0,0 +1,44 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try ("#\." functor)]
+ [parser
+ ["<.>" text]]]
+ [math
+ ["." random (#+ Random)]
+ [number
+ ["n" nat]
+ ["i" int]]]
+ [time
+ ["." date (#+ Date)]
+ ["." year]]]
+ {#program
+ ["." /]})
+
+(def: #export random
+ (Random Date)
+ (random.one (function (_ raw)
+ (try.to_maybe
+ (do try.monad
+ [year (|> raw date.year year.value i.abs (i.% +10,000) year.year)]
+ (date.date year
+ (date.month raw)
+ (date.day_of_month raw)))))
+ random.date))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ ($_ _.and
+ (do random.monad
+ [expected ..random]
+ (_.cover [/.format /.parser]
+ (|> expected
+ /.format
+ (<text>.run /.parser)
+ (try\map (\ date.equivalence = expected))
+ (try.default false))))
+ )))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index d490620ff..2fb01ad72 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -1,27 +1,25 @@
(.module:
["/" lux #*
+ [program (#+ program:)]
+ ["_" test (#+ Test)]
["@" target]
[abstract
[monad (#+ do)]
[predicate (#+ Predicate)]]
[control
- ["." io (#+ io)]
- [parser
- [cli (#+ program:)]]]
+ ["." io (#+ io)]]
[data
["." name]
[text
["%" format (#+ format)]]]
- ["." math]
- ["_" test (#+ Test)]
- [math
+ ["." math
["." random (#+ Random) ("#\." functor)]
[number
- ["." i64]
["n" nat]
["i" int]
["r" rev]
- ["f" frac]]]]
+ ["f" frac]
+ ["." i64]]]]
## TODO: Must have 100% coverage on tests.
["." / #_
["#." abstract]
diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux
index 78c933714..b2757b863 100644
--- a/stdlib/source/test/lux/data/collection/array.lux
+++ b/stdlib/source/test/lux/data/collection/array.lux
@@ -12,7 +12,6 @@
[data
["." bit]
["." maybe]
- ["." text ("#\." equivalence)]
[collection
["." list]
["." set]]]
@@ -108,9 +107,9 @@
(n.= size (/.size (: (Array Nat)
(/.new size)))))
(_.cover [/.type_name]
- (case (:of (/.new size))
- (^ (#.UnivQ _ (#.Apply _ (#.Named _ (#.UnivQ _ (#.Primitive nominal_type (list (#.Parameter 1))))))))
- (text\= /.type_name nominal_type)
+ (case /.Array
+ (^ (#.Named _ (#.UnivQ _ (#.Primitive nominal_type (list (#.Parameter 1))))))
+ (is? /.type_name nominal_type)
_
false))
diff --git a/stdlib/source/test/lux/host.jvm.lux b/stdlib/source/test/lux/host.jvm.lux
index 2532b3075..9edaecd0c 100644
--- a/stdlib/source/test/lux/host.jvm.lux
+++ b/stdlib/source/test/lux/host.jvm.lux
@@ -21,19 +21,22 @@
(import: java/lang/String)
(import: java/lang/Exception
- (new [java/lang/String]))
+ ["#::."
+ (new [java/lang/String])])
(import: java/lang/Object)
(import: (java/lang/Class a)
- (getName [] java/lang/String))
+ ["#::."
+ (getName [] java/lang/String)])
(import: java/lang/Runnable)
(import: java/lang/System
- (#static out java/io/PrintStream)
- (#static currentTimeMillis [] #io long)
- (#static getenv [java/lang/String] #io #? java/lang/String))
+ ["#::."
+ (#static out java/io/PrintStream)
+ (#static currentTimeMillis [] #io long)
+ (#static getenv [java/lang/String] #io #? java/lang/String)])
## TODO: Handle "class:" ASAP.
## (class: #final (TestClass A) [java/lang/Runnable]
@@ -54,14 +57,14 @@
## (java/lang/Runnable [] (run self) void
## []))
-(def: test-runnable
+(def: test_runnable
(object [] [java/lang/Runnable]
[]
(java/lang/Runnable
[] (run self) void
[])))
-(def: test-callable
+(def: test_callable
(object [a] [(java/util/concurrent/Callable a)]
[]
((java/util/concurrent/Callable a)
@@ -79,15 +82,15 @@
(~~ (template [<to> <from> <message>]
[(_.test <message>
(or (|> sample (:coerce java/lang/Long) <to> <from> (:coerce Int) (i.= sample))
- (let [capped-sample (|> sample (:coerce java/lang/Long) <to> <from>)]
- (|> capped-sample <to> <from> (:coerce Int) (i.= (:coerce Int capped-sample))))))]
-
- [/.long-to-byte /.byte-to-long "Can succesfully convert to/from byte."]
- [/.long-to-short /.short-to-long "Can succesfully convert to/from short."]
- [/.long-to-int /.int-to-long "Can succesfully convert to/from int."]
- [/.long-to-float /.float-to-long "Can succesfully convert to/from float."]
- [/.long-to-double /.double-to-long "Can succesfully convert to/from double."]
- [(<| /.int-to-char /.long-to-int) (<| /.int-to-long /.char-to-int) "Can succesfully convert to/from char."]
+ (let [capped_sample (|> sample (:coerce java/lang/Long) <to> <from>)]
+ (|> capped_sample <to> <from> (:coerce Int) (i.= (:coerce Int capped_sample))))))]
+
+ [/.long_to_byte /.byte_to_long "Can succesfully convert to/from byte."]
+ [/.long_to_short /.short_to_long "Can succesfully convert to/from short."]
+ [/.long_to_int /.int_to_long "Can succesfully convert to/from int."]
+ [/.long_to_float /.float_to_long "Can succesfully convert to/from float."]
+ [/.long_to_double /.double_to_long "Can succesfully convert to/from double."]
+ [(<| /.int_to_char /.long_to_int) (<| /.int_to_long /.char_to_int) "Can succesfully convert to/from char."]
))
))))
@@ -107,7 +110,7 @@
(/.synchronized sample #1))
(_.test "Can access Class instances."
- (text\= "java.lang.Class" (java/lang/Class::getName (/.class-for java/lang/Class))))
+ (text\= "java.lang.Class" (java/lang/Class::getName (/.class_for java/lang/Class))))
(_.test "Can check if a value is null."
(and (/.null? (/.null))
@@ -130,13 +133,13 @@
value (\ ! map (|>> (:coerce java/lang/Long)) r.int)]
($_ _.and
(_.test "Can create arrays of some length."
- (n.= size (/.array-length (/.array java/lang/Long size))))
+ (n.= size (/.array_length (/.array java/lang/Long size))))
(_.test "Can set and get array values."
(let [arr (/.array java/lang/Long size)]
- (exec (/.array-write idx value arr)
+ (exec (/.array_write idx value arr)
(i.= (:coerce Int value)
- (:coerce Int (/.array-read idx arr)))))))))
+ (:coerce Int (/.array_read idx arr)))))))))
(def: #export test
($_ _.and
diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux
index 1244b84e4..0f217e335 100644
--- a/stdlib/source/test/lux/macro/code.lux
+++ b/stdlib/source/test/lux/macro/code.lux
@@ -119,6 +119,7 @@
($_ _.and
(_.for [/.equivalence]
($equivalence.spec /.equivalence ..random))
+
(_.for [/.format]
(`` ($_ _.and
(~~ (template [<coverage> <random> <tag>]
diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux
index c1edf6022..593dba8e1 100644
--- a/stdlib/source/test/lux/macro/poly/equivalence.lux
+++ b/stdlib/source/test/lux/macro/poly/equivalence.lux
@@ -6,7 +6,10 @@
[monad (#+ do)]
[equivalence (#+ Equivalence)
{[0 #poly]
- ["." /]}]]
+ ["." /]}]
+ {[0 #spec]
+ [/
+ ["$." equivalence]]}]
[data
["." bit]
["." maybe]
@@ -48,7 +51,7 @@
(random.and random.safe_frac
gen_recursive)))))
-(def: gen_record
+(def: random
(Random Record)
(do {! random.monad}
[size (\ ! map (n.% 2) random.nat)
@@ -75,9 +78,6 @@
(def: #export test
Test
- (<| (_.context (%.name (name_of /._)))
- (do random.monad
- [sample gen_record
- #let [(^open "/\.") ..equivalence]]
- (_.test "Every instance equals itself."
- (/\= sample sample)))))
+ (<| (_.covering /._)
+ (_.for [/.equivalence]
+ ($equivalence.spec ..equivalence ..random))))
diff --git a/stdlib/source/test/lux/macro/poly/functor.lux b/stdlib/source/test/lux/macro/poly/functor.lux
index 3f2b4db50..9463d7f11 100644
--- a/stdlib/source/test/lux/macro/poly/functor.lux
+++ b/stdlib/source/test/lux/macro/poly/functor.lux
@@ -22,6 +22,6 @@
(def: #export test
Test
- (<| (_.context (%.name (name_of /._)))
- (_.test "Can derive functors automatically."
- true)))
+ (<| (_.covering /._)
+ (_.cover [/.functor]
+ true)))
diff --git a/stdlib/source/test/lux/macro/syntax/common.lux b/stdlib/source/test/lux/macro/syntax/common.lux
index 429b7fc6e..2929417e3 100644
--- a/stdlib/source/test/lux/macro/syntax/common.lux
+++ b/stdlib/source/test/lux/macro/syntax/common.lux
@@ -33,7 +33,9 @@
["#." check]
["#." declaration]
["#." definition]
- ["#." export]])
+ ["#." export]
+ ["#." type #_
+ ["#/." variable]]])
(def: random_text
(Random Text)
@@ -46,18 +48,6 @@
(_.covering /writer._)
($_ _.and
(do {! random.monad}
- [size (\ ! map (|>> (n.% 3)) random.nat)
- expected (random.list size ..random_text)]
- (_.cover [/.Type_Var /reader.type_variables /writer.type_variables]
- (|> expected
- /writer.type_variables
- (<c>.run /reader.type_variables)
- (case> (#try.Success actual)
- (\ (list.equivalence text.equivalence) = expected actual)
-
- (#try.Failure error)
- false))))
- (do {! random.monad}
[expected (: (Random /.Typed_Input)
(random.and ///code.random
///code.random))]
@@ -77,4 +67,5 @@
/declaration.test
/definition.test
/export.test
+ /type/variable.test
)))
diff --git a/stdlib/source/test/lux/macro/syntax/common/annotations.lux b/stdlib/source/test/lux/macro/syntax/common/annotations.lux
index bc29a00f6..b1369ef48 100644
--- a/stdlib/source/test/lux/macro/syntax/common/annotations.lux
+++ b/stdlib/source/test/lux/macro/syntax/common/annotations.lux
@@ -49,4 +49,5 @@
false
(#try.Success actual)
- (\ /.equivalence = expected actual)))))))
+ (\ /.equivalence = expected actual))))
+ )))
diff --git a/stdlib/source/test/lux/macro/syntax/common/type/variable.lux b/stdlib/source/test/lux/macro/syntax/common/type/variable.lux
new file mode 100644
index 000000000..4701f5aef
--- /dev/null
+++ b/stdlib/source/test/lux/macro/syntax/common/type/variable.lux
@@ -0,0 +1,37 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ ["$." equivalence]]}]
+ [control
+ ["." try ("#\." functor)]
+ [parser
+ ["<.>" code]]]
+ [math
+ ["." random (#+ Random)]]]
+ {1
+ ["." /]})
+
+(def: #export random
+ (Random /.Variable)
+ (random.ascii/alpha 10))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Variable])
+ ($_ _.and
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence ..random))
+
+ (do random.monad
+ [expected ..random]
+ (_.cover [/.format /.parser]
+ (|> (list (/.format expected))
+ (<code>.run /.parser)
+ (try\map (\ /.equivalence = expected))
+ (try.default false))))
+ )))
diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux
index a8c7c121e..a140a736d 100644
--- a/stdlib/source/test/lux/math.lux
+++ b/stdlib/source/test/lux/math.lux
@@ -21,17 +21,12 @@
["#/." continuous]
["#/." fuzzy]]])
-(def: (within? margin_of_error standard value)
- (-> Frac Frac Frac Bit)
- (f.< margin_of_error
- (f.abs (f.- standard value))))
-
(def: margin Frac +0.0000001)
(def: (trigonometric_symmetry forward backward angle)
(-> (-> Frac Frac) (-> Frac Frac) Frac Bit)
(let [normal (|> angle forward backward)]
- (|> normal forward backward (within? margin normal))))
+ (|> normal forward backward (f.approximately? margin normal))))
(def: #export test
Test
@@ -71,7 +66,7 @@
(do {! random.monad}
[sample (|> random.safe_frac (\ ! map (f.* +10.0)))]
(_.test "Logarithm is the inverse of exponential."
- (|> sample /.exp /.log (within? +0.000000000000001 sample)))))
+ (|> sample /.exp /.log (f.approximately? +0.000000000000001 sample)))))
(<| (_.context "Greatest-Common-Divisor and Least-Common-Multiple")
(do {! random.monad}
[#let [gen_nat (|> random.nat (\ ! map (|>> (n.% 1000) (n.max 1))))]
diff --git a/stdlib/source/test/lux/math/number/complex.lux b/stdlib/source/test/lux/math/number/complex.lux
index 751ec9022..11f729aac 100644
--- a/stdlib/source/test/lux/math/number/complex.lux
+++ b/stdlib/source/test/lux/math/number/complex.lux
@@ -60,10 +60,10 @@
(let [r+i (/.complex real)]
(and (f.= real (get@ #/.real r+i))
(f.= +0.0 (get@ #/.imaginary r+i))))))
- (_.cover [/.within?]
- (/.within? ..margin_of_error
- (/.complex real imaginary)
- (/.complex real imaginary)))
+ (_.cover [/.approximately?]
+ (/.approximately? ..margin_of_error
+ (/.complex real imaginary)
+ (/.complex real imaginary)))
(_.cover [/.not_a_number?]
(and (/.not_a_number? (/.complex f.not_a_number imaginary))
(/.not_a_number? (/.complex real f.not_a_number))))
@@ -119,10 +119,10 @@
(_.cover [/.argument]
(let [sample (/.complex real imaginary)]
(or (/.= /.zero sample)
- (/.within? ..margin_of_error
- sample
- (/.*' (/.abs sample)
- (/.exp (/.* /.i (/.complex (/.argument sample)))))))))
+ (/.approximately? ..margin_of_error
+ sample
+ (/.*' (/.abs sample)
+ (/.exp (/.* /.i (/.complex (/.argument sample)))))))))
)))
(def: number
@@ -149,23 +149,23 @@
(get@ #/.imaginary x))))))
inverse!
- (and (|> x (/.+ y) (/.- y) (/.within? ..margin_of_error x))
- (|> x (/.- y) (/.+ y) (/.within? ..margin_of_error x)))]
+ (and (|> x (/.+ y) (/.- y) (/.approximately? ..margin_of_error x))
+ (|> x (/.- y) (/.+ y) (/.approximately? ..margin_of_error x)))]
(and normal!
inverse!)))
(_.cover [/.* /./]
- (|> x (/.* y) (/./ y) (/.within? ..margin_of_error x)))
+ (|> x (/.* y) (/./ y) (/.approximately? ..margin_of_error x)))
(_.cover [/.*' /./']
- (|> x (/.*' factor) (/./' factor) (/.within? ..margin_of_error x)))
+ (|> x (/.*' factor) (/./' factor) (/.approximately? ..margin_of_error x)))
(_.cover [/.%]
(let [rem (/.% y x)
quotient (|> x (/.- rem) (/./ y))
floored (|> quotient
(update@ #/.real math.floor)
(update@ #/.imaginary math.floor))]
- (/.within? +0.000000000001
- x
- (|> quotient (/.* y) (/.+ rem)))))
+ (/.approximately? +0.000000000001
+ x
+ (|> quotient (/.* y) (/.+ rem)))))
)))
(def: conjugate&reciprocal&signum&negation
@@ -181,10 +181,10 @@
(get@ #/.imaginary cx)))))
(_.cover [/.reciprocal]
(let [reciprocal!
- (|> x (/.* (/.reciprocal x)) (/.within? ..margin_of_error /.+one))
+ (|> x (/.* (/.reciprocal x)) (/.approximately? ..margin_of_error /.+one))
own_inverse!
- (|> x /.reciprocal /.reciprocal (/.within? ..margin_of_error x))]
+ (|> x /.reciprocal /.reciprocal (/.approximately? ..margin_of_error x))]
(and reciprocal!
own_inverse!)))
(_.cover [/.signum]
@@ -210,7 +210,7 @@
(def: (trigonometric_symmetry forward backward angle)
(-> (-> /.Complex /.Complex) (-> /.Complex /.Complex) /.Complex Bit)
(let [normal (|> angle forward backward)]
- (|> normal forward backward (/.within? ..margin_of_error normal))))
+ (|> normal forward backward (/.approximately? ..margin_of_error normal))))
(def: trigonometry
Test
@@ -230,17 +230,17 @@
[angle ..angle]
($_ _.and
(_.cover [/.sinh]
- (/.within? ..margin_of_error
- (|> angle (/.* /.i) /.sin (/.* /.i) (/.* /.-one))
- (/.sinh angle)))
+ (/.approximately? ..margin_of_error
+ (|> angle (/.* /.i) /.sin (/.* /.i) (/.* /.-one))
+ (/.sinh angle)))
(_.cover [/.cosh]
- (/.within? ..margin_of_error
- (|> angle (/.* /.i) /.cos)
- (/.cosh angle)))
+ (/.approximately? ..margin_of_error
+ (|> angle (/.* /.i) /.cos)
+ (/.cosh angle)))
(_.cover [/.tanh]
- (/.within? ..margin_of_error
- (|> angle (/.* /.i) /.tan (/.* /.i) (/.* /.-one))
- (/.tanh angle)))
+ (/.approximately? ..margin_of_error
+ (|> angle (/.* /.i) /.tan (/.* /.i) (/.* /.-one))
+ (/.tanh angle)))
)))
(def: exponentiation&logarithm
@@ -249,11 +249,11 @@
[x ..random]
($_ _.and
(_.cover [/.pow /.root/2]
- (|> x (/.pow (/.complex +2.0)) /.root/2 (/.within? ..margin_of_error x)))
+ (|> x (/.pow (/.complex +2.0)) /.root/2 (/.approximately? ..margin_of_error x)))
(_.cover [/.pow']
- (|> x (/.pow' +2.0) (/.pow' +0.5) (/.within? ..margin_of_error x)))
+ (|> x (/.pow' +2.0) (/.pow' +0.5) (/.approximately? ..margin_of_error x)))
(_.cover [/.log /.exp]
- (|> x /.log /.exp (/.within? ..margin_of_error x)))
+ (|> x /.log /.exp (/.approximately? ..margin_of_error x)))
)))
(def: root
@@ -265,7 +265,7 @@
(|> sample
(/.roots degree)
(list\map (/.pow' (|> degree .int int.frac)))
- (list.every? (/.within? ..margin_of_error sample))))))
+ (list.every? (/.approximately? ..margin_of_error sample))))))
(def: #export test
Test
diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux
index 2bd56a513..0bbe19697 100644
--- a/stdlib/source/test/lux/math/number/frac.lux
+++ b/stdlib/source/test/lux/math/number/frac.lux
@@ -63,9 +63,9 @@
(_.cover [/.zero?]
(bit\= (/.zero? sample)
(/.= +0.0 sample)))
- (_.cover [/.within?]
- (and (/.within? /.smallest sample sample)
- (/.within? (/.+ +1.0 shift) sample (/.+ shift sample))))
+ (_.cover [/.approximately?]
+ (and (/.approximately? /.smallest sample sample)
+ (/.approximately? (/.+ +1.0 shift) sample (/.+ shift sample))))
(_.cover [/.number?]
(and (not (/.number? /.not_a_number))
(not (/.number? /.positive_infinity))
diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux
index 3f92e9d13..2315165ef 100644
--- a/stdlib/source/test/lux/meta.lux
+++ b/stdlib/source/test/lux/meta.lux
@@ -22,7 +22,8 @@
{1
["." /]}
["." / #_
- ["#." annotation]])
+ ["#." annotation]
+ ["#." location]])
(template: (!expect <pattern> <value>)
(case <value>
@@ -303,4 +304,5 @@
))
/annotation.test
+ /location.test
)))
diff --git a/stdlib/source/test/lux/meta/location.lux b/stdlib/source/test/lux/meta/location.lux
new file mode 100644
index 000000000..5c9d43d50
--- /dev/null
+++ b/stdlib/source/test/lux/meta/location.lux
@@ -0,0 +1,50 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ ["$." equivalence]]}]
+ [data
+ ["." text]]
+ [math
+ ["." random (#+ Random)]]]
+ {1
+ ["." /]}
+ ["$." /// #_
+ [macro
+ ["#." code]]])
+
+(def: #export random
+ (Random Location)
+ ($_ random.and
+ (random.ascii/alpha 10)
+ random.nat
+ random.nat
+ ))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [.Location])
+ ($_ _.and
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence ..random))
+
+ (_.cover [/.here]
+ (not (\ /.equivalence = (/.here) (/.here))))
+ (do random.monad
+ [location ..random
+ error (random.ascii/alpha 10)]
+ (_.cover [/.format /.with]
+ (let [located_error (/.with location error)]
+ (and (text.contains? (/.format location)
+ located_error)
+ (text.contains? error
+ located_error)))))
+ (do random.monad
+ [[location _] $///code.random]
+ (_.cover [/.dummy]
+ (\ /.equivalence = /.dummy location)))
+ )))
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 3a5a79711..a04371340 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -250,7 +250,7 @@
(def: $Double::random (:coerce (Random java/lang/Double) random.frac))
(def: $Double::literal
(-> java/lang/Double (Bytecode Any))
- (|>> (:coerce Frac) /.double))
+ /.double)
(def: valid_double
(Random java/lang/Double)
(random.filter (|>> (:coerce Frac) f.not_a_number? not)
@@ -794,14 +794,14 @@
@.jvm
(|>> (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))}))
(do /.monad
- [_ (/.double (:coerce Frac expected))]
+ [_ (/.double expected)]
(/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)]))))
(<| (_.lift "INVOKEVIRTUAL")
(do random.monad
[expected ..$Double::random])
(..bytecode (|>> (:coerce Bit) (bit\= (f.not_a_number? (:coerce Frac expected)))))
(do /.monad
- [_ (/.double (:coerce Frac expected))
+ [_ (/.double expected)
_ ..$Double::wrap
_ (/.invokevirtual ..$Double "isNaN" (/type.method [(list) /type.boolean (list)]))]
..$Boolean::wrap))
@@ -817,7 +817,7 @@
(do /.monad
[_ (/.new ..$Double)
_ /.dup
- _ (/.double (:coerce Frac expected))]
+ _ (/.double expected)]
(/.invokespecial ..$Double "<init>" (/type.method [(list /type.double) /type.void (list)]))))
(<| (_.lift "INVOKEINTERFACE")
(do random.monad