diff options
Diffstat (limited to '')
20 files changed, 415 insertions, 165 deletions
diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux index 47ad25f30..633872f9c 100644 --- a/stdlib/source/lux/data/number/frac.lux +++ b/stdlib/source/lux/data/number/frac.lux @@ -5,6 +5,7 @@ [monoid (#+ Monoid)] [equivalence (#+ Equivalence)] [codec (#+ Codec)] + [predicate (#+ Predicate)] ["." order (#+ Order)]] [control ["." try (#+ Try)]] @@ -29,7 +30,7 @@ ("lux f64 <" reference sample)) (def: #export (<= reference sample) - {#.doc "Frac(tion) less-than-equal."} + {#.doc "Frac(tion) less-than or equal."} (-> Frac Frac Bit) (or ("lux f64 <" reference sample) ("lux f64 =" reference sample))) @@ -40,11 +41,21 @@ ("lux f64 <" sample reference)) (def: #export (>= reference sample) - {#.doc "Frac(tion) greater-than-equal."} + {#.doc "Frac(tion) greater-than or equal."} (-> Frac Frac Bit) (or ("lux f64 <" sample reference) ("lux f64 =" sample reference))) +(template [<comparison> <name>] + [(def: #export <name> + (Predicate Frac) + (<comparison> +0.0))] + + [..> positive?] + [..< negative?] + [..= zero?] + ) + (template [<name> <op> <doc>] [(def: #export (<name> param subject) {#.doc <doc>} @@ -63,7 +74,9 @@ [(../ param subject) (..% param subject)]) -(def: #export negate (-> Frac Frac) (..* -1.0)) +(def: #export negate + (-> Frac Frac) + (..* -1.0)) (def: #export (abs x) (-> Frac Frac) diff --git a/stdlib/source/lux/data/number/int.lux b/stdlib/source/lux/data/number/int.lux index fb1ceb224..f2bcdfeb9 100644 --- a/stdlib/source/lux/data/number/int.lux +++ b/stdlib/source/lux/data/number/int.lux @@ -7,6 +7,7 @@ [monoid (#+ Monoid)] [equivalence (#+ Equivalence)] [codec (#+ Codec)] + [predicate (#+ Predicate)] ["." order (#+ Order)]] [control ["." try (#+ Try)]] @@ -28,7 +29,7 @@ ("lux i64 <" reference sample)) (def: #export (<= reference sample) - {#.doc "Int(eger) less-than-equal."} + {#.doc "Int(eger) less-than or equal."} (-> Int Int Bit) (if ("lux i64 <" reference sample) #1 @@ -40,12 +41,22 @@ ("lux i64 <" sample reference)) (def: #export (>= reference sample) - {#.doc "Int(eger) greater-than-equal."} + {#.doc "Int(eger) greater-than or equal."} (-> Int Int Bit) (if ("lux i64 <" sample reference) #1 ("lux i64 =" reference sample))) +(template [<comparison> <name>] + [(def: #export <name> + (Predicate Int) + (<comparison> +0))] + + [..> positive?] + [..< negative?] + [..= zero?] + ) + (template [<name> <test> <doc>] [(def: #export (<name> left right) {#.doc <doc>} diff --git a/stdlib/source/lux/data/number/nat.lux b/stdlib/source/lux/data/number/nat.lux index 9f370fb51..dd5e52ad1 100644 --- a/stdlib/source/lux/data/number/nat.lux +++ b/stdlib/source/lux/data/number/nat.lux @@ -48,7 +48,7 @@ #0)))) (def: #export (<= reference sample) - {#.doc "Nat(ural) less-than-equal."} + {#.doc "Nat(ural) less-than or equal."} (-> Nat Nat Bit) (if (..< reference sample) #1 @@ -60,7 +60,7 @@ (..< sample reference)) (def: #export (>= reference sample) - {#.doc "Nat(ural) greater-than-equal."} + {#.doc "Nat(ural) greater-than or equal."} (-> Nat Nat Bit) (if (..< sample reference) #1 diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux index 881043013..be4959726 100644 --- a/stdlib/source/lux/data/number/rev.lux +++ b/stdlib/source/lux/data/number/rev.lux @@ -32,7 +32,7 @@ (:coerce Nat sample))) (def: #export (<= reference sample) - {#.doc "Rev(olution) less-than-equal."} + {#.doc "Rev(olution) less-than or equal."} (-> Rev Rev Bit) (if (//nat.< (:coerce Nat reference) (:coerce Nat sample)) @@ -45,7 +45,7 @@ (..< sample reference)) (def: #export (>= reference sample) - {#.doc "Rev(olution) greater-than-equal."} + {#.doc "Rev(olution) greater-than or equal."} (-> Rev Rev Bit) (if (..< sample reference) #1 diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index fb2bc0728..c82dd5e41 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -106,6 +106,11 @@ _ false)) +(def: #export (encloses? boundary value) + (-> Text Text Bit) + (and (starts-with? boundary value) + (ends-with? boundary value))) + (def: #export (contains? sub text) (-> Text Text Bit) (case ("lux text index" 0 sub text) @@ -155,18 +160,18 @@ #.None (#.Cons sample #.Nil))) -(def: #export (replace-once pattern value template) +(def: #export (replace-once pattern replacement template) (-> Text Text Text Text) (<| (maybe.default template) (do maybe.monad [[pre post] (split-with pattern template)] - (wrap ($_ "lux text concat" pre value post))))) + (wrap ($_ "lux text concat" pre replacement post))))) -(def: #export (replace-all pattern value template) +(def: #export (replace-all pattern replacement template) (-> Text Text Text Text) (case (..split-with pattern template) (#.Some [pre post]) - ($_ "lux text concat" pre value (replace-all pattern value post)) + ($_ "lux text concat" pre replacement (replace-all pattern replacement post)) #.None template)) @@ -264,6 +269,7 @@ (..enclose' ..double-quote)) (def: #export space + Text " ") (def: #export (space? char) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 72096032a..59241f43d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -192,16 +192,32 @@ (def: (caster input output) (-> Type Type Handler) - (function (_ extension-name analyse archive args) - (case args - (^ (list valueC)) - (do ////.monad + (..custom + [<c>.any + (function (_ extension-name phase archive valueC) + (do {@ ////.monad} [_ (typeA.infer output)] (typeA.with-type input - (analyse archive valueC))) - - _ - (////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) + (phase archive valueC))))])) + +(def: lux::macro + Handler + (..custom + [<c>.any + (function (_ extension-name phase archive valueC) + (do {@ ////.monad} + [_ (typeA.infer .Macro) + input-type (loop [input-name (name-of .Macro')] + (do @ + [input-type (///.lift (meta.find-def (name-of .Macro')))] + (case input-type + (#.Definition [exported? def-type def-data def-value]) + (wrap (:coerce Type def-value)) + + (#.Alias real-name) + (recur real-name))))] + (typeA.with-type input-type + (phase archive valueC))))])) (def: (bundle::lux eval) (-> Eval Bundle) @@ -211,7 +227,7 @@ (///bundle.install "try" lux::try) (///bundle.install "check" (lux::check eval)) (///bundle.install "coerce" (lux::coerce eval)) - (///bundle.install "macro" (..caster .Macro' .Macro)) + (///bundle.install "macro" ..lux::macro) (///bundle.install "check type" (..caster .Type .Type)) (///bundle.install "in-module" lux::in-module))) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index e29af6e7a..c2fa69e11 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -132,7 +132,7 @@ (case (do try.monad [data data project (..project data)] - (/project.profile project profile)) + (/project.profile profile project)) (#try.Success profile) (case operation #/cli.POM diff --git a/stdlib/source/program/aedifex/artifact/type.lux b/stdlib/source/program/aedifex/artifact/type.lux new file mode 100644 index 000000000..e5836d13f --- /dev/null +++ b/stdlib/source/program/aedifex/artifact/type.lux @@ -0,0 +1,16 @@ +(.module: + [lux (#- Type)]) + +## https://maven.apache.org/ref/3.6.3/maven-core/artifact-handlers.html +(type: #export Type + Text) + +(template [<type> <name>] + [(def: #export <name> + Type + <type>)] + + ["tar" lux-library] + ["jar" jvm-library] + ["pom" pom] + ) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index eb7842e45..2c4b26aed 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -25,9 +25,10 @@ ["#." action] ["#." command (#+ Command)] ["#." local] - ["#." artifact (#+ Group Name Artifact)] ["#." dependency (#+ Dependency Resolution)] - ["#." shell]]) + ["#." shell] + ["#." artifact (#+ Group Name Artifact) + ["#/." type]]]) (type: Finder (-> Resolution (Maybe Dependency))) @@ -86,7 +87,7 @@ (def: libraries (-> Resolution (List Path)) (|>> dictionary.keys - (list.filter (|>> (get@ #///dependency.type) (text@= ///dependency.lux-library))) + (list.filter (|>> (get@ #///dependency.type) (text@= ///artifact/type.lux-library))) (list@map (|>> (get@ #///dependency.artifact) (///local.path file.system))))) (import: java/lang/String) diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index 1081322b4..a4b076733 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -30,7 +30,9 @@ ["#." command (#+ Command)] ["#." dependency] ["#." pom] - ["#." hash]]) + ["#." hash] + ["#." artifact + ["#/." type]]]) (exception: #export (cannot-find-repository {repository Text} {options (Dictionary Text ///dependency.Repository)}) @@ -51,7 +53,7 @@ (promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)])) [(#.Some identity) (#.Some repository)] - (let [deploy! (: (-> ///dependency.Type Binary (Action Any)) + (let [deploy! (: (-> ///artifact/type.Type Binary (Action Any)) (function (_ type content) (promise.future (//.upload repository @@ -65,8 +67,8 @@ (export.library (file.async file.system) (set.to-list (get@ #/.sources profile)))) pom (promise@wrap (///pom.project profile)) - _ (deploy! ///dependency.pom (|> pom (:: xml.codec encode) encoding.to-utf8)) - _ (deploy! ///dependency.lux-library library) + _ (deploy! ///artifact/type.pom (|> pom (:: xml.codec encode) encoding.to-utf8)) + _ (deploy! ///artifact/type.lux-library library) _ (deploy! "sha1" (///hash.sha1 library)) _ (deploy! "md5" (///hash.md5 library))] (wrap []))))) diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux index 2086a4d06..3128bb3f3 100644 --- a/stdlib/source/program/aedifex/dependency.lux +++ b/stdlib/source/program/aedifex/dependency.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Name Type) + [lux (#- Name) ["." host (#+ import:)] [abstract [monad (#+ do)] @@ -30,19 +30,16 @@ ["." uri]]]] ["." // #_ ["#." extension] - ["#." artifact (#+ Artifact)] - ["#." hash]]) + ["#." hash] + ["#." artifact (#+ Artifact) + ["#/." type]]]) (type: #export Repository URL) -## https://maven.apache.org/ref/3.6.3/maven-core/artifact-handlers.html -(type: #export Type - Text) - (type: #export Dependency {#artifact Artifact - #type ..Type}) + #type //artifact/type.Type}) (def: #export equivalence (Equivalence Dependency) @@ -58,16 +55,6 @@ text.hash )) -(template [<type> <name>] - [(def: #export <name> - Type - <type>)] - - ["tar" lux-library] - ["jar" jvm-library] - ["pom" pom] - ) - (import: java/lang/String) (import: java/lang/AutoCloseable @@ -200,7 +187,7 @@ #//artifact.version version} #type (|> properties (dictionary.get ["" "type"]) - (maybe.default ..lux-library))}))))) + (maybe.default //artifact/type.lux-library))}))))) (def: parse-dependencies (Parser (List Dependency)) diff --git a/stdlib/source/program/aedifex/format.lux b/stdlib/source/program/aedifex/format.lux index 1107f4d13..4ec8b8ae6 100644 --- a/stdlib/source/program/aedifex/format.lux +++ b/stdlib/source/program/aedifex/format.lux @@ -11,8 +11,9 @@ ["." // #_ ["/" profile] ["#." project (#+ Project)] - ["#." artifact (#+ Artifact)] - ["#." dependency (#+ Dependency)]]) + ["#." dependency (#+ Dependency)] + ["#." artifact (#+ Artifact) + ["#/." type]]]) (type: #export (Format a) (-> a Code)) @@ -125,7 +126,7 @@ (def: (dependency [artifact type]) (Format Dependency) - (if (text@= //dependency.lux-library type) + (if (text@= //artifact/type.lux-library type) (` [(~+ (..artifact' artifact))]) (` [(~+ (..artifact' artifact)) (~ (code.text type))]))) diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux index 1b8a02f1a..60b5e8881 100644 --- a/stdlib/source/program/aedifex/local.lux +++ b/stdlib/source/program/aedifex/local.lux @@ -32,9 +32,10 @@ ["/" profile (#+ Profile)] ["#." extension] ["#." pom] - ["#." artifact (#+ Artifact)] ["#." dependency (#+ Package Resolution Dependency)] - ["#." hash]]) + ["#." hash] + ["#." artifact (#+ Artifact) + ["#/." type]]]) (def: (local system) (All [a] (-> (file.System a) Path)) @@ -78,7 +79,7 @@ #let [artifact-name (format repository (:: system separator) (//artifact.identity identity))] package (export.library system (set.to-list (get@ #/.sources profile))) _ (..save! system (binary.run tar.writer package) - (format artifact-name "." //dependency.lux-library)) + (format artifact-name "." //artifact/type.lux-library)) pom (:: promise.monad wrap (//pom.project profile))] (..save! system (|> pom (:: xml.codec encode) encoding.to-utf8) (format artifact-name //extension.pom))) diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 1799db09e..867b3b81f 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -20,8 +20,9 @@ ["." // #_ ["/" profile] ["#." project (#+ Project)] - ["#." artifact (#+ Artifact)] - ["#." dependency]]) + ["#." dependency] + ["#." artifact (#+ Artifact) + ["#/." type]]]) (def: (as-input input) (-> (Maybe Code) (List Code)) @@ -139,7 +140,7 @@ ..url) (def: type - (Parser //dependency.Type) + (Parser //artifact/type.Type) <c>.text) (def: dependency @@ -147,7 +148,7 @@ (<c>.tuple ($_ <>.and ..artifact' - (<>.default //dependency.lux-library ..type) + (<>.default //artifact/type.lux-library ..type) ))) (def: source diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 1ba27d0b6..72715fdef 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -9,6 +9,8 @@ ["$." equivalence]]}] [math ["." random (#+ Random)]]] + ["." / #_ + ["#." type]] {#program ["." /]}) @@ -27,4 +29,6 @@ ($_ _.and (_.with-cover [/.equivalence] ($equivalence.spec /.equivalence ..random)) + + /type.test )))) diff --git a/stdlib/source/test/aedifex/artifact/type.lux b/stdlib/source/test/aedifex/artifact/type.lux new file mode 100644 index 000000000..fd815f19e --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/type.lux @@ -0,0 +1,28 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + ["." text] + [number + ["n" nat]] + [collection + ["." set] + ["." list]]] + [math + ["." random (#+ Random)]]] + {#program + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Type] + ($_ _.and + (_.cover [/.lux-library /.jvm-library /.pom] + (let [options (list /.lux-library /.jvm-library /.pom) + uniques (set.from-list text.hash options)] + (n.= (list.size options) + (set.size uniques)))) + )))) diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux index 20e62ef86..74057ad63 100644 --- a/stdlib/source/test/lux/data/product.lux +++ b/stdlib/source/test/lux/data/product.lux @@ -18,6 +18,7 @@ (def: #export test Test (<| (_.covering /._) + (_.with-cover [.&]) (do random.monad [expected random.nat shift random.nat diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 972677361..3bbf65bc9 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -22,6 +22,7 @@ (def: #export test Test (<| (_.covering /._) + (_.with-cover [.|]) (do {@ random.monad} [expected random.nat shift random.nat]) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index a1a0ec7b1..6fbee6ec5 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -1,137 +1,295 @@ (.module: - [lux #* - ["%" data/text/format (#+ format)] + [lux (#- char) ["_" test (#+ Test)] [abstract - [monad (#+ do Monad)] + [monad (#+ do)] {[0 #spec] [/ ["$." equivalence] - ["$." order]]}] + ["$." order] + ["$." monoid]]}] [control pipe] [data + ["." maybe] [number ["n" nat]] [collection - ["." list]]] + ["." list] + ["." set]]] [math - ["r" random]]] + ["." random]]] {1 ["." /]}) (def: bounded-size - (r.Random Nat) - (|> r.nat - (:: r.monad map (|>> (n.% 20) (n.+ 1))))) + (random.Random Nat) + (|> random.nat + (:: random.monad map (|>> (n.% 20) (n.+ 1))))) -(def: #export test +(def: size Test - (<| (_.context (%.name (name-of .Text))) - ($_ _.and - ($equivalence.spec /.equivalence (r.ascii 2)) - ($order.spec /.order (r.ascii 2)) + (do {@ random.monad} + [size (:: @ map (n.% 10) random.nat) + sample (random.unicode size)] + ($_ _.and + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (or (/.empty? sample) + (not (n.= 0 size))))))) - (do {@ r.monad} - [size (:: @ map (n.% 10) r.nat) - sample (r.unicode size)] - ($_ _.and - (_.test "Can get the size of text." - (n.= size (/.size sample))) - (_.test "Text with size 0 is considered 'empty'." - (or (not (n.= 0 size)) - (/.empty? sample))))) - (do {@ r.monad} - [size bounded-size - idx (:: @ map (n.% size) r.nat) - sample (r.unicode size)] - (_.test "Character locations." - (|> sample - (/.nth idx) - (case> (^multi (#.Some char) - [(/.from-code char) char] - [[(/.index-of char sample) - (/.last-index-of char sample) - (/.index-of' char idx sample) - (/.last-index-of' char idx sample)] - [(#.Some io) (#.Some lio) - (#.Some io') (#.Some lio')]]) - (and (n.<= idx io) - (n.>= idx lio) +(def: affix + Test + (do {@ random.monad} + [inner (random.unicode 1) + outer (random.filter (|>> (:: /.equivalence = inner) not) + (random.unicode 1)) + left (random.unicode 1) + right (random.unicode 1) + #let [full (:: /.monoid compose inner outer) + fake-index (.nat -1)]] + (`` ($_ _.and + (~~ (template [<affix> <predicate>] + [(_.cover [<affix> <predicate>] + (<predicate> outer (<affix> outer inner)))] + + [/.prefix /.starts-with?] + [/.suffix /.ends-with?] + [/.enclose' /.encloses?] + )) + (_.cover [/.enclose] + (let [value (/.enclose [left right] inner)] + (and (/.starts-with? left value) + (/.ends-with? right value)))) + (_.cover [/.encode] + (let [sample (/.encode inner)] + (and (/.encloses? /.double-quote sample) + (/.contains? inner sample)))) + )))) + +(def: index + Test + (do {@ random.monad} + [inner (random.unicode 1) + outer (random.filter (|>> (:: /.equivalence = inner) not) + (random.unicode 1)) + #let [fake-index (.nat -1)]] + ($_ _.and + (_.cover [/.contains?] + (let [full (:: /.monoid compose inner outer)] + (and (/.contains? inner full) + (/.contains? outer full)))) + (_.cover [/.index-of] + (and (|> (/.index-of inner (:: /.monoid compose inner outer)) + (maybe.default fake-index) + (n.= 0)) + (|> (/.index-of outer (:: /.monoid compose inner outer)) + (maybe.default fake-index) + (n.= 1)))) + (_.cover [/.index-of'] + (let [full (:: /.monoid compose inner outer)] + (and (|> (/.index-of' inner 0 full) + (maybe.default fake-index) + (n.= 0)) + (|> (/.index-of' inner 1 full) + (maybe.default fake-index) + (n.= fake-index)) + + (|> (/.index-of' outer 0 full) + (maybe.default fake-index) + (n.= 1)) + (|> (/.index-of' outer 1 full) + (maybe.default fake-index) + (n.= 1)) + (|> (/.index-of' outer 2 full) + (maybe.default fake-index) + (n.= fake-index))))) + (_.cover [/.last-index-of] + (let [full ($_ (:: /.monoid compose) outer inner outer)] + (and (|> (/.last-index-of inner full) + (maybe.default fake-index) + (n.= 1)) + (|> (/.last-index-of outer full) + (maybe.default fake-index) + (n.= 2))))) + (_.cover [/.last-index-of'] + (let [full ($_ (:: /.monoid compose) outer inner outer)] + (and (|> (/.last-index-of' inner 0 full) + (maybe.default fake-index) + (n.= 1)) + (|> (/.last-index-of' inner 2 full) + (maybe.default fake-index) + (n.= fake-index)) + + (|> (/.last-index-of' outer 0 full) + (maybe.default fake-index) + (n.= 2)) + (|> (/.last-index-of' outer 2 full) + (maybe.default fake-index) + (n.= 2)) + (|> (/.last-index-of' outer 3 full) + (maybe.default fake-index) + (n.= fake-index))))) + ))) + +(def: char + Test + ($_ _.and + (_.with-cover [/.Char /.from-code] + (`` ($_ _.and + (~~ (template [<short> <long>] + [(_.cover [<short> <long>] + (:: /.equivalence = <short> <long>))] - (n.= idx io') - (n.>= idx lio') + [/.\0 /.null] + [/.\a /.alarm] + [/.\b /.back-space] + [/.\t /.tab] + [/.\n /.new-line] + [/.\v /.vertical-tab] + [/.\f /.form-feed] + [/.\r /.carriage-return] + [/.\'' /.double-quote])) + (_.cover [/.line-feed] + (:: /.equivalence = /.new-line /.line-feed)) + ))) + (do {@ random.monad} + [size (:: @ map (|>> (n.% 10) inc) random.nat) + characters (random.set /.hash size (random.ascii/alpha 1)) + #let [sample (|> characters set.to-list /.concat)] + expected (:: @ map (n.% size) random.nat)] + (_.cover [/.nth] + (case (/.nth expected sample) + (#.Some char) + (case (/.index-of (/.from-code char) sample) + (#.Some actual) + (n.= expected actual) - (/.contains? char sample)) + _ + false) + + #.None + false))) + (_.cover [/.space /.space?] + (`` (and (~~ (template [<char>] + [(/.space? (`` (.char (~~ (static <char>)))))] + + [/.tab] + [/.vertical-tab] + [/.space] + [/.new-line] + [/.carriage-return] + [/.form-feed] + ))))) + )) - _ - #0 - )) - )) - (do r.monad +(def: manipulation + Test + (do {@ random.monad} + [size (:: @ map (|>> (n.% 10) (n.+ 2)) random.nat) + characters (random.set /.hash size (random.ascii/alpha 1)) + separator (random.filter (|>> (set.member? characters) not) + (random.ascii/alpha 1)) + #let [with-no-separator (|> characters set.to-list /.concat)] + static (random.ascii/alpha 1) + #let [dynamic (random.filter (|>> (:: /.equivalence = static) not) + (random.ascii/alpha 1))] + pre dynamic + post dynamic] + ($_ _.and + (_.cover [/.concat] + (n.= (set.size characters) + (/.size (/.concat (set.to-list characters))))) + (_.cover [/.join-with /.split-all-with] + (and (|> (set.to-list characters) + (/.join-with separator) + (/.split-all-with separator) + (set.from-list /.hash) + (:: set.equivalence = characters)) + (:: /.equivalence = + (/.concat (set.to-list characters)) + (/.join-with "" (set.to-list characters))))) + (_.cover [/.replace-once] + (:: /.equivalence = + (:: /.monoid compose post static) + (/.replace-once pre post (:: /.monoid compose pre static)))) + (_.cover [/.split-with] + (case (/.split-with static ($_ (:: /.monoid compose) pre static post)) + (#.Some [left right]) + (and (:: /.equivalence = pre left) + (:: /.equivalence = post right)) + + #.None + false)) + ))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [.Text]) + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence (random.ascii 2))) + (_.with-cover [/.order] + ($order.spec /.order (random.ascii 2))) + (_.with-cover [/.monoid] + ($monoid.spec /.equivalence /.monoid (random.ascii 2))) + + ..size + ..affix + ..index + ..char + ..manipulation + + (do random.monad [sizeL bounded-size sizeR bounded-size - sampleL (r.unicode sizeL) - sampleR (r.unicode sizeR) + sampleL (random.unicode sizeL) + sampleR (random.unicode sizeR) + middle (random.unicode 1) #let [sample (/.concat (list sampleL sampleR)) (^open "/@.") /.equivalence]] ($_ _.and - (_.test "Can join text snippets." - (and (not (/@= sample - (/.join-with " " (list sampleL sampleR)))) - (/@= sample - (/.join-with "" (list sampleL sampleR))))) - (_.test "Can check sub-texts at the borders." - (and (/.starts-with? sampleL sample) - (/.ends-with? sampleR sample))) - (_.test "Can enclose text in another texts." - (/@= (/.enclose [sampleR sampleR] sampleL) - (/.enclose' sampleR sampleL))) - (_.test "Can split text." - (|> (/.split sizeL sample) - (case> (#.Right [_l _r]) - (and (/@= sampleL _l) - (/@= sampleR _r) - (/@= sample (/.concat (list _l _r)))) + (_.cover [/.split] + (|> (/.split sizeL sample) + (case> (#.Right [_l _r]) + (and (/@= sampleL _l) + (/@= sampleR _r) + (/@= sample (/.concat (list _l _r)))) - _ - #0))) - (_.test "Can clip text." - (|> [(/.clip 0 sizeL sample) - (/.clip sizeL (/.size sample) sample) - (/.clip' sizeL sample) - (/.clip' 0 sample)] - (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)] - (and (/@= sampleL _l) - (/@= sampleR _r) - (/@= _r _r') - (/@= sample _f)) + _ + #0))) + (_.cover [/.clip /.clip'] + (|> [(/.clip 0 sizeL sample) + (/.clip sizeL (/.size sample) sample) + (/.clip' sizeL sample) + (/.clip' 0 sample)] + (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)] + (and (/@= sampleL _l) + (/@= sampleR _r) + (/@= _r _r') + (/@= sample _f)) - _ - #0))) + _ + #0))) )) - (do {@ r.monad} + (do {@ random.monad} [sizeP bounded-size sizeL bounded-size #let [## The wider unicode charset includes control characters that ## can make text replacement work improperly. ## Because of that, I restrict the charset. - normal-char-gen (|> r.nat (:: @ map (|>> (n.% 128) (n.max 1))))] - sep1 (r.text normal-char-gen 1) - sep2 (r.text normal-char-gen 1) - #let [part-gen (|> (r.text normal-char-gen sizeP) - (r.filter (|>> (/.contains? sep1) not)))] - parts (r.list sizeL part-gen) + normal-char-gen (|> random.nat (:: @ map (|>> (n.% 128) (n.max 1))))] + sep1 (random.text normal-char-gen 1) + sep2 (random.text normal-char-gen 1) + #let [part-gen (|> (random.text normal-char-gen sizeP) + (random.filter (|>> (/.contains? sep1) not)))] + parts (random.list sizeL part-gen) #let [sample1 (/.concat (list.interpose sep1 parts)) sample2 (/.concat (list.interpose sep2 parts)) (^open "/@.") /.equivalence]] - ($_ _.and - (_.test "Can split text multiple times through a separator." - (n.= (list.size parts) - (list.size (/.split-all-with sep1 sample1)))) - - (_.test "Can replace occurrences of a piece of text inside a larger text." - (/@= sample2 - (/.replace-all sep1 sep2 sample1))) - )) + (_.cover [/.replace-all] + (/@= sample2 + (/.replace-all sep1 sep2 sample1)))) ))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index b9639a82f..e1c4dbfe3 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -237,6 +237,11 @@ #random ..$Float::random #literal ..$Float::literal}) +(def: valid-float + (Random java/lang/Float) + (random.filter (|>> host.float-to-double (:coerce Frac) f.not-a-number? not) + ..$Float::random)) + (def: $Double (/type.class "java.lang.Double" (list))) (def: $Double::wrap (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)]))) (def: $Double::random (:coerce (Random java/lang/Double) random.frac)) @@ -678,10 +683,8 @@ comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit)) (function (_ instruction standard) (do random.monad - [#let [valid-double (random.filter (|>> (:coerce Frac) f.not-a-number? not) - ..$Double::random)] - reference valid-double - subject valid-double + [reference ..valid-double + subject ..valid-double #let [expected (if (for {@.old ("jvm deq" reference subject) @@ -1184,15 +1187,15 @@ (let [test (!::= java/lang/Float "jvm feq" "jvm float =")] ($_ _.and (_.lift "FSTORE_0/FLOAD_0" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-0) (function.constant /.fload-0)] test)) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-0) (function.constant /.fload-0)] test)) (_.lift "FSTORE_1/FLOAD_1" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-1) (function.constant /.fload-1)] test)) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-1) (function.constant /.fload-1)] test)) (_.lift "FSTORE_2/FLOAD_2" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-2) (function.constant /.fload-2)] test)) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-2) (function.constant /.fload-2)] test)) (_.lift "FSTORE_3/FLOAD_3" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-3) (function.constant /.fload-3)] test)) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-3) (function.constant /.fload-3)] test)) (_.lift "FSTORE/FLOAD" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [/.fstore /.fload] test))))) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [/.fstore /.fload] test))))) (<| (_.context "double") (let [test (!::= java/lang/Double "jvm deq" "jvm double =")] ($_ _.and |