diff options
Diffstat (limited to '')
33 files changed, 928 insertions, 530 deletions
diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux index dce3017f5..88dc6a96f 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm.lux @@ -135,7 +135,8 @@ (-> Library java/lang/ClassLoader Definition (Try Any)) (io.run (do (try.with io.monad) [existing-class? (|> (atom.read library) - (\ io.monad map (dictionary.contains? class-name)) + (\ io.monad map (function (_ library) + (dictionary.key? library class-name))) (try.lift io.monad) (: (IO (Try Bit)))) _ (if existing-class? diff --git a/stdlib/source/lux/data/number/i64.lux b/stdlib/source/lux/data/number/i64.lux index 249ae9046..8dfec1fc7 100644 --- a/stdlib/source/lux/data/number/i64.lux +++ b/stdlib/source/lux/data/number/i64.lux @@ -25,9 +25,9 @@ (All [s] (-> <parameter-type> (I64 s) (I64 s))) (<op> parameter subject))] - [(I64 Any) and "lux i64 and" "Bitwise and."] [(I64 Any) or "lux i64 or" "Bitwise or."] [(I64 Any) xor "lux i64 xor" "Bitwise xor."] + [(I64 Any) and "lux i64 and" "Bitwise and."] [Nat left-shift "lux i64 left-shift" "Bitwise left-shift."] [Nat logic-right-shift "lux i64 logical-right-shift" "Unsigned bitwise logic-right-shift."] @@ -37,7 +37,7 @@ (def: #export not {#.doc "Bitwise negation."} (All [s] (-> (I64 s) (I64 s))) - (xor (:coerce I64 -1))) + (xor (.i64 (dec 0)))) (type: #export Mask I64) @@ -64,7 +64,7 @@ (def: #export sign Mask - (..bit 63)) + (..bit (dec ..width))) (def: (add-shift shift value) (-> Nat Nat Nat) @@ -102,6 +102,10 @@ (-> Nat (I64 Any) Bit) (|> input (:coerce I64) (..and (..bit idx)) (n.= 0) .not)) +(def: #export (clear? idx input) + (-> Nat (I64 Any) Bit) + (.not (..set? idx input))) + (template [<name> <main> <comp>] [(def: #export (<name> distance input) (All [s] (-> Nat (I64 s) (I64 s))) @@ -115,8 +119,8 @@ ) (def: #export (region size offset) - (-> Nat Nat I64) - (|> 1 (:coerce I64) (left-shift size) dec (left-shift offset))) + (-> Nat Nat Mask) + (..left-shift offset (..mask size))) (structure: #export equivalence (All [a] (Equivalence (I64 a))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 3334e29be..4f8ce6736 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1420,7 +1420,7 @@ (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (cond (or never-null? - (dictionary.contains? unboxed ..boxes)) + (dictionary.key? ..boxes unboxed)) return-term (get@ #import-member-maybe? commons) diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index 43614dce3..bc089eeaa 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -5,7 +5,7 @@ ["." monad (#+ do)]] [control ["." try (#+ Try)] - ["ex" exception (#+ exception:)]] + ["." exception (#+ exception:)]] [data [binary (#+ Binary)] ["." product] @@ -27,17 +27,17 @@ [program (#+ Program)] ["#." version] ["#." syntax (#+ Aliases)] - ["#." analysis - [macro (#+ Expander)] - ["#/." evaluation]] ["#." synthesis] ["#." directive (#+ Requirements)] ["#." generation] + ["#." analysis + [macro (#+ Expander)] + ["#/." evaluation]] [phase - [".P" analysis - ["." module]] [".P" synthesis] [".P" directive] + [".P" analysis + ["." module]] ["." extension (#+ Extender) [".E" analysis] [".E" synthesis] @@ -201,9 +201,9 @@ (#try.Success [state (#.Some source&requirements&buffer)]) (#try.Failure error) - (if (ex.match? ///syntax.end-of-file error) + (if (exception.match? ///syntax.end-of-file error) (#try.Success [state #.None]) - (ex.with ///.cannot-compile module (#try.Failure error))))))) + (exception.with ///.cannot-compile module (#try.Failure error))))))) (def: (default-dependencies prelude input) (-> Module ///.Input (List Module)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux index 3d71e7c51..482ae99bb 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux @@ -3,7 +3,7 @@ [abstract [monad (#+ do)]] [control - ["ex" exception (#+ exception:)]] + ["." exception (#+ exception:)]] [data [text ["%" format (#+ format)]]] @@ -28,7 +28,7 @@ [archive (#+ Archive)]]]]]]) (exception: #export (unrecognized-syntax {code Code}) - (ex.report ["Code" (%.code code)])) + (exception.report ["Code" (%.code code)])) ## TODO: Had to split the 'compile' function due to compilation issues ## with old-luxc. Must re-combine all the code ASAP diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux index a306b178b..49ba590f1 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -320,7 +320,7 @@ [key (///extension.lift (meta.normalize key))] (case (dictionary.get key tag->idx) (#.Some idx) - (if (dictionary.contains? idx idx->val) + (if (dictionary.key? idx->val idx) (/.throw ..cannot-repeat-tag [key record]) (wrap (dictionary.put idx val idx->val))) 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 c6899c4e8..19cb9b946 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 @@ -513,7 +513,7 @@ (-> .Type (Operation External)) (do {! phase.monad} [name (\ ! map ..reflection (check-jvm objectT))] - (if (dictionary.contains? name ..boxes) + (if (dictionary.key? ..boxes name) (/////analysis.throw ..primitives-are-not-objects [name]) (phase\wrap name)))) @@ -891,9 +891,9 @@ ## else (do ! [_ (phase.assert ..primitives-are-not-objects [from-name] - (not (dictionary.contains? from-name ..boxes))) + (not (dictionary.key? ..boxes from-name))) _ (phase.assert ..primitives-are-not-objects [to-name] - (not (dictionary.contains? to-name ..boxes))) + (not (dictionary.key? ..boxes to-name))) to-class (phase.lift (reflection!.load to-name)) _ (if (text\= ..inheritance-relationship-type-name from-name) (wrap []) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux index c87f00333..96c39d8cb 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux @@ -124,7 +124,8 @@ (-> Library java/lang/ClassLoader Text Definition (Try Any)) (io.run (do (try.with io.monad) [existing-class? (|> (atom.read library) - (\ io.monad map (dictionary.contains? class-name)) + (\ io.monad map (function (_ library) + (dictionary.key? library class-name))) (try.lift io.monad) (: (IO (Try Bit)))) _ (if existing-class? diff --git a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux index 55bde3869..345b46c14 100644 --- a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux +++ b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux @@ -64,7 +64,7 @@ (wrap (list\fold set.union parents ancestors))))) ancestry (memo.open memo)] (list\fold (function (_ module memory) - (if (dictionary.contains? module memory) + (if (dictionary.key? memory module) memory (let [[memory _] (ancestry [memory module])] memory))) diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux index e2c046449..91fbe9cb4 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux @@ -371,8 +371,7 @@ Purge) (list\fold (function (_ [module-name [module-id [descriptor document]]] purge) (let [purged? (: (Predicate Module) - (function (_ module) - (dictionary.contains? module purge)))] + (dictionary.key? purge))] (if (purged? module-name) purge (if (|> descriptor @@ -417,7 +416,7 @@ (monad.map ! (..purge! system static))) loaded-caches (|> load-order (list.filter (function (_ [module-name [module-id [descriptor document]]]) - (not (dictionary.contains? module-name purge)))) + (not (dictionary.key? purge module-name)))) (monad.map ! (function (_ [module-name [module-id descriptor,document]]) (do ! [[descriptor,document bundles] (..load-definitions system static module-id host-environment descriptor,document)] diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index 7d68ced07..8c074c4d8 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -115,8 +115,8 @@ @.jvm (as-is <jvm>)})) (def: #export (write-line message console) - (All [!] (-> Text (Console !) (! Any))) - (!.use (\ console write) (format message text.new-line))) + (All [!] (-> Text (Console !) (! (Try Any)))) + (!.use (\ console write) [(format message text.new-line)])) (signature: #export (Simulation s) (: (-> s (Try [s Char])) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 2478b4016..06b75afd5 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -33,6 +33,7 @@ [world ["." environment (#+ Environment)] ["." shell (#+ Shell)] + ["." console (#+ Console)] ["." file (#+ Path) ["." watch]]]] ["." / #_ @@ -64,15 +65,16 @@ set.to-list (list\map (|>> /repository.remote /repository.async)))) -(def: (with-dependencies command profile) +(def: (with-dependencies console command profile) (All [a] - (-> (-> Environment (file.System Promise) (Shell Promise) Resolution (Command a)) + (-> (Console Promise) + (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command a)) (Command a))) (do promise.monad [environment (promise.future environment.read)] (do /action.monad - [resolution (/command/deps.do! (file.async file.default) (..repositories profile) profile)] - ((command environment (file.async file.default) (shell.async shell.default) resolution) profile)))) + [resolution (/command/deps.do! console (file.async file.default) (..repositories profile) profile)] + ((command console environment (file.async file.default) (shell.async shell.default) resolution) profile)))) (exception: (cannot-find-repository {repository Text} {options (Dictionary Text Address)}) @@ -84,66 +86,70 @@ (program: [{[profile operation] /cli.command}] (do {! io.monad} - [?profile (/input.read io.monad file.default profile)] - (case ?profile - (#try.Success profile) - (case operation - #/cli.Version - (exec (/command/version.do! profile) - (wrap [])) - - #/cli.Clean - (exec (/command/clean.do! (file.async file.default) profile) - (wrap [])) + [?profile (/input.read io.monad file.default profile) + ?console console.default] + (case [?profile ?console] + [(#try.Success profile) (#try.Success console)] + (let [console (console.async console)] + (case operation + #/cli.Version + (exec (/command/version.do! console profile) + (wrap [])) + + #/cli.Clean + (exec (/command/clean.do! console (file.async file.default) profile) + (wrap [])) - #/cli.POM - (exec (/command/pom.do! (file.async file.default) profile) - (wrap [])) - - #/cli.Install - (exec (/command/install.do! (file.async file.default) profile) - (wrap [])) + #/cli.POM + (exec (/command/pom.do! console (file.async file.default) profile) + (wrap [])) + + #/cli.Install + (exec (/command/install.do! console (file.async file.default) profile) + (wrap [])) - (#/cli.Deploy repository identity) - (exec (case [(get@ #/.identity profile) - (dictionary.get repository (get@ #/.deploy-repositories profile))] - [(#.Some artifact) (#.Some repository)] - (/command/deploy.do! (/repository.async (/repository.remote repository)) - (file.async file.default) - identity - artifact - profile) + (#/cli.Deploy repository identity) + (exec (case [(get@ #/.identity profile) + (dictionary.get repository (get@ #/.deploy-repositories profile))] + [(#.Some artifact) (#.Some repository)] + (/command/deploy.do! console + (/repository.async (/repository.remote repository)) + (file.async file.default) + identity + artifact + profile) - [#.None _] - (promise\wrap (exception.throw /.no-identity [])) + [#.None _] + (promise\wrap (exception.throw /.no-identity [])) - [_ #.None] - (promise\wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)]))) - (wrap [])) - - #/cli.Dependencies - (exec (/command/deps.do! (file.async file.default) (..repositories profile) profile) - (wrap [])) + [_ #.None] + (promise\wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)]))) + (wrap [])) + + #/cli.Dependencies + (exec (/command/deps.do! console (file.async file.default) (..repositories profile) profile) + (wrap [])) - (#/cli.Compilation compilation) - (case compilation - #/cli.Build (exec (..with-dependencies /command/build.do! profile) - (wrap [])) - #/cli.Test (exec (..with-dependencies /command/test.do! profile) - (wrap []))) + (#/cli.Compilation compilation) + (case compilation + #/cli.Build (exec (..with-dependencies console /command/build.do! profile) + (wrap [])) + #/cli.Test (exec (..with-dependencies console /command/test.do! profile) + (wrap []))) - (#/cli.Auto auto) - (do ! - [?watcher watch.default] - (case ?watcher - (#try.Failure error) - (wrap (log! error)) - - (#try.Success watcher) - (exec (case auto - #/cli.Build (..with-dependencies (/command/auto.do! watcher /command/build.do!) profile) - #/cli.Test (..with-dependencies (/command/auto.do! watcher /command/test.do!) profile)) - (wrap []))))) + (#/cli.Auto auto) + (do ! + [?watcher watch.default] + (case ?watcher + (#try.Failure error) + (wrap (log! error)) + + (#try.Success watcher) + (exec (case auto + #/cli.Build (..with-dependencies console (/command/auto.do! watcher /command/build.do!) profile) + #/cli.Test (..with-dependencies console (/command/auto.do! watcher /command/test.do!) profile)) + (wrap [])))))) - (#try.Failure error) + (^or [(#try.Failure error) _] + [_ (#try.Failure error)]) (wrap (log! error))))) diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux index c2df31df5..33115c2e4 100644 --- a/stdlib/source/program/aedifex/command/auto.lux +++ b/stdlib/source/program/aedifex/command/auto.lux @@ -15,6 +15,7 @@ [world [environment (#+ Environment)] [shell (#+ Shell)] + ["." console (#+ Console)] ["." file (#+ Path) ["." watch (#+ Watcher)]]]] ["." // #_ @@ -48,11 +49,11 @@ (def: #export (do! watcher command) (All [a] (-> (Watcher Promise) - (-> Environment (file.System Promise) (Shell Promise) Resolution (Command a)) - (-> Environment (file.System Promise) (Shell Promise) Resolution (Command Any)))) - (function (_ environment fs shell resolution) + (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command a)) + (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command Any)))) + (function (_ console environment fs shell resolution) (function (_ profile) - (with-expansions [<call> ((command environment fs shell resolution) profile)] + (with-expansions [<call> ((command console environment fs shell resolution) profile)] (do {! promise.monad} [targets (|> profile (get@ #///.sources) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index 85210fd36..be20d2e29 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -24,7 +24,8 @@ [world [environment (#+ Environment)] ["." file (#+ Path)] - ["." shell (#+ Shell)]]] + ["." shell (#+ Shell)] + ["." console (#+ Console)]]] ["." /// #_ ["#" profile] ["#." action] @@ -118,8 +119,12 @@ (-> Text (List Text) (List Text)) (|>> (list\map (|>> (list name))) list.concat)) -(def: #export (do! environment fs shell resolution profile) - (-> Environment (file.System Promise) (Shell Promise) Resolution (Command [Compiler Path])) +(def: #export start "[BUILD STARTED]") +(def: #export success "[BUILD ENDED]") +(def: #export failure "[BUILD FAILED]") + +(def: #export (do! console environment fs shell resolution profile) + (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command [Compiler Path])) (case [(get@ #///.program profile) (get@ #///.target profile)] [#.None _] @@ -140,7 +145,7 @@ [(format compiler " build") output]) / (\ fs separator) cache-directory (format working-directory / target)] - #let [_ (log! "[BUILD STARTED]")] + _ (console.write-line ..start console) process (!.use (\ shell execute) [environment working-directory @@ -150,8 +155,9 @@ (..singular "--target" cache-directory) (..singular "--module" program)))]) exit (!.use (\ process await) []) - #let [_ (log! (if (i.= shell.normal exit) - "[BUILD ENDED]" - "[BUILD FAILED]"))]] + _ (console.write-line (if (i.= shell.normal exit) + ..success + ..failure) + console)] (wrap [compiler (format cache-directory / output)])))) diff --git a/stdlib/source/program/aedifex/command/clean.lux b/stdlib/source/program/aedifex/command/clean.lux index 618125a89..7f942fc00 100644 --- a/stdlib/source/program/aedifex/command/clean.lux +++ b/stdlib/source/program/aedifex/command/clean.lux @@ -9,7 +9,8 @@ [concurrency ["." promise (#+ Promise)]]] [world - ["." file (#+ Path File Directory)]]] + ["." file (#+ Path File Directory)] + ["." console (#+ Console)]]] ["." /// #_ [command (#+ Command)] ["#" profile] @@ -25,8 +26,14 @@ nodes)] (wrap []))) -(def: #export (do! fs profile) - (-> (file.System Promise) (Command Any)) +(def: #export success + "Success") + +(def: #export failure + "Failure: No 'target' defined for clean-up.") + +(def: #export (do! console fs profile) + (-> (Console Promise) (file.System Promise) (Command Any)) (case (get@ #///.target profile) (#.Some target) (do {! ///action.monad} @@ -39,9 +46,7 @@ (!.use (\ root directories) [])) _ (monad.map ! recur subs)] (!.use (\ root discard) [])))] - (exec (log! "No 'target' defined for clean-up.") - (wrap []))) + (console.write-line ..success console)) #.None - (exec (log! "No 'target' defined for clean-up.") - (\ ///action.monad wrap [])))) + (console.write-line ..failure console))) diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index 1f5ccc441..dbe4a88cb 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -16,22 +16,25 @@ ["." tar] ["." xml]]] [world - ["." file]]] + ["." file] + ["." console (#+ Console)]]] [program [compositor ["." export]]] - ["." /// #_ - [repository (#+ Identity Repository)] - [command (#+ Command)] - ["/" profile] - ["#." action (#+ Action)] - ["#." pom] - ["#." hash] - ["#." artifact (#+ Artifact) - ["#/." extension (#+ Extension)]]]) + ["." // #_ + ["#." clean] + ["/#" // #_ + [repository (#+ Identity Repository)] + [command (#+ Command)] + ["/" profile] + ["#." action (#+ Action)] + ["#." pom] + ["#." hash] + ["#." artifact (#+ Artifact) + ["#/." extension (#+ Extension)]]]]) -(def: #export (do! repository fs identity artifact profile) - (-> (Repository Promise) (file.System Promise) Identity Artifact (Command Any)) +(def: #export (do! console repository fs identity artifact profile) + (-> (Console Promise) (Repository Promise) (file.System Promise) Identity Artifact (Command Any)) (let [deploy! (: (-> Extension Binary (Action Any)) (\ repository upload identity artifact))] (do {! ///action.monad} @@ -44,6 +47,5 @@ _ (deploy! ///artifact/extension.pom (|> pom (\ xml.codec encode) encoding.to-utf8)) _ (deploy! ///artifact/extension.lux-library library) _ (deploy! ///artifact/extension.sha-1 (///hash.data (///hash.sha-1 library))) - _ (deploy! ///artifact/extension.md5 (///hash.data (///hash.md5 library))) - #let [_ (log! "Successfully deployed!")]] - (wrap [])))) + _ (deploy! ///artifact/extension.md5 (///hash.data (///hash.md5 library)))] + (console.write-line //clean.success console)))) diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux index dfe58d707..67dc19e47 100644 --- a/stdlib/source/program/aedifex/command/deps.lux +++ b/stdlib/source/program/aedifex/command/deps.lux @@ -9,23 +9,26 @@ [collection ["." set (#+ Set)]]] [world - ["." file]]] - ["." /// #_ - [command (#+ Command)] - [artifact (#+ Artifact)] - [repository (#+ Repository)] - ["#" profile] - ["#." action (#+ Action)] - ["#." cache] - ["#." dependency #_ - ["#/." resolution (#+ Resolution)]]]) + ["." file] + ["." console (#+ Console)]]] + ["." // #_ + ["#." clean] + ["/#" // #_ + [command (#+ Command)] + [artifact (#+ Artifact)] + [repository (#+ Repository)] + ["#" profile] + ["#." action (#+ Action)] + ["#." cache] + ["#." dependency #_ + ["#/." resolution (#+ Resolution)]]]]) -(def: #export (do! fs repositories profile) - (-> (file.System Promise) (List (Repository Promise)) (Command Resolution)) +(def: #export (do! console fs repositories profile) + (-> (Console Promise) (file.System Promise) (List (Repository Promise)) (Command Resolution)) (do ///action.monad [#let [dependencies (set.to-list (get@ #///.dependencies profile))] cache (///cache.read-all fs dependencies ///dependency/resolution.empty) resolution (///dependency/resolution.all repositories dependencies cache) cached (///cache.write-all fs resolution) - #let [_ (log! "Successfully resolved dependencies!")]] + _ (console.write-line //clean.success console)] (wrap resolution))) diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux index b152bc66c..327a0c119 100644 --- a/stdlib/source/program/aedifex/command/install.lux +++ b/stdlib/source/program/aedifex/command/install.lux @@ -21,18 +21,21 @@ ["." tar] ["." xml]]] [world - ["." file (#+ Path File)]]] + ["." file (#+ Path File)] + ["." console (#+ Console)]]] [program [compositor ["." export]]] - ["." /// #_ - ["/" profile (#+ Profile)] - ["#." action (#+ Action)] - ["#." command (#+ Command)] - ["#." local] - ["#." pom] - ["#." artifact (#+ Artifact) - ["#/." extension]]]) + ["." // #_ + ["#." clean] + ["/#" // #_ + ["/" profile (#+ Profile)] + ["#." action (#+ Action)] + ["#." command (#+ Command)] + ["#." local] + ["#." pom] + ["#." artifact (#+ Artifact) + ["#/." extension]]]]) (def: (save! system content file) (-> (file.System Promise) Binary Path (Promise (Try Any))) @@ -41,8 +44,11 @@ (file.get-file promise.monad system file))] (!.use (\ file over-write) [content]))) -(def: #export (do! system profile) - (-> (file.System Promise) (Command Any)) +(def: #export failure + "Failure: No 'identity' defined for the project.") + +(def: #export (do! console system profile) + (-> (Console Promise) (file.System Promise) (Command Any)) (case (get@ #/.identity profile) (#.Some identity) (do ///action.monad @@ -54,9 +60,8 @@ (format artifact-name ///artifact/extension.lux-library)) pom (\ promise.monad wrap (///pom.write profile)) _ (..save! system (|> pom (\ xml.codec encode) encoding.to-utf8) - (format artifact-name ///artifact/extension.pom)) - #let [_ (log! "Successfully installed locally!")]] - (wrap [])) + (format artifact-name ///artifact/extension.pom))] + (console.write-line //clean.success console)) _ - (\ promise.monad wrap (exception.throw /.no-identity [])))) + (console.write-line ..failure console))) diff --git a/stdlib/source/program/aedifex/command/pom.lux b/stdlib/source/program/aedifex/command/pom.lux index 28bd23921..cf07ad0e0 100644 --- a/stdlib/source/program/aedifex/command/pom.lux +++ b/stdlib/source/program/aedifex/command/pom.lux @@ -15,14 +15,17 @@ [format ["." xml]]] [world - ["." file (#+ Path File)]]] - ["." /// #_ - [command (#+ Command)] - ["#." action (#+ Action)] - ["#." pom]]) + ["." file (#+ Path File)] + ["." console (#+ Console)]]] + ["." // #_ + ["#." clean] + ["/#" // #_ + [command (#+ Command)] + ["#." action (#+ Action)] + ["#." pom]]]) -(def: #export (do! fs profile) - (-> (file.System Promise) (Command Path)) +(def: #export (do! console fs profile) + (-> (Console Promise) (file.System Promise) (Command Path)) (do ///action.monad [pom (promise\wrap (///pom.write profile)) file (: (Promise (Try (File Promise))) @@ -31,5 +34,5 @@ (\ xml.codec encode) encoding.to-utf8 (!.use (\ file over-write))) - #let [_ (log! "Successfully wrote POM file!")]] + _ (console.write-line //clean.success console)] (wrap ///pom.file))) diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index 5c205b7b8..93c705be1 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -15,7 +15,8 @@ [world [environment (#+ Environment)] ["." file] - ["." shell (#+ Shell)]]] + ["." shell (#+ Shell)] + ["." console (#+ Console)]]] ["." // #_ ["#." build] ["/#" // #_ @@ -25,12 +26,16 @@ [dependency [resolution (#+ Resolution)]]]]) -(def: #export (do! environment fs shell resolution profile) - (-> Environment (file.System Promise) (Shell Promise) Resolution (Command Any)) +(def: #export start "[TEST STARTED]") +(def: #export success "[TEST ENDED]") +(def: #export failure "[TEST FAILED]") + +(def: #export (do! console environment fs shell resolution profile) + (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command Any)) (do ///action.monad - [[compiler program] (//build.do! environment fs shell resolution profile) + [[compiler program] (//build.do! console environment fs shell resolution profile) working-directory (promise\wrap (//build.working-directory environment)) - #let [_ (log! "[TEST STARTED]")] + _ (console.write-line ..start console) process (!.use (\ shell execute) [environment working-directory @@ -39,7 +44,8 @@ (#//build.JS artifact) (///runtime.node program)) (list)]) exit (!.use (\ process await) []) - #let [_ (log! (if (i.= shell.normal exit) - "[TEST ENDED]" - "[TEST FAILED]"))]] + _ (console.write-line (if (i.= shell.normal exit) + ..success + ..failure) + console)] (wrap []))) diff --git a/stdlib/source/program/aedifex/command/version.lux b/stdlib/source/program/aedifex/command/version.lux index 8f26a7fb7..076d2a71d 100644 --- a/stdlib/source/program/aedifex/command/version.lux +++ b/stdlib/source/program/aedifex/command/version.lux @@ -1,16 +1,20 @@ (.module: [lux #* + [control + [concurrency + ["." promise (#+ Promise)]]] [tool [compiler ["." version] ["." language #_ ["#/." lux #_ - ["#" version]]]]]] - ["." /// #_ - [command (#+ Command)] - ["#." action]]) + ["#" version]]]]] + [world + ["." console (#+ Console)]]] + [/// + [command (#+ Command)]]) -(def: #export (do! profile) - (Command Any) - (\ ///action.monad wrap - (log! (version.format language/lux.version)))) +(def: #export (do! console profile) + (-> (Console Promise) (Command Any)) + (console.write-line (version.format language/lux.version) + console)) diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/program/compositor/import.lux index 318c3705c..edc0160f5 100644 --- a/stdlib/source/program/compositor/import.lux +++ b/stdlib/source/program/compositor/import.lux @@ -1,5 +1,5 @@ (.module: - [lux #* + [lux (#- Module) [abstract ["." monad (#+ Monad do)]] [control @@ -13,12 +13,18 @@ ["<b>" binary]]] [data [binary (#+ Binary)] - ["." text] + ["." text + ["%" format (#+ format)]] [collection ["." dictionary (#+ Dictionary)] ["." row]] [format ["." tar]]] + [tool + [compiler + [meta + [archive + [descriptor (#+ Module)]]]]] [world ["." file (#+ Path File)]]] [// @@ -29,6 +35,11 @@ (exception: #export useless-tar-entry) +(exception: #export (duplicate {library Library} {module Module}) + (exception.report + ["Module" (%.text module)] + ["Library" (%.text library)])) + (type: #export Import (Dictionary Path Binary)) @@ -44,9 +55,13 @@ (monad.fold ! (function (_ entry import) (case entry (#tar.Normal [path instant mode ownership content]) - (dictionary.try-put (tar.from-path path) - (tar.data content) - import) + (let [path (tar.from-path path)] + (case (dictionary.try-put path (tar.data content) import) + (#try.Success import) + (wrap import) + + (#try.Failure error) + (exception.throw ..duplicate [library path]))) _ (exception.throw ..useless-tar-entry []))) diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index 5fad232b1..aa1b8ebe8 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -25,11 +25,15 @@ ["." random]] [world [environment (#+ Environment)] + [console (#+ Console)] ["." shell (#+ Shell)] ["." file (#+ Path) ["." watch]]]] - ["$." /// #_ - ["#." package]] + ["." // #_ + ["@." version] + ["@." build] + ["$/#" // #_ + ["#." package]]] {#program ["." / ["/#" // #_ @@ -46,11 +50,11 @@ (def: (command end-signal dummy-files) (-> Text (List Path) [(Atom [Nat (List Path)]) - (-> Environment (file.System Promise) (Shell Promise) Resolution (Command Any))]) + (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command Any))]) (let [@runs (: (Atom [Nat (List Path)]) (atom.atom [0 dummy-files]))] [@runs - (function (_ environment fs shell resolution profile) + (function (_ console environment fs shell resolution profile) (do {! promise.monad} [[runs remaining-files] (promise.future (atom.update (function (_ [runs remaining-files]) @@ -72,23 +76,7 @@ (<| (_.covering /._) (do {! random.monad} [#let [/ (\ file.default separator) - [fs watcher] (watch.mock /) - shell (shell.mock - (function (_ [actual-environment actual-working-directory actual-command actual-arguments]) - (#try.Success - (: (shell.Simulation []) - (structure - (def: (on-read state) - (#try.Failure "on-read")) - (def: (on-error state) - (#try.Failure "on-error")) - (def: (on-write input state) - (#try.Failure "on-write")) - (def: (on-destroy state) - (#try.Failure "on-destroy")) - (def: (on-await state) - (#try.Success [state shell.normal])))))) - [])] + [fs watcher] (watch.mock /)] end-signal (random.ascii/alpha 5) program (random.ascii/alpha 5) target (random.ascii/alpha 5) @@ -110,38 +98,24 @@ with-target (set@ #///.sources (set.from-list text.hash (list source)))) - environment (dictionary.put "user.dir" working-directory environment.empty)]] + environment (dictionary.put "user.dir" working-directory environment.empty)] + resolution @build.resolution] ($_ _.and - (do ! - [lux-version (random.ascii/alpha 5) - [_ compiler-package] $///package.random - #let [jvm-compiler {#///dependency.artifact {#///artifact.group //build.lux-group - #///artifact.name //build.jvm-compiler-name - #///artifact.version lux-version} - #///dependency.type ///artifact/type.lux-library} - js-compiler {#///dependency.artifact {#///artifact.group //build.lux-group - #///artifact.name //build.js-compiler-name - #///artifact.version lux-version} - #///dependency.type ///artifact/type.lux-library}] - compiler-dependency (random.either (wrap jvm-compiler) - (wrap js-compiler)) - #let [[@runs command] (..command end-signal dummy-files)]] - (wrap (do promise.monad - [verdict (do ///action.monad - [_ (!.use (\ fs create-directory) [source]) - _ (\ watcher poll []) - #let [resolution (|> ///dependency/resolution.empty - (dictionary.put compiler-dependency compiler-package))]] - (do promise.monad - [outcome ((/.do! watcher command) environment fs shell resolution profile) - [actual-runs _] (promise.future (atom.read @runs))] - (wrap (#try.Success (and (n.= expected-runs actual-runs) - (case outcome - (#try.Failure error) - (is? end-signal error) + (wrap (do promise.monad + [verdict (do ///action.monad + [#let [[@runs command] (..command end-signal dummy-files)] + _ (!.use (\ fs create-directory) [source]) + _ (\ watcher poll [])] + (do promise.monad + [outcome ((/.do! watcher command) (@version.echo "") environment fs (@build.good-shell []) resolution profile) + [actual-runs _] (promise.future (atom.read @runs))] + (wrap (#try.Success (and (n.= expected-runs actual-runs) + (case outcome + (#try.Failure error) + (is? end-signal error) - (#try.Success _) - false))))))] - (_.cover' [/.do!] - (try.default false verdict))))) + (#try.Success _) + false))))))] + (_.cover' [/.do!] + (try.default false verdict)))) )))) diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 3b1802440..6a911e928 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -7,19 +7,24 @@ ["." try] ["." exception] [concurrency - ["." promise]] + ["." promise (#+ Promise)]] [parser - ["." environment]]] + ["." environment]] + [security + ["!" capability]]] [data + ["." text ("#\." equivalence)] [collection ["." dictionary]]] [math ["." random]] [world ["." file] - ["." shell]]] - ["$." /// #_ - ["#." package]] + ["." shell (#+ Shell)]]] + ["." // #_ + ["@." version] + ["$/#" // #_ + ["#." package]]] {#program ["." / ["//#" /// #_ @@ -30,27 +35,69 @@ ["#." dependency ["#/." resolution]]]]}) +(def: #export good-shell + (-> Any (Shell Promise)) + (shell.mock + (function (_ [actual-environment actual-working-directory actual-command actual-arguments]) + (#try.Success + (: (shell.Simulation []) + (structure + (def: (on-read state) + (#try.Failure "on-read")) + (def: (on-error state) + (#try.Failure "on-error")) + (def: (on-write input state) + (#try.Failure "on-write")) + (def: (on-destroy state) + (#try.Failure "on-destroy")) + (def: (on-await state) + (#try.Success [state shell.normal])))))))) + +(def: #export bad-shell + (-> Any (Shell Promise)) + (shell.mock + (function (_ [actual-environment actual-working-directory actual-command actual-arguments]) + (#try.Success + (: (shell.Simulation []) + (structure + (def: (on-read state) + (#try.Failure "on-read")) + (def: (on-error state) + (#try.Failure "on-error")) + (def: (on-write input state) + (#try.Failure "on-write")) + (def: (on-destroy state) + (#try.Failure "on-destroy")) + (def: (on-await state) + (#try.Success [state shell.error])))))))) + +(def: compiler + (do random.monad + [lux-version (random.ascii/alpha 5) + #let [jvm-compiler {#///dependency.artifact {#///artifact.group /.lux-group + #///artifact.name /.jvm-compiler-name + #///artifact.version lux-version} + #///dependency.type ///artifact/type.lux-library} + js-compiler {#///dependency.artifact {#///artifact.group /.lux-group + #///artifact.name /.js-compiler-name + #///artifact.version lux-version} + #///dependency.type ///artifact/type.lux-library}]] + (random.either (wrap jvm-compiler) + (wrap js-compiler)))) + +(def: #export resolution + (do random.monad + [dependency ..compiler + [_ package] $///package.random] + (wrap (|> ///dependency/resolution.empty + (dictionary.put dependency package))))) + (def: #export test Test (<| (_.covering /._) (do {! random.monad} [#let [fs (file.mock (\ file.default separator)) - shell (shell.mock - (function (_ [actual-environment actual-working-directory actual-command actual-arguments]) - (#try.Success - (: (shell.Simulation []) - (structure - (def: (on-read state) - (#try.Failure "on-read")) - (def: (on-error state) - (#try.Failure "on-error")) - (def: (on-write input state) - (#try.Failure "on-write")) - (def: (on-destroy state) - (#try.Failure "on-destroy")) - (def: (on-await state) - (#try.Success [state shell.normal])))))) - [])] + shell (..good-shell [])] program (random.ascii/alpha 5) target (random.ascii/alpha 5) working-directory (random.ascii/alpha 5) @@ -83,7 +130,7 @@ (#try.Failure error) false))) (wrap (do promise.monad - [outcome (/.do! environment fs shell ///dependency/resolution.empty + [outcome (/.do! (@version.echo "") environment fs shell ///dependency/resolution.empty (with-target empty-profile))] (_.cover' [/.no-specified-program] (case outcome @@ -93,7 +140,7 @@ (#try.Failure error) (exception.match? /.no-specified-program error))))) (wrap (do promise.monad - [outcome (/.do! environment fs shell ///dependency/resolution.empty + [outcome (/.do! (@version.echo "") environment fs shell ///dependency/resolution.empty (with-program empty-profile))] (_.cover' [/.no-specified-target] (case outcome @@ -103,7 +150,7 @@ (#try.Failure error) (exception.match? /.no-specified-target error))))) (wrap (do promise.monad - [outcome (/.do! environment fs shell ///dependency/resolution.empty profile)] + [outcome (/.do! (@version.echo "") environment fs shell ///dependency/resolution.empty profile)] (_.cover' [/.Compiler /.no-available-compiler] (case outcome (#try.Success _) @@ -112,25 +159,29 @@ (#try.Failure error) (exception.match? /.no-available-compiler error))))) (do ! - [lux-version (random.ascii/alpha 5) - [_ compiler-package] $///package.random - #let [jvm-compiler {#///dependency.artifact {#///artifact.group /.lux-group - #///artifact.name /.jvm-compiler-name - #///artifact.version lux-version} - #///dependency.type ///artifact/type.lux-library} - js-compiler {#///dependency.artifact {#///artifact.group /.lux-group - #///artifact.name /.js-compiler-name - #///artifact.version lux-version} - #///dependency.type ///artifact/type.lux-library}] - compiler-dependency (random.either (wrap jvm-compiler) - (wrap js-compiler))] + [#let [console (@version.echo "")] + resolution ..resolution] (wrap (do promise.monad [verdict (do ///action.monad - [#let [resolution (|> ///dependency/resolution.empty - (dictionary.put compiler-dependency compiler-package))] - _ (/.do! environment fs shell resolution profile)] - (wrap true))] + [_ (/.do! console environment fs shell resolution profile) + start (!.use (\ console read-line) []) + end (!.use (\ console read-line) [])] + (wrap (and (text\= /.start start) + (text\= /.success end))))] (_.cover' [/.do! - /.lux-group /.jvm-compiler-name /.js-compiler-name] + /.lux-group /.jvm-compiler-name /.js-compiler-name + /.start /.success] + (try.default false verdict))))) + (do ! + [#let [console (@version.echo "")] + resolution ..resolution] + (wrap (do promise.monad + [verdict (do ///action.monad + [_ (/.do! console environment fs (..bad-shell []) resolution profile) + start (!.use (\ console read-line) []) + end (!.use (\ console read-line) [])] + (wrap (and (text\= /.start start) + (text\= /.failure end))))] + (_.cover' [/.failure] (try.default false verdict))))) )))) diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux index 11570d034..739bd1a34 100644 --- a/stdlib/source/test/aedifex/command/clean.lux +++ b/stdlib/source/test/aedifex/command/clean.lux @@ -12,7 +12,7 @@ [data [binary (#+ Binary)] ["." product] - ["." text + ["." text ("#\." equivalence) ["%" format (#+ format)]] [number ["n" nat]] @@ -23,12 +23,14 @@ ["." random (#+ Random)]] [world ["." file (#+ Path File)]]] - [/// - ["@." profile] + [// + ["@." version] [// - [lux - [data - ["_." binary]]]]] + ["@." profile] + [// + [lux + [data + ["_." binary]]]]]] {#program ["." / ["//#" /// #_ @@ -97,22 +99,35 @@ sub-files (..files (format sub-path /)) dummy @profile.random] - (wrap (do promise.monad - [verdict (do {! (try.with promise.monad)} - [_ (..create-directory! fs target-path direct-files) - _ (..create-directory! fs sub-path sub-files) - context-exists!/pre (..directory-exists? fs context) - target-exists!/pre (..assets-exist? fs target-path direct-files) - sub-exists!/pre (..assets-exist? fs sub-path sub-files) - _ (/.do! fs (set@ #///.target (#.Some target-path) dummy)) - context-exists!/post (..directory-exists? fs context) - target-exists!/post (..assets-exist? fs target-path direct-files) - sub-exists!/post (..assets-exist? fs sub-path sub-files)] - (wrap (and (and context-exists!/pre - context-exists!/post) - (and target-exists!/pre - (not target-exists!/post)) - (and sub-exists!/pre - (not sub-exists!/post)))))] - (_.cover' [/.do!] - (try.default false verdict))))))) + ($_ _.and + (wrap (do promise.monad + [#let [console (@version.echo "")] + verdict (do {! (try.with promise.monad)} + [_ (/.do! console fs (set@ #///.target #.None dummy))] + (\ ! map (text\= /.failure) + (!.use (\ console read-line) [])))] + (_.cover' [/.failure] + (try.default false verdict)))) + (wrap (do promise.monad + [#let [console (@version.echo "")] + verdict (do {! (try.with promise.monad)} + [_ (..create-directory! fs target-path direct-files) + _ (..create-directory! fs sub-path sub-files) + context-exists!/pre (..directory-exists? fs context) + target-exists!/pre (..assets-exist? fs target-path direct-files) + sub-exists!/pre (..assets-exist? fs sub-path sub-files) + _ (/.do! console fs (set@ #///.target (#.Some target-path) dummy)) + context-exists!/post (..directory-exists? fs context) + target-exists!/post (..assets-exist? fs target-path direct-files) + sub-exists!/post (..assets-exist? fs sub-path sub-files) + logging (!.use (\ console read-line) [])] + (wrap (and (and context-exists!/pre + context-exists!/post) + (and target-exists!/pre + (not target-exists!/post)) + (and sub-exists!/pre + (not sub-exists!/post)) + (text\= /.success logging))))] + (_.cover' [/.do! /.success] + (try.default false verdict)))) + )))) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index 5e4f6615b..773069322 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -30,20 +30,24 @@ [program [compositor ["." export]]] - [/// - ["@." profile] - ["@." repository]] + [// + ["@." version] + [// + ["@." profile] + ["@." repository]]] {#program ["." / - ["//#" /// #_ - ["#" profile] - ["#." action] - ["#." pom] - ["#." local] - ["#." hash] - ["#." repository (#+ Identity Repository)] - ["#." artifact (#+ Artifact) - ["#/." extension]]]]}) + ["/#" // #_ + ["#." clean] + ["/#" // #_ + ["#" profile] + ["#." action] + ["#." pom] + ["#." local] + ["#." hash] + ["#." repository (#+ Identity Repository)] + ["#." artifact (#+ Artifact) + ["#/." extension]]]]]}) (def: (make-sources! fs sources) (-> (file.System Promise) (Set Path) (Promise (Try Any))) @@ -65,12 +69,14 @@ (def: (execute! repository fs identity artifact profile) (-> (Repository Promise) (file.System Promise) Identity Artifact ///.Profile - (Promise (Try Any))) + (Promise (Try Text))) (do ///action.monad - [_ (..make-sources! fs (get@ #///.sources profile)) + [#let [console (@version.echo "")] + _ (..make-sources! fs (get@ #///.sources profile)) _ (: (Promise (Try Path)) - (file.make-directories promise.monad fs (///local.repository fs)))] - (/.do! repository fs identity artifact profile))) + (file.make-directories promise.monad fs (///local.repository fs))) + _ (/.do! console repository fs identity artifact profile)] + (!.use (\ console read-line) []))) (def: #export test Test @@ -90,7 +96,7 @@ fs (file.mock (\ file.default separator))]] (wrap (do {! promise.monad} [verdict (do {! ///action.monad} - [_ (..execute! repository fs identity artifact profile) + [logging (..execute! repository fs identity artifact profile) expected-library (|> profile (get@ #///.sources) set.to-list @@ -121,7 +127,8 @@ (\ binary.equivalence = (///hash.data (///hash.md5 expected-library)) actual-md5)]] - (wrap (and deployed-library! + (wrap (and (text\= //clean.success logging) + deployed-library! deployed-pom! deployed-sha-1! deployed-md5!)))] diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index 2f221a7ce..5b9dd87da 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -7,9 +7,11 @@ [control ["." try] [concurrency - ["." promise]]] + ["." promise]] + [security + ["!" capability]]] [data - [text + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection ["." dictionary] @@ -18,24 +20,28 @@ ["." random (#+ Random)]] [world ["." file]]] - ["$." /// #_ - ["#." package] - ["#." artifact] - ["#." dependency #_ - ["#/." resolution]]] + ["." // #_ + ["@." version] + ["$/#" // #_ + ["#." package] + ["#." artifact] + ["#." dependency #_ + ["#/." resolution]]]] {#program ["." / - ["//#" /// #_ - ["#" profile] - ["#." action] - ["#." pom] - ["#." package] - ["#." cache] - ["#." repository] - ["#." artifact - ["#/." type]] - ["#." dependency - ["#/." resolution]]]]}) + ["/#" // #_ + ["#." clean] + ["/#" // #_ + ["#" profile] + ["#." action] + ["#." pom] + ["#." package] + ["#." cache] + ["#." repository] + ["#." artifact + ["#/." type]] + ["#." dependency + ["#/." resolution]]]]]}) (def: #export test Test @@ -74,13 +80,18 @@ fs (file.mock (\ file.default separator))]] (wrap (do promise.monad [verdict (do ///action.monad - [pre (|> ///dependency/resolution.empty + [#let [console (@version.echo "")] + pre (|> ///dependency/resolution.empty (dictionary.put dependee dependee-package) (///cache.write-all fs)) post (|> (\ ///.monoid identity) (set@ #///.dependencies (set.from-list ///dependency.hash (list dependee depender))) - (/.do! fs (list (///repository.mock ($///dependency/resolution.single depender-artifact depender-package) []))))] - (wrap (and (and (set.member? pre dependee-artifact) + (/.do! console fs (list (///repository.mock ($///dependency/resolution.single depender-artifact depender-package) [])))) + logging! (\ ///action.monad map + (text\= //clean.success) + (!.use (\ console read-line) []))] + (wrap (and logging! + (and (set.member? pre dependee-artifact) (not (set.member? pre depender-artifact))) (and (dictionary.key? post dependee) (dictionary.key? post depender)))))] diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index e858d46d2..2dbddeaa3 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -4,7 +4,7 @@ [abstract ["." monad (#+ do)]] [control - ["." try (#+ Try)] + ["." try (#+ Try) ("#\." functor)] ["." exception] [concurrency ["." promise (#+ Promise)]] @@ -13,7 +13,7 @@ [data ["." maybe] ["." binary] - ["." text + ["." text ("#\." equivalence) ["%" format (#+ format)] ["." encoding]] [format @@ -24,17 +24,22 @@ ["." random (#+ Random)]] [world ["." file (#+ Path File)]]] - [/// - ["@." profile]] + [// + ["@." version] + [// + ["@." profile] + ["@." artifact]]] {#program ["." / - ["//#" /// #_ - ["#" profile] - ["#." action] - ["#." pom] - ["#." local] - ["#." artifact - ["#/." extension]]]]}) + ["/#" // #_ + ["#." clean] + ["/#" // #_ + ["#" profile] + ["#." action] + ["#." pom] + ["#." local] + ["#." artifact + ["#/." extension]]]]]}) (def: (make-sources! fs sources) (-> (file.System Promise) (Set Path) (Promise (Try Any))) @@ -54,48 +59,49 @@ (recur tail))))) (def: (execute! fs sample) - (-> (file.System Promise) ///.Profile (Promise (Try Any))) + (-> (file.System Promise) ///.Profile (Promise (Try Text))) (do ///action.monad - [_ (..make-sources! fs (get@ #///.sources sample)) + [#let [console (@version.echo "")] + _ (..make-sources! fs (get@ #///.sources sample)) _ (: (Promise (Try Path)) - (file.make-directories promise.monad fs (///local.repository fs)))] - (/.do! fs sample))) + (file.make-directories promise.monad fs (///local.repository fs))) + _ (/.do! console fs sample)] + (!.use (\ console read-line) []))) (def: #export test Test (<| (_.covering /._) - (do random.monad - [sample @profile.random - #let [fs (file.mock (\ file.default separator))]] - (wrap (case (get@ #///.identity sample) - (#.Some identity) - (do {! promise.monad} - [verdict (do ///action.monad - [_ (..execute! fs sample) - #let [artifact-path (format (///local.path fs identity) - (\ fs separator) - (///artifact.identity identity)) - library-path (format artifact-path ///artifact/extension.lux-library) - pom-path (format artifact-path ///artifact/extension.pom)] + (do {! random.monad} + [identity @artifact.random + sample (\ ! map (set@ #///.identity (#.Some identity)) + @profile.random)] + ($_ _.and + (wrap (do {! promise.monad} + [#let [fs (file.mock (\ file.default separator))] + verdict (do ///action.monad + [logging (..execute! fs sample) + #let [artifact-path (format (///local.path fs identity) + (\ fs separator) + (///artifact.identity identity)) + library-path (format artifact-path ///artifact/extension.lux-library) + pom-path (format artifact-path ///artifact/extension.pom)] - library-exists! (\ promise.monad map - exception.return - (file.file-exists? promise.monad fs library-path)) - pom-exists! (\ promise.monad map - exception.return - (file.file-exists? promise.monad fs pom-path))] - (wrap (and library-exists! - pom-exists!)))] - (_.cover' [/.do!] - (try.default false verdict))) - - #.None - (do {! promise.monad} - [outcome (..execute! fs sample)] - (_.cover' [/.do!] - (case outcome - (#try.Success _) - false - - (#try.Failure error) - true)))))))) + library-exists! (\ promise.monad map + exception.return + (file.file-exists? promise.monad fs library-path)) + pom-exists! (\ promise.monad map + exception.return + (file.file-exists? promise.monad fs pom-path))] + (wrap (and (text\= //clean.success logging) + library-exists! + pom-exists!)))] + (_.cover' [/.do!] + (try.default false verdict)))) + (wrap (do {! promise.monad} + [#let [fs (file.mock (\ file.default separator))] + logging (..execute! fs (set@ #///.identity #.None sample))] + (_.cover' [/.failure] + (|> logging + (try\map (text\= /.failure)) + (try.default false))))) + )))) diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index 408debea6..d63641e04 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -19,14 +19,18 @@ ["." random (#+ Random)]] [world ["." file (#+ File)]]] - [/// - ["@." profile]] + [// + ["@." version] + [// + ["@." profile]]] {#program ["." / - ["//#" /// #_ - ["#" profile] - ["#." action] - ["#." pom]]]}) + ["/#" // #_ + ["#." clean] + ["/#" // #_ + ["#" profile] + ["#." action] + ["#." pom]]]]}) (def: #export test Test @@ -35,7 +39,8 @@ [sample @profile.random #let [fs (file.mock (\ file.default separator))]] (wrap (do {! promise.monad} - [outcome (/.do! fs sample)] + [#let [console (@version.echo "")] + outcome (/.do! console fs sample)] (case outcome (#try.Success path) (do ! @@ -47,12 +52,17 @@ (file.get-file promise.monad fs path)) actual (!.use (\ file content) []) + logging! (\ ///action.monad map + (text\= //clean.success) + (!.use (\ console read-line) [])) + #let [expected-path! (text\= ///pom.file path) expected-content! (\ binary.equivalence = expected actual)]] - (wrap (and expected-path! + (wrap (and logging! + expected-path! expected-content!)))] (_.cover' [/.do!] (try.default false verdict))) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index 3a4bf9d79..43c70d8ba 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -8,8 +8,11 @@ [concurrency ["." promise]] [parser - ["." environment]]] + ["." environment]] + [security + ["!" capability]]] [data + ["." text ("#\." equivalence)] [collection ["." dictionary]]] [math @@ -17,8 +20,11 @@ [world ["." file] ["." shell]]] - ["$." /// #_ - ["#." package]] + ["." // #_ + ["@." version] + ["@." build] + ["$/#" // #_ + ["#." package]]] {#program ["." / ["/#" // #_ @@ -35,24 +41,7 @@ Test (<| (_.covering /._) (do {! random.monad} - [#let [fs (file.mock (\ file.default separator)) - shell (shell.mock - (function (_ [actual-environment actual-working-directory actual-command actual-arguments]) - (#try.Success - (: (shell.Simulation []) - (structure - (def: (on-read state) - (#try.Failure "on-read")) - (def: (on-error state) - (#try.Failure "on-error")) - (def: (on-write input state) - (#try.Failure "on-write")) - (def: (on-destroy state) - (#try.Failure "on-destroy")) - (def: (on-await state) - (#try.Success [state shell.normal])))))) - [])] - program (random.ascii/alpha 5) + [program (random.ascii/alpha 5) target (random.ascii/alpha 5) working-directory (random.ascii/alpha 5) #let [empty-profile (: Profile @@ -68,27 +57,56 @@ no-working-directory environment.empty - environment (dictionary.put "user.dir" working-directory environment.empty)]] + environment (dictionary.put "user.dir" working-directory environment.empty)] + resolution @build.resolution] ($_ _.and - (do ! - [lux-version (random.ascii/alpha 5) - [_ compiler-package] $///package.random - #let [jvm-compiler {#///dependency.artifact {#///artifact.group //build.lux-group - #///artifact.name //build.jvm-compiler-name - #///artifact.version lux-version} - #///dependency.type ///artifact/type.lux-library} - js-compiler {#///dependency.artifact {#///artifact.group //build.lux-group - #///artifact.name //build.js-compiler-name - #///artifact.version lux-version} - #///dependency.type ///artifact/type.lux-library}] - compiler-dependency (random.either (wrap jvm-compiler) - (wrap js-compiler))] + (let [fs (file.mock (\ file.default separator)) + console (@version.echo "")] (wrap (do promise.monad [verdict (do ///action.monad - [#let [resolution (|> ///dependency/resolution.empty - (dictionary.put compiler-dependency compiler-package))] - _ (/.do! environment fs shell resolution profile)] - (wrap true))] - (_.cover' [/.do!] + [_ (/.do! console environment fs (@build.good-shell []) resolution profile) + build-start (!.use (\ console read-line) []) + build-end (!.use (\ console read-line) []) + test-start (!.use (\ console read-line) []) + test-end (!.use (\ console read-line) [])] + (wrap (and (and (text\= //build.start build-start) + (text\= //build.success build-end)) + (and (text\= /.start test-start) + (text\= /.success test-end)))))] + (_.cover' [/.do! + /.start /.success] + (try.default false verdict))))) + (let [fs (file.mock (\ file.default separator)) + console (@version.echo "")] + (wrap (do promise.monad + [verdict (do ///action.monad + [#let [bad-shell (shell.mock + (function (_ [actual-environment actual-working-directory actual-command actual-arguments]) + (#try.Success + (: (shell.Simulation []) + (structure + (def: (on-read state) + (#try.Failure "on-read")) + (def: (on-error state) + (#try.Failure "on-error")) + (def: (on-write input state) + (#try.Failure "on-write")) + (def: (on-destroy state) + (#try.Failure "on-destroy")) + (def: (on-await state) + (#try.Success [state (if (text.ends-with? " build" actual-command) + shell.normal + shell.error)])))))) + [])] + _ (/.do! console environment fs bad-shell resolution profile) + build-start (!.use (\ console read-line) []) + build-end (!.use (\ console read-line) []) + test-start (!.use (\ console read-line) []) + test-end (!.use (\ console read-line) [])] + (wrap (and (and (text\= //build.start build-start) + (text\= //build.success build-end)) + (and (text\= /.start test-start) + (text\= /.failure test-end)))))] + (_.cover' [/.failure] (try.default false verdict))))) )))) diff --git a/stdlib/source/test/aedifex/command/version.lux b/stdlib/source/test/aedifex/command/version.lux index f6196556d..5e60f6b9b 100644 --- a/stdlib/source/test/aedifex/command/version.lux +++ b/stdlib/source/test/aedifex/command/version.lux @@ -5,23 +5,74 @@ [monad (#+ do)]] [control ["." try] + ["." exception (#+ exception:)] [concurrency - ["." promise]]] + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + ["." maybe] + ["." text ("#\." equivalence) + ["%" format (#+ format)]]] [math - ["." random]]] + ["." random]] + [tool + [compiler + ["." version] + ["." language #_ + ["#/." lux #_ + ["#" version]]]]] + [world + ["." console (#+ Console Simulation)]]] [/// ["@." profile]] {#program ["." /]}) +(exception: #export console-is-closed!) + +(structure: simulation + (Simulation [Bit Text]) + + (def: (on-read [open? state]) + (if open? + (try.from-maybe + (do maybe.monad + [head (text.nth 0 state) + [_ tail] (text.split 1 state)] + (wrap [[open? tail] head]))) + (exception.throw ..console-is-closed! []))) + (def: (on-read-line [open? state]) + (if open? + (try.from-maybe + (do maybe.monad + [[output state] (text.split-with text.new-line state)] + (wrap [[open? state] output]))) + (exception.throw ..console-is-closed! []))) + (def: (on-write input [open? state]) + (if open? + (#try.Success [open? (format state input)]) + (exception.throw ..console-is-closed! []))) + (def: (on-close [open? buffer]) + (if open? + (#try.Success [false buffer]) + (exception.throw ..console-is-closed! [])))) + +(def: #export echo + (-> Text (Console Promise)) + (|>> [true] (console.mock ..simulation))) + (def: #export test Test (<| (_.covering /._) (do random.monad [profile @profile.random] (wrap (do promise.monad - [verdict (do (try.with promise.monad) - [_ (/.do! profile)] - (wrap true))] + [#let [console (..echo "")] + verdict (do (try.with promise.monad) + [_ (/.do! console profile) + logging (!.use (\ console read-line) [])] + (wrap (text\= (version.format language/lux.version) + logging)))] (_.cover' [/.do!] (try.default false verdict))))))) diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux index b9669756d..fd963a3ef 100644 --- a/stdlib/source/test/lux/data/number/frac.lux +++ b/stdlib/source/test/lux/data/number/frac.lux @@ -1,6 +1,8 @@ (.module: [lux #* ["_" test (#+ Test)] + ["@" target] + ["." host] [abstract [monad (#+ do)] {[0 #spec] @@ -115,6 +117,13 @@ (|> expected r.frac /.rev (r.= expected)))) )) +(with-expansions [<jvm> (as-is (host.import: java/lang/Double + ["#::." + (#static doubleToRawLongBits #manual [double] long) + (#static longBitsToDouble #manual [long] double)]))] + (for {@.old (as-is <jvm>) + @.jvm (as-is <jvm>)})) + (def: #export test Test (<| (_.covering /._) @@ -161,14 +170,37 @@ (/.negative? sample))) (_.cover [/.signum] (/.= (/.abs sample) - (/.* (/.signum sample) sample))))) + (/.* (/.signum sample) sample))) + )) + (with-expansions [<jvm> ($_ _.and + (do random.monad + [expected random.frac] + (_.cover [/.to-bits] + (n.= (.nat (java/lang/Double::doubleToRawLongBits expected)) + (/.to-bits expected)))) + (do random.monad + [sample random.i64] + (_.cover [/.from-bits] + (let [expected (java/lang/Double::longBitsToDouble sample) + actual (/.from-bits sample)] + (or (/.= expected actual) + (and (/.not-a-number? expected) + (/.not-a-number? actual)))))) + )] + (for {@.old <jvm> + @.jvm <jvm>} + (do random.monad + [expected random.frac] + (_.cover [/.to-bits /.from-bits] + (let [actual (|> expected /.to-bits /.from-bits)] + (or (/.= expected actual) + (and (/.not-a-number? expected) + (/.not-a-number? actual)))))))) (do random.monad - [expected random.frac] - (_.cover [/.to-bits /.from-bits] - (let [actual (|> expected /.to-bits /.from-bits)] - (or (/.= expected actual) - (and (/.not-a-number? expected) - (/.not-a-number? actual)))))) + [sample random.frac] + (_.cover [/.hash] + (n.= (/.to-bits sample) + (\ /.hash hash sample)))) (do random.monad [expected random.safe-frac] (_.cover [/.negate] @@ -179,9 +211,9 @@ (|> expected /.negate /.negate (/.= expected))] (and subtraction! inverse!)))) - - ..signature + ..constant ..predicate ..conversion + ..signature )))) diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 4d9b9f468..89dc6a669 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -2,9 +2,9 @@ [lux #* ["_" test (#+ Test)] [data - ["." name] - ["%" text/format (#+ format)] + ["." bit ("#\." equivalence)] [number + ["n" nat] ["i" int]]] [abstract [monad (#+ do)] @@ -13,96 +13,258 @@ ["$." equivalence] ["$." monoid]]}] [math - ["r" random]]] + ["." random (#+ Random)]]] {1 - ["." / - ["/#" // #_ - ["#." nat]]]}) + ["." / ("\." equivalence)]}) -(def: #export test +(def: bit + Test + (do {! random.monad} + [pattern random.nat + idx (\ ! map (n.% /.width) random.nat)] + ($_ _.and + (_.cover [/.set? /.set] + (if (/.set? idx pattern) + (\= pattern (/.set idx pattern)) + (not (\= pattern (/.set idx pattern))))) + (_.cover [/.clear? /.clear] + (if (/.clear? idx pattern) + (\= pattern (/.clear idx pattern)) + (not (\= pattern (/.clear idx pattern))))) + (_.cover [/.flip] + (\= (/.flip idx pattern) + (if (/.set? idx pattern) + (/.clear idx pattern) + (/.set idx pattern)))) + (_.cover [/.bit] + (bit\= (/.clear? idx pattern) + (\= /.false (/.and (/.bit idx) pattern)))) + ))) + +(def: shift + Test + (do {! random.monad} + [pattern random.nat] + ($_ _.and + (do ! + [idx (\ ! map (n.% /.width) random.nat)] + (_.cover [/.arithmetic-right-shift] + (let [value (.int pattern) + + nullity! + (\= pattern (/.arithmetic-right-shift 0 pattern)) + + idempotency! + (\= value (/.arithmetic-right-shift /.width value)) + + sign-preservation! + (bit\= (i.negative? value) + (i.negative? (/.arithmetic-right-shift idx value)))] + (and nullity! + idempotency! + sign-preservation!)))) + (do ! + [idx (\ ! map (|>> (n.% (dec /.width)) inc) random.nat)] + (_.cover [/.left-shift /.logic-right-shift] + (let [nullity! + (and (\= pattern (/.left-shift 0 pattern)) + (\= pattern (/.logic-right-shift 0 pattern))) + + idempotency! + (and (\= pattern (/.left-shift /.width pattern)) + (\= pattern (/.logic-right-shift /.width pattern))) + + movement! + (let [shift (n.- idx /.width)] + (\= (/.and (/.mask idx) pattern) + (|> pattern + (/.left-shift shift) + (/.logic-right-shift shift))))] + (and nullity! + idempotency! + movement!)))) + ))) + +(def: mask Test - (<| (_.context (name.module (name-of /._))) - (do {! r.monad} - [pattern r.nat - idx (\ ! map (//nat.% /.width) r.nat)] + (<| (_.with-cover [/.Mask]) + (do {! random.monad} + [pattern random.nat + idx (\ ! map (n.% /.width) random.nat) + signed random.int] ($_ _.and - ($equivalence.spec /.equivalence r.i64) - ($monoid.spec //nat.equivalence /.disjunction r.nat) - ($monoid.spec //nat.equivalence /.conjunction r.nat) - - (_.test "Clearing and settings bits should alter the count." - (and (//nat.= (dec (/.count (/.set idx pattern))) - (/.count (/.clear idx pattern))) - (|> (/.count pattern) - (//nat.- (/.count (/.clear idx pattern))) - (//nat.<= 1)) - (|> (/.count (/.set idx pattern)) - (//nat.- (/.count pattern)) - (//nat.<= 1)))) - (_.test "Can query whether a bit is set." - (and (or (and (/.set? idx pattern) - (not (/.set? idx (/.clear idx pattern)))) - (and (not (/.set? idx pattern)) - (/.set? idx (/.set idx pattern)))) - - (or (and (/.set? idx pattern) - (not (/.set? idx (/.flip idx pattern)))) - (and (not (/.set? idx pattern)) - (/.set? idx (/.flip idx pattern)))))) - (_.test "The negation of a bit pattern should have a complementary bit-count." - (//nat.= /.width - (//nat.+ (/.count pattern) - (/.count (/.not pattern))))) - (_.test "Can do simple binary logic." - (and (//nat.= 0 - (/.and pattern - (/.not pattern))) - (//nat.= (/.not 0) - (/.or pattern - (/.not pattern))) - (//nat.= (/.not 0) - (/.xor pattern - (/.not pattern))) - (//nat.= 0 - (/.xor pattern - pattern)))) - (_.test "rotate-left and rotate-right are inverses of one another." - (and (|> pattern - (/.rotate-left idx) - (/.rotate-right idx) - (//nat.= pattern)) - (|> pattern - (/.rotate-right idx) - (/.rotate-left idx) - (//nat.= pattern)))) - (_.test "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged." - (and (|> pattern - (/.rotate-left /.width) - (//nat.= pattern)) - (|> pattern - (/.rotate-right /.width) - (//nat.= pattern)))) - (_.test "Shift right respect the sign of ints." - (let [value (.int pattern)] - (if (i.< +0 value) - (i.< +0 (/.arithmetic-right-shift idx value)) - (i.>= +0 (/.arithmetic-right-shift idx value))))) + (_.cover [/.sign] + (bit\= (\= (.i64 0) (/.and /.sign signed)) + (i.positive? signed))) (_.cover [/.mask] (let [mask (/.mask idx) - idempotent? (\ /.equivalence = - (/.and mask pattern) - (/.and mask (/.and mask pattern))) + idempotency! (\= (/.and mask pattern) + (/.and mask (/.and mask pattern))) limit (inc (.nat mask)) - below-limit? (if (//nat.< limit pattern) - (//nat.= pattern (/.and mask pattern)) - (//nat.< limit (/.and mask pattern))) + limit! (if (n.< limit pattern) + (\= pattern (/.and mask pattern)) + (n.< limit (/.and mask pattern))) - with-empty-mask? (//nat.= 0 (/.and (/.mask 0) pattern)) - with-full-mask? (//nat.= pattern (/.and (/.mask /.width) pattern))] - (and idempotent? - below-limit? + empty! (\= /.false (/.mask 0)) + full! (\= /.true (/.mask /.width))] + (and idempotency! + limit! - with-empty-mask? - with-full-mask?))) + empty! + full!))) + (do ! + [size (\ ! map (n.% /.width) random.nat) + #let [spare (n.- size /.width)] + offset (\ ! map (n.% spare) random.nat)] + (_.cover [/.region] + (\= (|> pattern + ## NNNNYYYYNNNN + (/.logic-right-shift offset) + ## ____NNNNYYYY + (/.left-shift spare) + ## YYYY________ + (/.logic-right-shift spare) + ## ________YYYY + (/.left-shift offset) + ## ____YYYY____ + ) + (/.and (/.region size offset) pattern)))) + )))) + +(def: sub + Test + (_.with-cover [/.Sub] + (do {! random.monad} + [size (\ ! map (n.% /.width) random.nat)] + (case (/.sub size) + #.None + (_.cover [/.sub] + (n.= 0 size)) + + (#.Some sub) + (do {! random.monad} + [#let [limit (|> (dec (\ sub width)) + /.mask + .int + inc)] + expected (\ ! map (i.% limit) random.int) + #let [random (: (All [size] + (-> (-> I64 (I64 size)) (Random (I64 size)))) + (function (_ narrow) + (\ random.functor map narrow random.i64)))]] + ($_ _.and + ($equivalence.spec (\ sub &equivalence) (random (\ sub narrow))) + (_.cover [/.sub] + (let [actual (|> expected .i64 (\ sub narrow) (\ sub widen))] + (\= expected actual))) + )))))) + +(def: signature + Test + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence random.i64)) + (_.with-cover [/.disjunction] + ($monoid.spec n.equivalence /.disjunction random.nat)) + (_.with-cover [/.conjunction] + ($monoid.spec n.equivalence /.conjunction random.nat)) + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [.I64]) + (do {! random.monad} + [pattern random.nat + idx (\ ! map (n.% /.width) random.nat)] + ($_ _.and + (_.cover [/.width /.bits-per-byte /.bytes-per-i64] + (and (n.= /.bytes-per-i64 + (n./ /.bits-per-byte /.width)) + (n.= /.bits-per-byte + (n./ /.bytes-per-i64 /.width)))) + (_.cover [/.false] + (n.= 0 (/.count /.false))) + (_.cover [/.or] + (and (\= /.true (/.or /.true pattern)) + (\= pattern (/.or /.false pattern)))) + (_.cover [/.true] + (n.= /.width (/.count /.true))) + (_.cover [/.and] + (and (\= pattern (/.and /.true pattern)) + (\= /.false (/.and /.false pattern)))) + (_.cover [/.not] + (and (\= /.false + (/.and pattern + (/.not pattern))) + (\= /.true + (/.or pattern + (/.not pattern))))) + (_.cover [/.xor] + (and (\= /.true + (/.xor pattern + (/.not pattern))) + (\= /.false + (/.xor pattern + pattern)))) + (_.cover [/.count] + (let [clear&set! + (if (/.set? idx pattern) + (n.= (dec (/.count pattern)) (/.count (/.clear idx pattern))) + (n.= (inc (/.count pattern)) (/.count (/.set idx pattern)))) + + complementarity! + (n.= /.width + (n.+ (/.count pattern) + (/.count (/.not pattern))))] + (and clear&set! + complementarity!))) + (_.cover [/.rotate-left /.rotate-right] + (let [false! + (and (\= /.false (/.rotate-left idx /.false)) + (\= /.false (/.rotate-right idx /.false))) + + true! + (and (\= /.true (/.rotate-left idx /.true)) + (\= /.true (/.rotate-right idx /.true))) + + inverse! + (and (|> pattern + (/.rotate-left idx) + (/.rotate-right idx) + (\= pattern)) + (|> pattern + (/.rotate-right idx) + (/.rotate-left idx) + (\= pattern))) + + nullity! + (and (|> pattern + (/.rotate-left 0) + (\= pattern)) + (|> pattern + (/.rotate-right 0) + (\= pattern))) + + futility! + (and (|> pattern + (/.rotate-left /.width) + (\= pattern)) + (|> pattern + (/.rotate-right /.width) + (\= pattern)))] + (and false! + true! + inverse! + nullity! + futility!))) + (_.cover [/.hash] + (n.= pattern (\ /.hash hash pattern))) + + ..bit + ..shift + ..mask + ..sub + ..signature )))) |