aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux36
-rw-r--r--stdlib/source/lux/host.jvm.lux21
-rw-r--r--stdlib/source/lux/host.old.lux21
-rw-r--r--stdlib/source/lux/macro.lux65
-rw-r--r--stdlib/source/lux/test.lux180
-rw-r--r--stdlib/source/lux/type/abstract.lux50
-rw-r--r--stdlib/source/lux/type/implicit.lux30
-rw-r--r--stdlib/source/test/lux/abstract/apply.lux65
-rw-r--r--stdlib/source/test/lux/control/state.lux111
-rw-r--r--stdlib/source/test/lux/control/thread.lux75
10 files changed, 401 insertions, 253 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index c33f025ea..265b8e979 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -1456,16 +1456,6 @@
ys}
xs))
-(def:''' #export (splice-helper xs ys)
- #Nil
- (-> ($' List Code) ($' List Code) ($' List Code))
- ({(#Cons x xs')
- (#Cons x (splice-helper xs' ys))
-
- #Nil
- ys}
- xs))
-
(def:''' (_$_joiner op a1 a2)
#Nil
(-> Code Code Code Code)
@@ -1752,6 +1742,14 @@
(#Left ($_ text@compose "Unknown module: " module " @ " (name@encode full-name)))}
(get module modules))))
+(def:''' (as-code-list expression)
+ #Nil
+ (-> Code Code)
+ (let' [type (form$ (list (tag$ ["lux" "Apply"])
+ (identifier$ ["lux" "Code"])
+ (identifier$ ["lux" "List"])))]
+ (form$ (list (text$ "lux check") type expression))))
+
(def:''' (splice replace? untemplate elems)
#Nil
(-> Bit (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code))
@@ -1762,21 +1760,21 @@
(#Cons lastI inits)
(do meta-monad
[lastO ({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))]
- (let' [[[_module-name _ _] _] spliced]
- (wrap spliced))
+ (wrap (as-code-list spliced))
_
(do meta-monad
[lastO (untemplate lastI)]
- (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list lastO (tag$ ["lux" "Nil"])))))))}
+ (wrap (as-code-list (form$ (list (tag$ ["lux" "Cons"])
+ (tuple$ (list lastO (tag$ ["lux" "Nil"]))))))))}
lastI)]
(monad@fold meta-monad
(function' [leftI rightO]
({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))]
- (let' [[[_module-name _ _] _] spliced]
- (wrap (form$ (list (identifier$ ["lux" "splice-helper"])
- spliced
- rightO))))
+ (let' [g!in-module (form$ (list (text$ "lux in-module")
+ (text$ "lux")
+ (identifier$ ["lux" "list@compose"])))]
+ (wrap (form$ (list g!in-module (as-code-list spliced) rightO))))
_
(do meta-monad
@@ -1847,7 +1845,9 @@
(return (wrap-meta (form$ (list (tag$ ["lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name)))))))
[#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~"])] (#Cons [unquoted #Nil])]))]]
- (return unquoted)
+ (return (form$ (list (text$ "lux check")
+ (identifier$ ["lux" "Code"])
+ unquoted)))
[#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~!"])] (#Cons [dependent #Nil])]))]]
(do meta-monad
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index dad69604e..1fb112a48 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -405,19 +405,14 @@
(do macro.monad
[current-module macro.current-module-name
definitions (macro.definitions current-module)]
- (wrap (list@fold (: (-> [Text Global] Context Context)
- (function (_ [short-name constant] imports)
- (case constant
- (#.Left _)
- imports
-
- (#.Right [_ _ meta _])
- (case (macro.get-text-ann (name-of #..jvm-class) meta)
- (#.Some full-class-name)
- (add-import [short-name full-class-name] imports)
-
- _
- imports))))
+ (wrap (list@fold (: (-> [Text Definition] Context Context)
+ (function (_ [short-name [_ _ meta _]] imports)
+ (case (macro.get-text-ann (name-of #..jvm-class) meta)
+ (#.Some full-class-name)
+ (add-import [short-name full-class-name] imports)
+
+ _
+ imports)))
..fresh
definitions)))))
(#.Left _) (list)
diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux
index e5a5b3624..2b62b01b0 100644
--- a/stdlib/source/lux/host.old.lux
+++ b/stdlib/source/lux/host.old.lux
@@ -369,19 +369,14 @@
(do macro.monad
[current-module macro.current-module-name
definitions (macro.definitions current-module)]
- (wrap (list@fold (: (-> [Text Global] Class-Imports Class-Imports)
- (function (_ [short-name constant] imports)
- (case constant
- (#.Left _)
- imports
-
- (#.Right [_ _ meta _])
- (case (macro.get-text-ann (name-of #..jvm-class) meta)
- (#.Some full-class-name)
- (add-import [short-name full-class-name] imports)
-
- _
- imports))))
+ (wrap (list@fold (: (-> [Text Definition] Class-Imports Class-Imports)
+ (function (_ [short-name [_ _ meta _]] imports)
+ (case (macro.get-text-ann (name-of #..jvm-class) meta)
+ (#.Some full-class-name)
+ (add-import [short-name full-class-name] imports)
+
+ _
+ imports)))
empty-imports
definitions)))))
(#.Left _)
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index 4843b1fc2..bd8beac14 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -22,7 +22,9 @@
## (type: (Meta a)
## (-> Lux (Try [Lux a])))
-(structure: #export functor (Functor Meta)
+(structure: #export functor
+ (Functor Meta)
+
(def: (map f fa)
(function (_ compiler)
(case (fa compiler)
@@ -32,7 +34,9 @@
(#try.Success [compiler' a])
(#try.Success [compiler' (f a)])))))
-(structure: #export apply (Apply Meta)
+(structure: #export apply
+ (Apply Meta)
+
(def: &functor ..functor)
(def: (apply ff fa)
@@ -49,7 +53,9 @@
(#try.Failure msg)
(#try.Failure msg)))))
-(structure: #export monad (Monad Meta)
+(structure: #export monad
+ (Monad Meta)
+
(def: &functor ..functor)
(def: (wrap x)
@@ -525,6 +531,23 @@
"")
" All Known modules: " (|> compiler (get@ #.modules) (list@map product.left) (text.join-with separator)) text.new-line)))))))
+(def: #export (find-export name)
+ {#.doc "Looks-up a definition's type in the available modules (including the current one)."}
+ (-> Name (Meta Definition))
+ (do ..monad
+ [definition (..find-def name)]
+ (case definition
+ (#.Left de-aliased)
+ (fail ($_ text@compose
+ "Aliases are not considered exports: "
+ (name@encode name)))
+
+ (#.Right definition)
+ (let [[exported? def-type def-data def-value] definition]
+ (if exported?
+ (wrap definition)
+ (fail ($_ text@compose "Definition is not an export: " (name@encode name))))))))
+
(def: #export (find-def-type name)
{#.doc "Looks-up a definition's type in the available modules (including the current one)."}
(-> Name (Meta Type))
@@ -562,32 +585,40 @@
(#.Right [exported? def-type def-data def-value])
(wrap (:coerce Type def-value)))))
-(def: #export (definitions module-name)
- {#.doc "The entire list of definitions in a module (including the non-exported/private ones)."}
+(def: #export (globals module)
+ {#.doc "The entire list of globals in a module (including the non-exported/private ones)."}
(-> Text (Meta (List [Text Global])))
(function (_ compiler)
- (case (get module-name (get@ #.modules compiler))
+ (case (get module (get@ #.modules compiler))
#.None
- (#try.Failure ($_ text@compose "Unknown module: " module-name))
+ (#try.Failure ($_ text@compose "Unknown module: " module))
(#.Some module)
(#try.Success [compiler (get@ #.definitions module)]))))
+(def: #export (definitions module)
+ {#.doc "The entire list of definitions in a module (including the non-exported/private ones)."}
+ (-> Text (Meta (List [Text Definition])))
+ (:: ..monad map
+ (list.search-all (function (_ [name global])
+ (case global
+ (#.Left de-aliased)
+ #.None
+
+ (#.Right definition)
+ (#.Some [name definition]))))
+ (..globals module)))
+
(def: #export (exports module-name)
{#.doc "All the exported definitions in a module."}
(-> Text (Meta (List [Text Definition])))
(do ..monad
- [constants (definitions module-name)]
+ [constants (..definitions module-name)]
(wrap (do list.monad
- [[name definition] constants]
- (case definition
- (#.Left _)
- (list)
-
- (#.Right [exported? def-type def-data def-value])
- (if exported?
- (wrap [name [exported? def-type def-data def-value]])
- (list)))))))
+ [[name [exported? def-type def-data def-value]] constants]
+ (if exported?
+ (wrap [name [exported? def-type def-data def-value]])
+ (list))))))
(def: #export modules
{#.doc "All the available modules (including the current one)."}
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index d36ff8059..cca7205fd 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -3,37 +3,52 @@
[abstract
["." monad (#+ Monad do)]]
[control
- ["ex" exception (#+ exception:)]
+ ["." exception (#+ exception:)]
["." io]
[concurrency
- ["." promise (#+ Promise) ("#;." monad)]]]
+ ["." promise (#+ Promise) ("#@." monad)]]
+ ["<>" parser
+ ["<c>" code]]]
[data
["." product]
+ ["." name]
[number
["n" nat]]
["." text
["%" format (#+ format)]]
[collection
- ["." list ("#;." functor)]]]
+ ["." list ("#@." functor)]
+ ["." set (#+ Set)]]]
[time
["." instant]
- ["." duration]]
+ ["." duration (#+ Duration)]]
[math
- ["r" random (#+ Random) ("#;." monad)]]])
+ ["." random (#+ Random) ("#@." monad)]]
+ ["." macro
+ [syntax (#+ syntax:)]
+ ["." code]]])
(type: #export Counters
{#successes Nat
- #failures Nat})
+ #failures Nat
+ #expected-coverage (Set Name)
+ #actual-coverage (Set Name)})
(def: (add-counters parameter subject)
(-> Counters Counters Counters)
{#successes (n.+ (get@ #successes parameter) (get@ #successes subject))
- #failures (n.+ (get@ #failures parameter) (get@ #failures subject))})
+ #failures (n.+ (get@ #failures parameter) (get@ #failures subject))
+ #expected-coverage (set.union (get@ #expected-coverage parameter)
+ (get@ #expected-coverage subject))
+ #actual-coverage (set.union (get@ #actual-coverage parameter)
+ (get@ #actual-coverage subject))})
(def: start
Counters
{#successes 0
- #failures 0})
+ #failures 0
+ #expected-coverage (set.new name.hash)
+ #actual-coverage (set.new name.hash)})
(template [<name> <category>]
[(def: <name> Counters (update@ <category> .inc start))]
@@ -42,15 +57,18 @@
[failure #failures]
)
+(type: #export Assertion
+ (Promise [Counters Text]))
+
(type: #export Test
- (Random (Promise [Counters Text])))
+ (Random Assertion))
(def: separator text.new-line)
(def: #export (and left right)
{#.doc "Sequencing combinator."}
(-> Test Test Test)
- (do r.monad
+ (do random.monad
[left left
right right]
(wrap (do promise.monad
@@ -63,12 +81,12 @@
(def: #export (context description)
(-> Text Test Test)
- (r;map (promise;map (function (_ [counters documentation])
- [counters (|> documentation
- (text.split-all-with ..separator)
- (list;map (|>> (format context-prefix)))
- (text.join-with ..separator)
- (format description ..separator))]))))
+ (random@map (promise@map (function (_ [counters documentation])
+ [counters (|> documentation
+ (text.split-all-with ..separator)
+ (list@map (|>> (format context-prefix)))
+ (text.join-with ..separator)
+ (format description ..separator))]))))
(def: failure-prefix "[Failure] ")
(def: success-prefix "[Success] ")
@@ -77,13 +95,13 @@
(-> Text Test)
(|>> (format ..failure-prefix)
[failure]
- promise;wrap
- r;wrap))
+ promise@wrap
+ random@wrap))
(def: #export (assert message condition)
{#.doc "Check that a condition is #1, and fail with the given message otherwise."}
- (-> Text Bit (Promise [Counters Text]))
- (<| promise;wrap
+ (-> Text Bit Assertion)
+ (<| promise@wrap
(if condition
[success (format ..success-prefix message)]
[failure (format ..failure-prefix message)])))
@@ -91,11 +109,11 @@
(def: #export (test message condition)
{#.doc "Check that a condition is #1, and fail with the given message otherwise."}
(-> Text Bit Test)
- (:: r.monad wrap (assert message condition)))
+ (:: random.monad wrap (assert message condition)))
(def: #export (lift message random)
(-> Text (Random Bit) Test)
- (:: r.monad map (..assert message) random))
+ (:: random.monad map (..assert message) random))
(def: pcg-32-magic-inc Nat 12345)
@@ -106,13 +124,13 @@
(def: #export (seed value test)
(-> Seed Test Test)
(function (_ prng)
- (let [[_ result] (r.run (r.pcg-32 [..pcg-32-magic-inc value])
- test)]
+ (let [[_ result] (random.run (random.pcg-32 [..pcg-32-magic-inc value])
+ test)]
[prng result])))
(def: failed?
(-> Counters Bit)
- (|>> product.right (n.> 0)))
+ (|>> (get@ #failures) (n.> 0)))
(def: (times-failure seed documentation)
(-> Seed Text Text)
@@ -124,29 +142,37 @@
(def: #export (times amount test)
(-> Nat Test Test)
(cond (n.= 0 amount)
- (fail (ex.construct must-try-test-at-least-once []))
+ (fail (exception.construct must-try-test-at-least-once []))
(n.= 1 amount)
test
## else
- (do r.monad
- [seed r.nat]
+ (do random.monad
+ [seed random.nat]
(function (_ prng)
- (let [[prng' instance] (r.run (r.pcg-32 [..pcg-32-magic-inc seed]) test)]
+ (let [[prng' instance] (random.run (random.pcg-32 [..pcg-32-magic-inc seed]) test)]
[prng' (do promise.monad
[[counters documentation] instance]
(if (failed? counters)
(wrap [counters (times-failure seed documentation)])
- (product.right (r.run prng' (times (dec amount) test)))))])))))
+ (product.right (random.run prng' (times (dec amount) test)))))])))))
-(def: (tally counters)
- (-> Counters Text)
+(def: (tally duration counters)
+ (-> Duration Counters Text)
(let [successes (get@ #successes counters)
- failures (get@ #failures counters)]
- (ex.report ["Tests" (%.nat (n.+ successes failures))]
- ["Successes" (%.nat successes)]
- ["Failures" (%.nat failures)])))
+ failures (get@ #failures counters)
+ missing-coverage (set.difference (get@ #actual-coverage counters)
+ (get@ #expected-coverage counters))
+ unexpected-coverage (set.difference (get@ #expected-coverage counters)
+ (get@ #actual-coverage counters))]
+ (exception.report
+ ["Duration" (%.duration duration)]
+ ["Tests" (%.nat (n.+ successes failures))]
+ ["Successes" (%.nat successes)]
+ ["Failures" (%.nat failures)]
+ ["Missing Coverage" (|> missing-coverage set.to-list (exception.enumerate %.name))]
+ ["Unexpected Coverage" (|> unexpected-coverage set.to-list (exception.enumerate %.name))])))
(def: failure-exit-code -1)
(def: success-exit-code +0)
@@ -156,13 +182,87 @@
(do promise.monad
[pre (promise.future instant.now)
#let [seed (instant.to-millis pre)
- prng (r.pcg-32 [..pcg-32-magic-inc seed])]
- [counters documentation] (|> test (r.run prng) product.right)
+ prng (random.pcg-32 [..pcg-32-magic-inc seed])]
+ [counters documentation] (|> test (random.run prng) product.right)
post (promise.future instant.now)
#let [duration (instant.span pre post)
_ (log! (format documentation text.new-line text.new-line
- "(" (%.duration duration) ")" text.new-line
- (tally counters)))]]
+ (tally duration counters)
+ text.new-line))]]
(promise.future (io.exit (case (get@ #failures counters)
0 ..success-exit-code
_ ..failure-exit-code)))))
+
+(def: (cover' coverage condition)
+ (-> (List Name) Bit Test)
+ (let [message (|> coverage
+ (list@map %.name)
+ (text.join-with " & "))
+ coverage (set.from-list name.hash coverage)]
+ (|> (..assert message condition)
+ (promise@map (function (_ [counters documentation])
+ [(update@ #actual-coverage (set.union coverage) counters)
+ documentation]))
+ (:: random.monad wrap))))
+
+(def: (with-cover' coverage test)
+ (-> (List Name) Test Test)
+ (let [context (|> coverage
+ (list@map %.name)
+ (text.join-with " & "))
+ coverage (set.from-list name.hash coverage)]
+ (random@map (promise@map (function (_ [counters documentation])
+ [(update@ #actual-coverage (set.union coverage) counters)
+ documentation]))
+ (..context context test))))
+
+(def: (name-code name)
+ (-> Name Code)
+ (code.tuple (list (code.text (name.module name))
+ (code.text (name.short name)))))
+
+(syntax: (reference {name <c>.identifier})
+ (do @
+ [_ (macro.find-export name)]
+ (wrap (list (name-code name)))))
+
+(syntax: #export (cover {coverage (<c>.tuple (<>.many <c>.any))}
+ condition)
+ (let [coverage (list@map (function (_ definition)
+ (` ((~! ..reference) (~ definition))))
+ coverage)]
+ (wrap (list (` ((~! ..cover')
+ (: (.List .Name)
+ (.list (~+ coverage)))
+ (~ condition)))))))
+
+(syntax: #export (with-cover {coverage (<c>.tuple (<>.many <c>.any))}
+ test)
+ (let [coverage (list@map (function (_ definition)
+ (` ((~! ..reference) (~ definition))))
+ coverage)]
+ (wrap (list (` ((~! ..with-cover')
+ (: (.List .Name)
+ (.list (~+ coverage)))
+ (~ test)))))))
+
+(def: (covering' module coverage test)
+ (-> Text (List Name) Test Test)
+ (let [coverage (set.from-list name.hash coverage)]
+ (|> (..context module test)
+ (random@map (promise@map (function (_ [counters documentation])
+ [(update@ #expected-coverage (set.union coverage) counters)
+ documentation]))))))
+
+(syntax: #export (covering {module <c>.identifier}
+ test)
+ (do @
+ [#let [module (name.module module)]
+ definitions (macro.definitions module)
+ #let [coverage (|> definitions
+ (list.filter (|>> product.right product.left))
+ (list@map (|>> product.left [module] ..name-code)))]]
+ (wrap (list (` ((~! ..covering')
+ (~ (code.text module))
+ (.list (~+ coverage))
+ (~ test)))))))
diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux
index 70b742236..aa00fa4fd 100644
--- a/stdlib/source/lux/type/abstract.lux
+++ b/stdlib/source/lux/type/abstract.lux
@@ -4,15 +4,15 @@
[monad (#+ Monad do)]]
[control
["ex" exception (#+ exception:)]
- ["p" parser ("#;." monad)
- ["s" code (#+ Parser)]]]
+ ["<>" parser ("#@." monad)
+ ["<c>" code (#+ Parser)]]]
[data
- ["." name ("#;." codec)]
- ["." text ("#;." equivalence monoid)]
+ ["." name ("#@." codec)]
+ ["." text ("#@." equivalence monoid)]
[collection
- ["." list ("#;." functor monoid)]
+ ["." list ("#@." functor monoid)]
["." stack (#+ Stack)]]]
- ["." macro ("#;." monad)
+ ["." macro ("#@." monad)
["." code]
[syntax (#+ syntax:)
["cs" common
@@ -34,7 +34,7 @@
(loop [entries <source>]
(case entries
(#.Cons [head-name head] tail)
- (if (text;= <reference> head-name)
+ (if (text@= <reference> head-name)
<then>
(recur tail))
@@ -67,7 +67,7 @@
(case (case scope
(#.Some scope)
(list.find (function (_ [actual _])
- (text;= scope actual))
+ (text@= scope actual))
current-scopes)
#.None
@@ -82,7 +82,7 @@
(loop [entries <source>]
(case entries
(#.Cons [head-name head] tail)
- (if (text;= <reference> head-name)
+ (if (text@= <reference> head-name)
(#.Cons [head-name <then>]
tail)
(#.Cons [head-name head]
@@ -150,8 +150,8 @@
(def: cast
(Parser [(Maybe Text) Code])
- (p.either (p.and (p.maybe s.local-identifier) s.any)
- (p.and (p;wrap #.None) s.any)))
+ (<>.either (<>.and (<>.maybe <c>.local-identifier) <c>.any)
+ (<>.and (<>@wrap #.None) <c>.any)))
(template [<name> <from> <to>]
[(syntax: #export (<name> {[scope value] cast})
@@ -166,33 +166,33 @@
(def: abstraction-type-name
(-> Name Text)
- (|>> name;encode
- ($_ text;compose
- (name;encode (name-of #..Abstraction))
+ (|>> name@encode
+ ($_ text@compose
+ (name@encode (name-of #..Abstraction))
" ")))
(def: representation-definition-name
(-> Text Text)
- (|>> ($_ text;compose
- (name;encode (name-of #Representation))
+ (|>> ($_ text@compose
+ (name@encode (name-of #Representation))
" ")))
(def: declaration
(Parser [Text (List Text)])
- (p.either (s.form (p.and s.local-identifier (p.some s.local-identifier)))
- (p.and s.local-identifier (:: p.monad wrap (list)))))
+ (<>.either (<c>.form (<>.and <c>.local-identifier (<>.some <c>.local-identifier)))
+ (<>.and <c>.local-identifier (:: <>.monad wrap (list)))))
## TODO: Make sure the generated code always gets optimized away.
## (This applies to uses of ":abstraction" and ":representation")
(syntax: #export (abstract:
{export csr.export}
{[name type-vars] declaration}
- {annotations (p.default cs.empty-annotations csr.annotations)}
+ {annotations (<>.default cs.empty-annotations csr.annotations)}
representation-type
- {primitives (p.some s.any)})
+ {primitives (<>.some <c>.any)})
(do @
[current-module macro.current-module-name
- #let [type-varsC (list;map code.local-identifier type-vars)
+ #let [type-varsC (list@map code.local-identifier type-vars)
abstraction-declaration (` ((~ (code.local-identifier name)) (~+ type-varsC)))
representation-declaration (` ((~ (code.local-identifier (representation-definition-name name)))
(~+ type-varsC)))]
@@ -204,18 +204,18 @@
(~ (csw.annotations annotations))
(primitive (~ (code.text (abstraction-type-name [current-module name])))
[(~+ type-varsC)])))
- (` (type: (~+ (csw.export export)) (~ representation-declaration)
+ (` (type: (~ representation-declaration)
(~ representation-type)))
- ($_ list;compose
+ ($_ list@compose
primitives
(list (` ((~! ..pop!)))))))))
(syntax: #export (:transmutation value)
(wrap (list (` (..:abstraction (..:representation (~ value)))))))
-(syntax: #export (^:representation {name (s.form s.local-identifier)}
+(syntax: #export (^:representation {name (<c>.form <c>.local-identifier)}
body
- {branches (p.some s.any)})
+ {branches (<>.some <c>.any)})
(let [g!var (code.local-identifier name)]
(wrap (list& g!var
(` (.let [(~ g!var) (..:representation (~ g!var))]
diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux
index 55583e45f..1e55c2ab1 100644
--- a/stdlib/source/lux/type/implicit.lux
+++ b/stdlib/source/lux/type/implicit.lux
@@ -114,19 +114,14 @@
(wrap [idx sig-type])))
(def: (prepare-definitions source-module target-module constants)
- (-> Text Text (List [Text Global]) (List [Name Type]))
+ (-> Text Text (List [Text Definition]) (List [Name Type]))
(do list.monad
- [[name constant] constants]
- (case constant
- (#.Left _)
- (list)
-
- (#.Right [exported? def-type def-anns def-value])
- (if (and (macro.structure? def-anns)
- (or (text@= target-module source-module)
- exported?))
- (list [[source-module name] def-type])
- (list)))))
+ [[name [exported? def-type def-anns def-value]] constants]
+ (if (and (macro.structure? def-anns)
+ (or (text@= target-module source-module)
+ exported?))
+ (list [[source-module name] def-type])
+ (list))))
(def: local-env
(Meta (List [Name Type]))
@@ -144,9 +139,9 @@
(def: local-structs
(Meta (List [Name Type]))
(do macro.monad
- [this-module-name macro.current-module-name
- definitions (macro.definitions this-module-name)]
- (wrap (prepare-definitions this-module-name this-module-name definitions))))
+ [this-module-name macro.current-module-name]
+ (:: @ map (prepare-definitions this-module-name this-module-name)
+ (macro.definitions this-module-name))))
(def: import-structs
(Meta (List [Name Type]))
@@ -154,9 +149,8 @@
[this-module-name macro.current-module-name
imp-mods (macro.imported-modules this-module-name)
export-batches (monad.map @ (function (_ imp-mod)
- (do @
- [exports (macro.definitions imp-mod)]
- (wrap (prepare-definitions imp-mod this-module-name exports))))
+ (:: @ map (prepare-definitions imp-mod this-module-name)
+ (macro.definitions imp-mod)))
imp-mods)]
(wrap (list@join export-batches))))
diff --git a/stdlib/source/test/lux/abstract/apply.lux b/stdlib/source/test/lux/abstract/apply.lux
index 87c706f55..c53283233 100644
--- a/stdlib/source/test/lux/abstract/apply.lux
+++ b/stdlib/source/test/lux/abstract/apply.lux
@@ -3,72 +3,71 @@
[abstract/monad (#+ do)]
[data
[number
- ["n" nat]]
- [text
- ["%" format (#+ format)]]]
+ ["n" nat]]]
[control
["." function]]
[math
- ["r" random]]
+ ["." random]]
["_" test (#+ Test)]]
{1
["." / (#+ Apply)]}
[//
[functor (#+ Injection Comparison)]])
-(def: (identity injection comparison (^open "_;."))
+(def: (identity injection comparison (^open "_@."))
(All [f] (-> (Injection f) (Comparison f) (Apply f) Test))
- (do r.monad
- [sample (:: @ map injection r.nat)]
+ (do random.monad
+ [sample (:: @ map injection random.nat)]
(_.test "Identity."
((comparison n.=)
- (_;apply (injection function.identity) sample)
+ (_@apply (injection function.identity) sample)
sample))))
-(def: (homomorphism injection comparison (^open "_;."))
+(def: (homomorphism injection comparison (^open "_@."))
(All [f] (-> (Injection f) (Comparison f) (Apply f) Test))
- (do r.monad
- [sample r.nat
- increase (:: @ map n.+ r.nat)]
+ (do random.monad
+ [sample random.nat
+ increase (:: @ map n.+ random.nat)]
(_.test "Homomorphism."
((comparison n.=)
- (_;apply (injection increase) (injection sample))
+ (_@apply (injection increase) (injection sample))
(injection (increase sample))))))
-(def: (interchange injection comparison (^open "_;."))
+(def: (interchange injection comparison (^open "_@."))
(All [f] (-> (Injection f) (Comparison f) (Apply f) Test))
- (do r.monad
- [sample r.nat
- increase (:: @ map n.+ r.nat)]
+ (do random.monad
+ [sample random.nat
+ increase (:: @ map n.+ random.nat)]
(_.test "Interchange."
((comparison n.=)
- (_;apply (injection increase) (injection sample))
- (_;apply (injection (function (_ f) (f sample))) (injection increase))))))
+ (_@apply (injection increase) (injection sample))
+ (_@apply (injection (function (_ f) (f sample))) (injection increase))))))
-(def: (composition injection comparison (^open "_;."))
+(def: (composition injection comparison (^open "_@."))
(All [f] (-> (Injection f) (Comparison f) (Apply f) Test))
- (do r.monad
- [sample r.nat
- increase (:: @ map n.+ r.nat)
- decrease (:: @ map n.- r.nat)]
+ (do random.monad
+ [sample random.nat
+ increase (:: @ map n.+ random.nat)
+ decrease (:: @ map n.- random.nat)]
(_.test "Composition."
((comparison n.=)
- (_$ _;apply
+ (_$ _@apply
(injection function.compose)
(injection increase)
(injection decrease)
(injection sample))
- ($_ _;apply
+ ($_ _@apply
(injection increase)
(injection decrease)
(injection sample))))))
(def: #export (spec injection comparison apply)
(All [f] (-> (Injection f) (Comparison f) (Apply f) Test))
- (_.context (%.name (name-of /.Apply))
- ($_ _.and
- (..identity injection comparison apply)
- (..homomorphism injection comparison apply)
- (..interchange injection comparison apply)
- (..composition injection comparison apply)
- )))
+ (<| (_.covering /._)
+ (_.with-cover [/.Apply]
+ ($_ _.and
+ (..identity injection comparison apply)
+ (..homomorphism injection comparison apply)
+ (..interchange injection comparison apply)
+ (..composition injection comparison apply)
+ ))))
diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux
index 1d9899539..cb7c94b83 100644
--- a/stdlib/source/test/lux/control/state.lux
+++ b/stdlib/source/test/lux/control/state.lux
@@ -34,26 +34,26 @@
[state r.nat
value r.nat]
($_ _.and
- (_.test "Can get the state as a value."
- (with-conditions [state state]
- /.get))
- (_.test "Can replace the state."
- (with-conditions [state value]
- (do /.monad
- [_ (/.put value)]
- /.get)))
- (_.test "Can update the state."
- (with-conditions [state (n.* value state)]
- (do /.monad
- [_ (/.update (n.* value))]
- /.get)))
- (_.test "Can use the state."
- (with-conditions [state (inc state)]
- (/.use inc)))
- (_.test "Can use a temporary (local) state."
- (with-conditions [state (n.* value state)]
- (/.local (n.* value)
- /.get)))
+ (_.cover [/.State /.get]
+ (with-conditions [state state]
+ /.get))
+ (_.cover [/.put]
+ (with-conditions [state value]
+ (do /.monad
+ [_ (/.put value)]
+ /.get)))
+ (_.cover [/.update]
+ (with-conditions [state (n.* value state)]
+ (do /.monad
+ [_ (/.update (n.* value))]
+ /.get)))
+ (_.cover [/.use]
+ (with-conditions [state (inc state)]
+ (/.use inc)))
+ (_.cover [/.local]
+ (with-conditions [state (n.* value state)]
+ (/.local (n.* value)
+ /.get)))
)))
(def: (injection value)
@@ -72,9 +72,12 @@
[state r.nat
value r.nat]
($_ _.and
- ($functor.spec ..injection (..comparison state) /.functor)
- ($apply.spec ..injection (..comparison state) /.apply)
- ($monad.spec ..injection (..comparison state) /.monad)
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection (..comparison state) /.functor))
+ (_.with-cover [/.apply]
+ ($apply.spec ..injection (..comparison state) /.apply))
+ (_.with-cover [/.monad]
+ ($monad.spec ..injection (..comparison state) /.monad))
)))
(def: loops
@@ -85,18 +88,18 @@
[state /.get]
(wrap (n.< limit state)))]]
($_ _.and
- (_.test "'while' will only execute if the condition is #1."
- (|> (/.while condition (/.update inc))
- (/.run 0)
- (let> [state' output']
- (n.= limit state'))))
- (_.test "'do-while' will execute at least once."
- (|> (/.do-while condition (/.update inc))
- (/.run 0)
- (let> [state' output']
- (or (n.= limit state')
- (and (n.= 0 limit)
- (n.= 1 state'))))))
+ (_.cover [/.while /.run]
+ (|> (/.while condition (/.update inc))
+ (/.run 0)
+ (let> [state' output']
+ (n.= limit state'))))
+ (_.cover [/.do-while]
+ (|> (/.do-while condition (/.update inc))
+ (/.run 0)
+ (let> [state' output']
+ (or (n.= limit state')
+ (and (n.= 0 limit)
+ (n.= 1 state'))))))
)))
(def: monad-transformer
@@ -105,29 +108,25 @@
[state r.nat
left r.nat
right r.nat]
- (let [(^open "io;.") io.monad]
- (_.test "Can add state functionality to any monad."
- (|> (: (/.State' io.IO Nat Nat)
- (do (/.with io.monad)
- [a (/.lift io.monad (io;wrap left))
- b (wrap right)]
- (wrap (n.+ a b))))
- (/.run' state)
- io.run
- (let> [state' output']
- (and (n.= state state')
- (n.= (n.+ left right) output')))))
+ (let [(^open "io@.") io.monad]
+ (_.cover [/.State' /.with /.lift /.run']
+ (|> (: (/.State' io.IO Nat Nat)
+ (do (/.with io.monad)
+ [a (/.lift io.monad (io@wrap left))
+ b (wrap right)]
+ (wrap (n.+ a b))))
+ (/.run' state)
+ io.run
+ (let> [state' output']
+ (and (n.= state state')
+ (n.= (n.+ left right) output')))))
)))
(def: #export test
Test
- (<| (_.context (%.name (name-of /.State)))
+ (<| (_.covering /._)
($_ _.and
- (<| (_.context "Basics.")
- ..basics)
- (<| (_.context "Structures.")
- ..structures)
- (<| (_.context "Loops.")
- ..loops)
- (<| (_.context "Monad transformer.")
- ..monad-transformer))))
+ ..basics
+ ..structures
+ ..loops
+ ..monad-transformer)))
diff --git a/stdlib/source/test/lux/control/thread.lux b/stdlib/source/test/lux/control/thread.lux
index 7d6ed0ceb..49e397d21 100644
--- a/stdlib/source/test/lux/control/thread.lux
+++ b/stdlib/source/test/lux/control/thread.lux
@@ -10,13 +10,13 @@
["$." monad]]}]
[data
[number
- ["n" nat]]
- [text
- ["%" format (#+ format)]]]
+ ["n" nat]]]
[math
- ["r" random]]]
+ ["." random]]]
{1
- ["." / (#+ Thread)]})
+ ["." / (#+ Thread)
+ [//
+ ["." io]]]})
(def: (injection value)
(Injection (All [a !] (Thread ! a)))
@@ -29,20 +29,55 @@
(def: #export test
Test
- (do r.monad
- [original r.nat
- factor r.nat]
- (<| (_.context (%.name (name-of /.Thread)))
+ (do random.monad
+ [sample random.nat
+ factor random.nat]
+ (<| (_.covering /._)
($_ _.and
- ($functor.spec ..injection ..comparison /.functor)
- ($apply.spec ..injection ..comparison /.apply)
- ($monad.spec ..injection ..comparison /.monad)
-
- (_.test "Can safely do mutation."
- (n.= (n.* factor original)
- (/.run (: (All [!] (Thread ! Nat))
- (do /.monad
- [box (/.box original)
- old (/.update (n.* factor) box)]
- (/.read box))))))
+ (_.with-cover [/.Thread]
+ ($_ _.and
+ (_.cover [/.run]
+ (n.= sample
+ (|> sample
+ (:: /.monad wrap)
+ /.run)))
+ (_.cover [/.io]
+ (n.= sample
+ (|> sample
+ (:: /.monad wrap)
+ /.io
+ io.run)))
+
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection ..comparison /.functor))
+ (_.with-cover [/.apply]
+ ($apply.spec ..injection ..comparison /.apply))
+ (_.with-cover [/.monad]
+ ($monad.spec ..injection ..comparison /.monad))
+ ))
+
+ (_.with-cover [/.Box /.box]
+ ($_ _.and
+ (_.cover [/.read]
+ (n.= sample
+ (/.run (: (All [!] (Thread ! Nat))
+ (do /.monad
+ [box (/.box sample)]
+ (/.read box))))))
+
+ (_.cover [/.write]
+ (n.= factor
+ (/.run (: (All [!] (Thread ! Nat))
+ (do /.monad
+ [box (/.box sample)
+ _ (/.write factor box)]
+ (/.read box))))))
+
+ (_.cover [/.update]
+ (n.= (n.* factor sample)
+ (/.run (: (All [!] (Thread ! Nat))
+ (do /.monad
+ [box (/.box sample)
+ old (/.update (n.* factor) box)]
+ (/.read box))))))))
))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 14:09:52 +0000