aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--documentation/bookmark/Type theory/Dependent types.md1
-rw-r--r--documentation/bookmark/Type theory/Type checking.md4
-rw-r--r--documentation/bookmark/concurrency/Engine.md4
-rw-r--r--documentation/bookmark/text_editor & ide.md1
-rw-r--r--stdlib/source/lux/data/number/frac.lux4
-rw-r--r--stdlib/source/lux/type/check.lux12
-rw-r--r--stdlib/source/lux/world/file.lux37
-rw-r--r--stdlib/source/lux/world/file/watch.lux4
-rw-r--r--stdlib/source/program/aedifex.lux20
-rw-r--r--stdlib/source/program/aedifex/command/auto.lux184
-rw-r--r--stdlib/source/test/aedifex.lux4
-rw-r--r--stdlib/source/test/aedifex/command/auto.lux147
-rw-r--r--stdlib/source/test/lux/data/collection/set.lux30
-rw-r--r--stdlib/source/test/lux/data/number.lux27
-rw-r--r--stdlib/source/test/lux/data/number/frac.lux196
-rw-r--r--stdlib/source/test/lux/type/check.lux49
-rw-r--r--stdlib/source/test/lux/world/file/watch.lux53
17 files changed, 512 insertions, 265 deletions
diff --git a/documentation/bookmark/Type theory/Dependent types.md b/documentation/bookmark/Type theory/Dependent types.md
index 84d739492..8269310db 100644
--- a/documentation/bookmark/Type theory/Dependent types.md
+++ b/documentation/bookmark/Type theory/Dependent types.md
@@ -5,6 +5,7 @@
# Reference
+1. [Multimodal Dependent Type Theory](https://arxiv.org/abs/2011.15021)
1. [Thorsten Altenkirch - The power of Π - Lambda Days 2020](https://www.youtube.com/watch?v=3zT5eVHpQwA)
1. [A Path To DOT: Formalizing Fully Path-Dependent Types](https://arxiv.org/abs/1904.07298)
1. [Ghosts of Departed Proofs (Functional Pearl)](https://www.youtube.com/watch?v=2cAxOJEiL00)
diff --git a/documentation/bookmark/Type theory/Type checking.md b/documentation/bookmark/Type theory/Type checking.md
new file mode 100644
index 000000000..d26019e88
--- /dev/null
+++ b/documentation/bookmark/Type theory/Type checking.md
@@ -0,0 +1,4 @@
+# Reference
+
+1. [Let Should Not Be Generalised](https://www.microsoft.com/en-us/research/publication/let-should-not-be-generalised/)
+
diff --git a/documentation/bookmark/concurrency/Engine.md b/documentation/bookmark/concurrency/Engine.md
new file mode 100644
index 000000000..33d036863
--- /dev/null
+++ b/documentation/bookmark/concurrency/Engine.md
@@ -0,0 +1,4 @@
+# Reference
+
+1. [Literate Engines in Lisp](http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.45.6198)
+
diff --git a/documentation/bookmark/text_editor & ide.md b/documentation/bookmark/text_editor & ide.md
index c0257d5c6..b39b0a075 100644
--- a/documentation/bookmark/text_editor & ide.md
+++ b/documentation/bookmark/text_editor & ide.md
@@ -50,6 +50,7 @@
# Reference
+1. [On the design of text editors](https://arxiv.org/abs/2008.06030)
1. [The Piece Table - the Unsung Hero of Your Text Editor](https://darrenburns.net/posts/piece-table/)
1. [Build Your Own Text Editor](https://viewsourcecode.org/snaptoken/kilo/)
1. [It’s 2019. Why don’t we have good code editors?](https://thoughts.thorlaksson.com/2019/09/27/its-2019-why-dont-we-have-good-code-editors/)
diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux
index 13f085310..fed714fee 100644
--- a/stdlib/source/lux/data/number/frac.lux
+++ b/stdlib/source/lux/data/number/frac.lux
@@ -164,8 +164,8 @@
[addition ..+ +0.0]
[multiplication ..* +1.0]
- [maximum ..max (..* -1.0 ..biggest)]
[minimum ..min ..biggest]
+ [maximum ..max (..* -1.0 ..biggest)]
)
(template [<name> <numerator> <doc>]
@@ -184,7 +184,7 @@
(-> Frac Bit)
(not (..= number number)))
-(def: #export (frac? value)
+(def: #export (number? value)
(-> Frac Bit)
(not (or (..not-a-number? value)
(..= ..positive-infinity value)
diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
index 28c73b124..742e02557 100644
--- a/stdlib/source/lux/type/check.lux
+++ b/stdlib/source/lux/type/check.lux
@@ -61,7 +61,9 @@
(type: #export Type-Vars
(List [Var (Maybe Type)]))
-(structure: #export functor (Functor Check)
+(structure: #export functor
+ (Functor Check)
+
(def: (map f fa)
(function (_ context)
(case (fa context)
@@ -71,7 +73,9 @@
(#try.Failure error)
(#try.Failure error)))))
-(structure: #export apply (Apply Check)
+(structure: #export apply
+ (Apply Check)
+
(def: &functor ..functor)
(def: (apply ff fa)
@@ -90,7 +94,9 @@
)))
)
-(structure: #export monad (Monad Check)
+(structure: #export monad
+ (Monad Check)
+
(def: &functor ..functor)
(def: (wrap x)
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 29409a881..a99e47d33 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -87,6 +87,9 @@
))
(signature: #export (Directory !)
+ (: (Can-See Path)
+ scope)
+
(: (Can-Query ! (List (File !)))
files)
@@ -148,17 +151,22 @@
(def: (async-directory directory)
(-> (Directory IO) (Directory Promise))
- (`` (structure (~~ (template [<name> <async>]
- [(def: <name> (..can-query
- (|>> (!.use (:: directory <name>))
- (io\map (try\map (list\map <async>)))
- promise.future)))]
+ (`` (structure (def: scope
+ (:: directory scope))
+
+ (~~ (template [<name> <async>]
+ [(def: <name>
+ (..can-query
+ (|>> (!.use (:: directory <name>))
+ (io\map (try\map (list\map <async>)))
+ promise.future)))]
[files ..async-file]
[directories async-directory]))
- (def: discard (..can-delete
- (|>> (!.use (:: directory discard)) promise.future))))))
+ (def: discard
+ (..can-delete
+ (|>> (!.use (:: directory discard)) promise.future))))))
(def: #export (async system)
(-> (System IO) (System Promise))
@@ -370,6 +378,11 @@
(`` (structure: (directory path)
(-> Path (Directory IO))
+ (def: scope
+ (..can-see
+ (function (_ _)
+ path)))
+
(~~ (template [<name> <method> <capability>]
[(def: <name>
(..can-query
@@ -576,6 +589,11 @@
(`` (structure: (directory path)
(-> Path (Directory IO))
+
+ (def: scope
+ (..can-see
+ (function (_ _)
+ path)))
(~~ (template [<name> <method> <capability>]
[(def: <name>
@@ -1023,6 +1041,11 @@
(def: (mock-directory separator path store)
(-> Text Path (Var Mock) (Directory Promise))
(structure
+ (def: scope
+ (..can-see
+ (function (_ _)
+ path)))
+
(def: files
(..can-query
(function (_ _)
diff --git a/stdlib/source/lux/world/file/watch.lux b/stdlib/source/lux/world/file/watch.lux
index b33cdaa6e..596163bb1 100644
--- a/stdlib/source/lux/world/file/watch.lux
+++ b/stdlib/source/lux/world/file/watch.lux
@@ -349,10 +349,6 @@
(import: java/io/File
["#::."
(new [java/lang/String])
- (exists [] #io #try boolean)
- (isDirectory [] #io #try boolean)
- (listFiles [] #io #try [java/io/File])
- (getAbsolutePath [] #io #try java/lang/String)
(toPath [] java/nio/file/Path)])
(type: Watch-Event
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index 0b2dda8f2..d876b5665 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -32,8 +32,9 @@
["." syntax]]]]]
[world
["." environment (#+ Environment)]
- ["." file (#+ Path)]
- ["." shell (#+ Shell)]]]
+ ["." shell (#+ Shell)]
+ ["." file (#+ Path)
+ ["." watch]]]]
["." / #_
["#" profile]
["#." action (#+ Action)]
@@ -127,10 +128,17 @@
(wrap [])))
(#/cli.Auto auto)
- (exec (case auto
- #/cli.Build (..with-dependencies (/command/auto.do! /command/build.do!) profile)
- #/cli.Test (..with-dependencies (/command/auto.do! /command/test.do!) profile))
- (wrap [])))
+ (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 [])))))
(#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 aa230daba..f7ec7a315 100644
--- a/stdlib/source/program/aedifex/command/auto.lux
+++ b/stdlib/source/program/aedifex/command/auto.lux
@@ -1,161 +1,77 @@
(.module:
[lux #*
- ["." host (#+ import:)]
[abstract
["." monad (#+ do)]]
[control
["." try (#+ Try)]
- ["." io (#+ IO)]
[concurrency
- ["." promise (#+ Promise)]]]
+ ["." promise (#+ Promise)]]
+ [security
+ ["!" capability]]]
[data
[collection
- ["." array]
["." list]
["." set]]]
[world
[environment (#+ Environment)]
- ["." file (#+ Path)]
- ["." shell (#+ Shell)]]]
+ [shell (#+ Shell)]
+ ["." file (#+ Path)
+ ["." watch (#+ Watcher)]]]]
["." // #_
["/#" // #_
+ [command (#+ Command)]
["#" profile]
["#." action (#+ Action)]
- ["#." command (#+ Command)]
[dependency
[resolution (#+ Resolution)]]]])
-(import: java/nio/file/WatchKey
- ["#::."
- (reset [] #io boolean)])
-
-(import: java/util/concurrent/TimeUnit
- ["#::."
- (#enum SECONDS)])
-
-(import: java/nio/file/WatchService
- ["#::."
- (poll [long java/util/concurrent/TimeUnit] #io #try #? java/nio/file/WatchKey)
- (poll #as fetch [] #io #try #? java/nio/file/WatchKey)])
-
-(import: java/nio/file/FileSystem
- ["#::."
- (newWatchService [] #io #try java/nio/file/WatchService)])
-
-(import: java/nio/file/FileSystems
- ["#::."
- (#static getDefault [] java/nio/file/FileSystem)])
-
-(import: java/lang/Object)
-
-(import: java/lang/String)
-
-(import: (java/nio/file/WatchEvent$Kind a))
-
-(import: java/nio/file/StandardWatchEventKinds
- ["#::."
- (#static ENTRY_CREATE (java/nio/file/WatchEvent$Kind java/nio/file/Path))
- (#static ENTRY_MODIFY (java/nio/file/WatchEvent$Kind java/nio/file/Path))
- (#static ENTRY_DELETE (java/nio/file/WatchEvent$Kind java/nio/file/Path))])
-
-(import: java/nio/file/Path
- ["#::."
- (register [java/nio/file/WatchService [(java/nio/file/WatchEvent$Kind ?)]] #io #try java/nio/file/WatchKey)])
-
-(import: java/io/File
- ["#::."
- (new [java/lang/String])
- (exists [] #io #try boolean)
- (isDirectory [] #io #try boolean)
- (listFiles [] #io #try [java/io/File])
- (getAbsolutePath [] #io #try java/lang/String)
- (toPath [] java/nio/file/Path)])
-
-(def: (targets path)
- (-> Path (Action (List Path)))
- (promise.future
- (loop [path path]
- (let [file (java/io/File::new path)]
- (do {! (try.with io.monad)}
- [exists? (java/io/File::exists file)
- directory? (java/io/File::isDirectory file)]
- (if (and exists?
- directory?)
- (do !
- [children (java/io/File::listFiles file)
- children (|> children
- array.to-list
- (monad.map ! (|>> java/io/File::getAbsolutePath)))
- descendants (monad.map ! recur children)]
- (wrap (#.Cons path (list.concat descendants))))
- (wrap (list))))))))
-
-(type: Watch-Event
- (java/nio/file/WatchEvent$Kind java/lang/Object))
-
-(def: watch-events
- (List Watch-Event)
- (list (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_CREATE))
- (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_MODIFY))
- (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_DELETE))))
-
-(def: (watch! watcher path)
- (-> java/nio/file/WatchService Path (Action Any))
- (promise.future
- (do (try.with io.monad)
- [_ (java/nio/file/Path::register watcher
- (array.from-list ..watch-events)
- (|> path java/io/File::new java/io/File::toPath))]
- (wrap []))))
-
-(def: (poll! watcher)
- (-> java/nio/file/WatchService (Action (Maybe java/nio/file/WatchKey)))
- (promise.future
- (java/nio/file/WatchService::poll 1 java/util/concurrent/TimeUnit::SECONDS watcher)))
-
-(def: (drain! watcher)
- (-> java/nio/file/WatchService (IO (Try Any)))
- (do (try.with io.monad)
- [?key (java/nio/file/WatchService::fetch watcher)]
- (case ?key
- (#.Some key)
- (do io.monad
- [valid? (java/nio/file/WatchKey::reset key)]
- (if valid?
- (drain! watcher)
- (wrap (:: try.monad wrap []))))
-
- #.None
- (wrap []))))
-
-(def: #export (do! command)
+(def: (targets fs path)
+ (-> (file.System Promise) Path (Promise (List Path)))
+ (do {! promise.monad}
+ [?root (!.use (:: fs directory) [path])]
+ (case ?root
+ (#try.Success root)
+ (loop [root root]
+ (do !
+ [subs (:: ! map (|>> (try.default (list)))
+ (!.use (:: root directories) []))]
+ (:: ! map (|>> list.concat (list& (!.use (:: root scope) [])))
+ (monad.map ! recur subs))))
+
+ (#try.Failure error)
+ (wrap (list)))))
+
+(def: (pause _)
+ (-> Any (Promise (Try Any)))
+ (promise.delay 1,000 (#try.Success [])))
+
+(def: #export (do! watcher command)
(All [a]
- (-> (-> Environment (file.System Promise) (Shell Promise) Resolution (Command 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)
(function (_ profile)
(with-expansions [<call> ((command environment fs shell resolution) profile)]
- (do {! ///action.monad}
- [watcher (promise.future
- (java/nio/file/FileSystem::newWatchService
- (java/nio/file/FileSystems::getDefault)))
- targets (|> profile
+ (do {! promise.monad}
+ [targets (|> profile
(get@ #///.sources)
set.to-list
- (monad.map ! ..targets)
- (:: ! map list.concat))
- _ (monad.map ! (..watch! watcher) targets)
- _ <call>]
- (loop [_ []]
- (do !
- [?key (..poll! watcher)
- _ (case ?key
- (#.Some key)
- (do !
- [_ (promise.future (..drain! watcher))
- _ <call>]
- (wrap []))
-
- #.None
- (wrap []))]
- (recur []))))))))
+ (monad.map ! (..targets fs))
+ (:: ! map list.concat))]
+ (do {! ///action.monad}
+ [_ (monad.map ! (:: watcher start watch.all) targets)
+ _ <call>]
+ (loop [_ []]
+ (do !
+ [_ (..pause [])
+ events (:: watcher poll [])
+ _ (case events
+ (#.Cons _)
+ (do !
+ [_ <call>]
+ (wrap []))
+
+ #.Nil
+ (wrap []))]
+ (recur [])))))))))
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux
index 71d9a29bb..02d2b8ed2 100644
--- a/stdlib/source/test/aedifex.lux
+++ b/stdlib/source/test/aedifex.lux
@@ -15,7 +15,8 @@
["#/." deploy]
["#/." deps]
["#/." build]
- ["#/." test]]
+ ["#/." test]
+ ["#/." auto]]
["#." local]
["#." cache]
["#." dependency
@@ -42,6 +43,7 @@
/command/deps.test
/command/build.test
/command/test.test
+ /command/auto.test
/local.test
/cache.test
/dependency.test
diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux
new file mode 100644
index 000000000..13039d9d3
--- /dev/null
+++ b/stdlib/source/test/aedifex/command/auto.lux
@@ -0,0 +1,147 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try]
+ [parser
+ ["." environment]]
+ [concurrency
+ ["." atom (#+ Atom)]
+ ["." promise (#+ Promise)]]
+ [security
+ ["!" capability]]]
+ [data
+ ["." text
+ ["%" format (#+ format)]]
+ [number
+ ["n" nat]]
+ [collection
+ ["." dictionary]
+ ["." set]
+ ["." list ("#\." functor)]]]
+ [math
+ ["." random]]
+ [world
+ [environment (#+ Environment)]
+ ["." shell (#+ Shell)]
+ ["." file (#+ Path)
+ ["." watch]]]]
+ ["$." /// #_
+ ["#." package]]
+ {#program
+ ["." /
+ ["/#" // #_
+ ["#." build]
+ ["/#" // #_
+ [command (#+ Command)]
+ ["#" profile (#+ Profile)]
+ ["#." action]
+ ["#." artifact
+ ["#/." type]]
+ ["#." dependency
+ ["#/." resolution (#+ Resolution)]]]]]})
+
+(def: (command end-signal dummy-files)
+ (-> Text (List Path)
+ [(Atom [Nat (List Path)])
+ (-> 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)
+ (do {! promise.monad}
+ [[runs remaining-files] (promise.future
+ (atom.update (function (_ [runs remaining-files])
+ [(inc runs) remaining-files])
+ @runs))]
+ (case remaining-files
+ #.Nil
+ (wrap (#try.Failure end-signal))
+
+ (#.Cons head tail)
+ (do (try.with !)
+ [_ (!.use (:: fs create-file) [head])]
+ (do !
+ [_ (promise.future (atom.write [runs tail] @runs))]
+ (wrap (#try.Success [])))))))]))
+
+(def: #export test
+ Test
+ (<| (_.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]))))))
+ [])]
+ end-signal (random.ascii/alpha 5)
+ program (random.ascii/alpha 5)
+ target (random.ascii/alpha 5)
+ working-directory (random.ascii/alpha 5)
+ expected-runs (:: ! map (|>> (n.% 10) (n.max 2)) random.nat)
+ source (random.ascii/alpha 5)
+ dummy-files (|> (random.ascii/alpha 5)
+ (random.set text.hash (dec expected-runs))
+ (:: ! map (|>> set.to-list (list\map (|>> (format source /))))))
+ #let [empty-profile (: Profile
+ (:: ///.monoid identity))
+ with-target (: (-> Profile Profile)
+ (set@ #///.target (#.Some target)))
+ with-program (: (-> Profile Profile)
+ (set@ #///.program (#.Some program)))
+
+ profile (|> empty-profile
+ with-program
+ with-target
+ (set@ #///.sources (set.from-list text.hash (list source))))
+
+ environment (dictionary.put "user.dir" working-directory environment.empty)]]
+ ($_ _.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)
+
+ (#try.Success _)
+ false))))))]
+ (_.cover' [/.do!]
+ (try.default false verdict)))))
+ ))))
diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux
index 3525a5fc8..83cfe60fb 100644
--- a/stdlib/source/test/lux/data/collection/set.lux
+++ b/stdlib/source/test/lux/data/collection/set.lux
@@ -1,8 +1,8 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
+ [hash (#+ Hash)]
[monad (#+ do)]
{[0 #spec]
[/
@@ -17,7 +17,7 @@
[math
["." random (#+ Random)]]]
{1
- ["." /]})
+ ["." / ("\." equivalence)]})
(def: gen-nat
(Random Nat)
@@ -28,8 +28,7 @@
Test
(<| (_.covering /._)
(_.with-cover [/.Set])
- (let [(^open "/\.") /.equivalence])
- (do random.monad
+ (do {! random.monad}
[size ..gen-nat]
($_ _.and
(_.with-cover [/.equivalence]
@@ -37,7 +36,7 @@
(_.with-cover [/.monoid]
($monoid.spec /.equivalence (/.monoid n.hash) (random.set n.hash size random.nat)))
- (do random.monad
+ (do !
[sizeL ..gen-nat
sizeR ..gen-nat
setL (random.set n.hash sizeL random.nat)
@@ -45,13 +44,26 @@
non-memberL (random.filter (|>> (/.member? setL) not)
random.nat)]
($_ _.and
+ (_.cover [/.new]
+ (/.empty? (/.new n.hash)))
+ (do !
+ [hash (:: ! map (function (_ constant)
+ (: (Hash Nat)
+ (structure
+ (def: &equivalence n.equivalence)
+
+ (def: (hash _)
+ constant))))
+ random.nat)]
+ (_.cover [/.member-hash]
+ (is? hash (/.member-hash (/.new hash)))))
(_.cover [/.size]
(n.= sizeL (/.size setL)))
(_.cover [/.empty?]
(bit\= (/.empty? setL)
(n.= 0 (/.size setL))))
(_.cover [/.to-list /.from-list]
- (|> setL /.to-list (/.from-list n.hash) (/\= setL)))
+ (|> setL /.to-list (/.from-list n.hash) (\= setL)))
(_.cover [/.member?]
(and (list.every? (/.member? setL) (/.to-list setL))
(not (/.member? setL non-memberL))))
@@ -72,12 +84,12 @@
(|> setL
(/.add non-memberL)
(/.remove non-memberL)
- (/\= setL))
+ (\= setL))
idempotency!
(|> setL
(/.remove non-memberL)
- (/\= setL))]
+ (\= setL))]
(and symmetry!
idempotency!)))
(_.cover [/.union /.sub?]
@@ -90,7 +102,7 @@
union-with-empty-set!
(|> setL
(/.union (/.new n.hash))
- (/\= setL))]
+ (\= setL))]
(and sets-are-subs-of-their-unions!
union-with-empty-set!)))
(_.cover [/.intersection /.super?]
diff --git a/stdlib/source/test/lux/data/number.lux b/stdlib/source/test/lux/data/number.lux
index d8b0ad3bf..9458bb12c 100644
--- a/stdlib/source/test/lux/data/number.lux
+++ b/stdlib/source/test/lux/data/number.lux
@@ -29,21 +29,6 @@
(-> Text Text)
(text.replace-all "," ""))
-(def: sub
- Test
- ($_ _.and
- /i8.test
- /i16.test
- /i32.test
- /i64.test
- /nat.test
- /int.test
- /rev.test
- /frac.test
- /ratio.test
- /complex.test
- ))
-
(def: #export test
Test
(<| (_.covering /._)
@@ -111,5 +96,15 @@
[f.= f.hex "+dead.BEEF"]
[f.= f.hex "-dead,BE.EF"]
)))))
- ..sub
+
+ /i8.test
+ /i16.test
+ /i32.test
+ /i64.test
+ /nat.test
+ /int.test
+ /rev.test
+ /frac.test
+ /ratio.test
+ /complex.test
)))
diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux
index 365bf9e7f..fcffb7c45 100644
--- a/stdlib/source/test/lux/data/number/frac.lux
+++ b/stdlib/source/test/lux/data/number/frac.lux
@@ -1,6 +1,5 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
[monad (#+ do)]
@@ -10,44 +9,171 @@
["$." order]
["$." monoid]
["$." codec]]}]
+ [data
+ ["." bit ("#\." equivalence)]]
[math
- ["." random]]]
+ ["." random (#+ Random)]]]
{1
["." /
[// #*
- ["i" int]]]})
+ ["n" nat]
+ ["i" int]
+ ["r" rev]
+ ["." i64]]]})
+
+(def: random
+ (Random Frac)
+ (:: random.monad map (|>> (i.% +1,000,000) i.frac) random.int))
+
+(def: signature
+ Test
+ (`` ($_ _.and
+ (_.with-cover [/.equivalence /.=]
+ ($equivalence.spec /.equivalence random.safe-frac))
+ (_.with-cover [/.order /.<]
+ ($order.spec /.order random.safe-frac))
+ (~~ (template [<monoid> <compose>]
+ [(_.with-cover [<monoid> <compose>]
+ ($monoid.spec /.equivalence <monoid> ..random))]
+
+ [/.addition /.+]
+ [/.multiplication /.*]
+ [/.minimum /.min]
+ [/.maximum /.max]
+ ))
+ (~~ (template [<codec>]
+ [(_.with-cover [<codec>]
+ ($codec.spec /.equivalence <codec> random.safe-frac))]
+
+ [/.binary] [/.octal] [/.decimal] [/.hex]
+ ))
+ )))
+
+(def: constant
+ Test
+ (do random.monad
+ [sample random.safe-frac]
+ ($_ _.and
+ (_.cover [/.biggest]
+ (/.<= /.biggest sample))
+ (_.cover [/.positive-infinity]
+ (/.< /.positive-infinity sample))
+ (_.cover [/.smallest]
+ (bit\= (/.positive? sample)
+ (/.>= /.smallest sample)))
+ (_.cover [/.negative-infinity]
+ (/.> /.negative-infinity sample))
+ (_.cover [/.not-a-number /.not-a-number?]
+ (and (/.not-a-number? /.not-a-number)
+ (not (or (/.= /.not-a-number sample)
+ (/.not-a-number? sample)))))
+ )))
+
+(def: predicate
+ Test
+ (do {! random.monad}
+ [sample ..random
+ shift (:: ! map /.abs ..random)]
+ ($_ _.and
+ (_.cover [/.negative?]
+ (bit\= (/.negative? sample)
+ (/.< +0.0 sample)))
+ (_.cover [/.positive?]
+ (bit\= (/.positive? sample)
+ (/.> +0.0 sample)))
+ (_.cover [/.zero?]
+ (bit\= (/.zero? sample)
+ (/.= +0.0 sample)))
+ (_.cover [/.within?]
+ (and (/.within? /.smallest sample sample)
+ (/.within? (/.+ +1.0 shift) sample (/.+ shift sample))))
+ (_.cover [/.number?]
+ (and (not (/.number? /.not-a-number))
+ (not (/.number? /.positive-infinity))
+ (not (/.number? /.negative-infinity))
+ (/.number? sample)))
+ )))
+
+(def: conversion
+ Test
+ ($_ _.and
+ (do {! random.monad}
+ [expected (:: ! map (n.% 1,000,000) random.nat)]
+ (_.cover [/.nat]
+ (|> expected n.frac /.nat (n.= expected))))
+ (do {! random.monad}
+ [expected (:: ! map (i.% +1,000,000) random.int)]
+ (_.cover [/.int]
+ (|> expected i.frac /.int (i.= expected))))
+ (do {! random.monad}
+ [expected (:: ! map (|>> (i64.left-shift 32) .rev)
+ random.nat)]
+ (_.cover [/.rev]
+ (|> expected r.frac /.rev (r.= expected))))
+ ))
(def: #export test
Test
- (let [gen-frac (:: random.monad map (|>> (i.% +100) i.frac) random.int)]
- (<| (_.context (%.name (name-of /._)))
- (`` ($_ _.and
- ($equivalence.spec /.equivalence gen-frac)
- ($order.spec /.order gen-frac)
- (~~ (template [<monoid>]
- [(<| (_.context (%.name (name-of <monoid>)))
- ($monoid.spec /.equivalence <monoid> gen-frac))]
-
- [/.addition] [/.multiplication] [/.minimum] [/.maximum]
- ))
- ## TODO: Uncomment ASAP
- ## (~~ (template [<codec>]
- ## [(<| (_.context (%.name (name-of /.binary)))
- ## ($codec.spec /.equivalence <codec> gen-frac))]
-
- ## [/.binary] [/.octal] [/.decimal] [/.hex]
- ## ))
-
- (_.test "Alternate notations."
- (and (/.= (bin "+1100.1001")
- (bin "+11,00.10,01"))
- (/.= (oct "-6152.43")
- (oct "-615,2.43"))
- (/.= (hex "+deadBE.EF")
- (hex "+dead,BE.EF"))))
- (do random.monad
- [sample gen-frac]
- (_.test (format (%.name (name-of /.to-bits))
- " & " (%.name (name-of /.from-bits)))
- (|> sample /.to-bits /.from-bits (/.= sample))))
- )))))
+ (<| (_.covering /._)
+ (_.with-cover [.Frac])
+ (`` ($_ _.and
+ (do random.monad
+ [left random.safe-frac
+ right random.safe-frac]
+ ($_ _.and
+ (_.cover [/.>]
+ (bit\= (/.> left right)
+ (/.< right left)))
+ (_.cover [/.<= /.>=]
+ (bit\= (/.<= left right)
+ (/.>= right left)))
+ ))
+ (do random.monad
+ [left ..random
+ right ..random]
+ ($_ _.and
+ (_.cover [/.%]
+ (let [rem (/.% left right)
+ div (|> right (/.- rem) (/./ left))]
+ (/.= right
+ (|> div (/.* left) (/.+ rem)))))
+ (_.cover [/./%]
+ (let [[div rem] (/./% left right)]
+ (and (/.= div (/./ left right))
+ (/.= rem (/.% left right)))))
+ ))
+ (do random.monad
+ [sample random.safe-frac]
+ ($_ _.and
+ (_.cover [/.-]
+ (and (/.= +0.0 (/.- sample sample))
+ (/.= sample (/.- +0.0 sample))
+ (/.= (/.negate sample)
+ (/.- sample +0.0))))
+ (_.cover [/./]
+ (and (/.= +1.0 (/./ sample sample))
+ (/.= sample (/./ +1.0 sample))))
+ (_.cover [/.abs]
+ (bit\= (/.> sample (/.abs sample))
+ (/.negative? sample)))
+ (_.cover [/.signum]
+ (/.= (/.abs sample)
+ (/.* (/.signum sample) sample)))))
+ (do random.monad
+ [expected random.frac]
+ ($_ _.and
+ (_.cover [/.to-bits /.from-bits]
+ (let [actual (|> expected /.to-bits /.from-bits)]
+ (or (/.= expected actual)
+ (and (/.not-a-number? expected)
+ (/.not-a-number? actual)))))
+ (_.cover [/.negate]
+ (and (/.= +0.0 (/.+ (/.negate expected) expected))
+ (|> expected /.negate /.negate (/.= expected))))
+ ))
+
+ ..signature
+ ..constant
+ ..predicate
+ ..conversion
+ ))))
diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux
index bbaaa5712..46749652e 100644
--- a/stdlib/source/test/lux/type/check.lux
+++ b/stdlib/source/test/lux/type/check.lux
@@ -31,31 +31,30 @@
(def: (type' num-vars)
(-> Nat (r.Random Type))
- (do r.monad
- [_ (wrap [])]
- (let [(^open "R\.") r.monad
- pairG (r.and (type' num-vars)
- (type' num-vars))
- quantifiedG (r.and (R\wrap (list)) (type' (inc num-vars)))
- random-pair (r.either (r.either (R\map (|>> #.Sum) pairG)
- (R\map (|>> #.Product) pairG))
- (r.either (R\map (|>> #.Function) pairG)
- (R\map (|>> #.Apply) pairG)))
- random-id (let [random-id (r.either (R\map (|>> #.Var) r.nat)
- (R\map (|>> #.Ex) r.nat))]
- (case num-vars
- 0 random-id
- _ (r.either (R\map (|>> (n.% num-vars) (n.* 2) inc #.Parameter) r.nat)
- random-id)))
- random-quantified (r.either (R\map (|>> #.UnivQ) quantifiedG)
- (R\map (|>> #.ExQ) quantifiedG))]
- ($_ r.either
- (R\map (|>> #.Primitive) (r.and ..short (R\wrap (list))))
- random-pair
- random-id
- random-quantified
- (R\map (|>> #.Named) (r.and ..name (type' num-vars)))
- ))))
+ (r.rec
+ (function (_ recur)
+ (let [(^open "R\.") r.monad
+ pairG (r.and recur recur)
+ quantifiedG (r.and (R\wrap (list)) (type' (inc num-vars)))
+ random-pair (r.either (r.either (R\map (|>> #.Sum) pairG)
+ (R\map (|>> #.Product) pairG))
+ (r.either (R\map (|>> #.Function) pairG)
+ (R\map (|>> #.Apply) pairG)))
+ random-id (let [random-id (r.either (R\map (|>> #.Var) r.nat)
+ (R\map (|>> #.Ex) r.nat))]
+ (case num-vars
+ 0 random-id
+ _ (r.either (R\map (|>> (n.% num-vars) (n.* 2) inc #.Parameter) r.nat)
+ random-id)))
+ random-quantified (r.either (R\map (|>> #.UnivQ) quantifiedG)
+ (R\map (|>> #.ExQ) quantifiedG))]
+ ($_ r.either
+ (R\map (|>> #.Primitive) (r.and ..short (R\wrap (list))))
+ random-pair
+ random-id
+ random-quantified
+ (R\map (|>> #.Named) (r.and ..name (type' 0)))
+ )))))
(def: type
(r.Random Type)
diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux
index 8d27ab307..5f55825e4 100644
--- a/stdlib/source/test/lux/world/file/watch.lux
+++ b/stdlib/source/test/lux/world/file/watch.lux
@@ -113,39 +113,46 @@
(list.empty? poll/0)]
file (!.use (:: fs create-file) [expected-path])
poll/1 (:: watcher poll [])
+ poll/1' (:: watcher poll [])
#let [after-creation!
- (case poll/1
- (^ (list [actual-path concern]))
- (and (text\= expected-path actual-path)
- (and (/.creation? concern)
- (not (/.modification? concern))
- (not (/.deletion? concern))))
+ (and (case poll/1
+ (^ (list [actual-path concern]))
+ (and (text\= expected-path actual-path)
+ (and (/.creation? concern)
+ (not (/.modification? concern))
+ (not (/.deletion? concern))))
- _
- false)]
+ _
+ false)
+ (list.empty? poll/1'))]
+ _ (promise.delay 1 (#try.Success "Delay to make sure the over-write time-stamp always changes."))
_ (!.use (:: file over-write) data)
poll/2 (:: watcher poll [])
+ poll/2' (:: watcher poll [])
#let [after-modification!
- (case poll/2
- (^ (list [actual-path concern]))
- (and (text\= expected-path actual-path)
- (and (not (/.creation? concern))
- (/.modification? concern)
- (not (/.deletion? concern))))
+ (and (case poll/2
+ (^ (list [actual-path concern]))
+ (and (text\= expected-path actual-path)
+ (and (not (/.creation? concern))
+ (/.modification? concern)
+ (not (/.deletion? concern))))
- _
- false)]
+ _
+ false)
+ (list.empty? poll/2'))]
_ (!.use (:: file delete) [])
poll/3 (:: watcher poll [])
+ poll/3' (:: watcher poll [])
#let [after-deletion!
- (case poll/3
- (^ (list [actual-path concern]))
- (and (not (/.creation? concern))
- (not (/.modification? concern))
- (/.deletion? concern))
+ (and (case poll/3
+ (^ (list [actual-path concern]))
+ (and (not (/.creation? concern))
+ (not (/.modification? concern))
+ (/.deletion? concern))
- _
- false)]]
+ _
+ false)
+ (list.empty? poll/3'))]]
(wrap (and no-events-prior-to-creation!
after-creation!
after-modification!
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 20:21:12 +0000