aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2020-12-03 02:09:57 -0400
committerEduardo Julian2020-12-03 02:09:57 -0400
commit0205e5146b50ab066d152fccda0fc8cef4eef852 (patch)
treeda2d89132da8f09344e26db78d0e43ca1095ee7f /stdlib/source
parent28c724857d76afdc40b5b036f415cc151eb66263 (diff)
Detect duplicate files coming from dependencies.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/number/i64.lux14
-rw-r--r--stdlib/source/lux/host.jvm.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux16
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux3
-rw-r--r--stdlib/source/lux/tool/compiler/meta/cache/dependency.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/archive.lux5
-rw-r--r--stdlib/source/lux/world/console.lux4
-rw-r--r--stdlib/source/program/aedifex.lux124
-rw-r--r--stdlib/source/program/aedifex/command/auto.lux9
-rw-r--r--stdlib/source/program/aedifex/command/build.lux20
-rw-r--r--stdlib/source/program/aedifex/command/clean.lux19
-rw-r--r--stdlib/source/program/aedifex/command/deploy.lux32
-rw-r--r--stdlib/source/program/aedifex/command/deps.lux29
-rw-r--r--stdlib/source/program/aedifex/command/install.lux35
-rw-r--r--stdlib/source/program/aedifex/command/pom.lux19
-rw-r--r--stdlib/source/program/aedifex/command/test.lux22
-rw-r--r--stdlib/source/program/aedifex/command/version.lux20
-rw-r--r--stdlib/source/program/compositor/import.lux25
-rw-r--r--stdlib/source/test/aedifex/command/auto.lux80
-rw-r--r--stdlib/source/test/aedifex/command/build.lux133
-rw-r--r--stdlib/source/test/aedifex/command/clean.lux65
-rw-r--r--stdlib/source/test/aedifex/command/deploy.lux43
-rw-r--r--stdlib/source/test/aedifex/command/deps.lux53
-rw-r--r--stdlib/source/test/aedifex/command/install.lux104
-rw-r--r--stdlib/source/test/aedifex/command/pom.lux26
-rw-r--r--stdlib/source/test/aedifex/command/test.lux98
-rw-r--r--stdlib/source/test/aedifex/command/version.lux61
-rw-r--r--stdlib/source/test/lux/data/number/frac.lux50
-rw-r--r--stdlib/source/test/lux/data/number/i64.lux330
32 files changed, 926 insertions, 529 deletions
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
))))