diff options
Diffstat (limited to '')
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 |