From 711c573bef4b7a6d809568ebfc196a7f8688307f Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 24 Mar 2019 01:00:56 -0400
Subject: Ported tests for collection-related modules.
---
stdlib/source/lux/data/collection/array.lux | 20 +-
stdlib/source/lux/data/collection/bits.lux | 6 +-
stdlib/source/lux/data/collection/dictionary.lux | 70 ++--
.../lux/data/collection/dictionary/ordered.lux | 28 +-
stdlib/source/lux/data/collection/list.lux | 12 +-
stdlib/source/lux/data/collection/set.lux | 125 +++----
stdlib/source/lux/data/collection/set/ordered.lux | 14 +-
stdlib/source/lux/data/collection/stack.lux | 23 +-
stdlib/source/lux/data/collection/tree/rose.lux | 4 -
stdlib/source/test/lux.lux | 18 -
stdlib/source/test/lux/control/fold.lux | 21 ++
stdlib/source/test/lux/control/functor.lux | 30 +-
stdlib/source/test/lux/data.lux | 4 +-
stdlib/source/test/lux/data/collection.lux | 62 ++++
stdlib/source/test/lux/data/collection/array.lux | 228 ++++++------
stdlib/source/test/lux/data/collection/bits.lux | 139 ++++----
.../source/test/lux/data/collection/dictionary.lux | 228 ++++++------
.../lux/data/collection/dictionary/ordered.lux | 163 +++++----
stdlib/source/test/lux/data/collection/list.lux | 386 +++++++++------------
stdlib/source/test/lux/data/collection/queue.lux | 96 ++---
.../test/lux/data/collection/queue/priority.lux | 79 +++--
stdlib/source/test/lux/data/collection/row.lux | 136 ++++----
.../source/test/lux/data/collection/sequence.lux | 170 +++++----
stdlib/source/test/lux/data/collection/set.lux | 111 +++---
.../test/lux/data/collection/set/ordered.lux | 185 +++++-----
stdlib/source/test/lux/data/collection/stack.lux | 81 +++--
.../source/test/lux/data/collection/tree/rose.lux | 88 ++---
.../test/lux/data/collection/tree/rose/zipper.lux | 203 +++++------
stdlib/source/test/lux/data/maybe.lux | 23 +-
29 files changed, 1414 insertions(+), 1339 deletions(-)
create mode 100644 stdlib/source/test/lux/control/fold.lux
create mode 100644 stdlib/source/test/lux/data/collection.lux
diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux
index 8677ceb62..d135b06d9 100644
--- a/stdlib/source/lux/data/collection/array.lux
+++ b/stdlib/source/lux/data/collection/array.lux
@@ -10,7 +10,7 @@
["." product]
["." maybe]
[collection
- ["." list ("#;." fold)]]]
+ ["." list ("#@." fold)]]]
[tool
[compiler
["." host]]]])
@@ -89,7 +89,7 @@
(Array a)))
(if (n/= 0 length)
dest-array
- (list;fold (function (_ offset target)
+ (list@fold (function (_ offset target)
(case (read (n/+ offset src-start) src-array)
#.None
target
@@ -102,7 +102,7 @@
(def: #export (occupied array)
{#.doc "Finds out how many cells in an array are occupied."}
(All [a] (-> (Array a) Nat))
- (list;fold (function (_ idx count)
+ (list@fold (function (_ idx count)
(case (read idx array)
#.None
count
@@ -120,7 +120,7 @@
(def: #export (filter! p xs)
(All [a]
(-> (-> a Bit) (Array a) (Array a)))
- (list;fold (function (_ idx xs')
+ (list@fold (function (_ idx xs')
(case (read idx xs)
#.None
xs'
@@ -168,7 +168,7 @@
(def: #export (clone xs)
(All [a] (-> (Array a) (Array a)))
(let [arr-size (size xs)]
- (list;fold (function (_ idx ys)
+ (list@fold (function (_ idx ys)
(case (read idx xs)
#.None
ys
@@ -180,7 +180,7 @@
(def: #export (from-list xs)
(All [a] (-> (List a) (Array a)))
- (product.right (list;fold (function (_ x [idx arr])
+ (product.right (list@fold (function (_ x [idx arr])
[(inc idx) (write idx x arr)])
[0 (new (list.size xs))]
xs)))
@@ -211,20 +211,20 @@
(#.Cons (maybe.default default (read idx array))
output)))))
-(structure: #export (equivalence Equivalence)
+(structure: #export (equivalence (^open ",@."))
(All [a] (-> (Equivalence a) (Equivalence (Array a))))
(def: (= xs ys)
(let [sxs (size xs)
sxy (size ys)]
(and (n/= sxy sxs)
- (list;fold (function (_ idx prev)
+ (list@fold (function (_ idx prev)
(and prev
(case [(read idx xs) (read idx ys)]
[#.None #.None]
#1
[(#.Some x) (#.Some y)]
- (:: Equivalence = x y)
+ (,@= x y)
_
#0)))
@@ -246,7 +246,7 @@
(let [arr-size (size ma)]
(if (n/= 0 arr-size)
(new arr-size)
- (list;fold (function (_ idx mb)
+ (list@fold (function (_ idx mb)
(case (read idx ma)
#.None
mb
diff --git a/stdlib/source/lux/data/collection/bits.lux b/stdlib/source/lux/data/collection/bits.lux
index 975605fdc..93158c54c 100644
--- a/stdlib/source/lux/data/collection/bits.lux
+++ b/stdlib/source/lux/data/collection/bits.lux
@@ -10,7 +10,7 @@
[text
format]
[collection
- ["." array (#+ Array) ("#;." fold)]]]])
+ ["." array (#+ Array) ("#@." fold)]]]])
(type: #export Chunk I64)
@@ -27,7 +27,7 @@
(def: #export (size bits)
(-> Bits Nat)
- (array;fold (function (_ chunk total)
+ (array@fold (function (_ chunk total)
(|> chunk i64.count (n/+ total)))
0
bits))
@@ -64,7 +64,7 @@
(let [idx|output (dec size|output)]
(if (n/> 0 size|output)
(case (|> (..chunk idx|output input)
- (cond> [(new> (n/= chunk-index idx|output))]
+ (cond> [(new> (n/= chunk-index idx|output) [])]
[( bit-index)]
## else
diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux
index a1f16311d..9a9663228 100644
--- a/stdlib/source/lux/data/collection/dictionary.lux
+++ b/stdlib/source/lux/data/collection/dictionary.lux
@@ -1,23 +1,23 @@
(.module:
[lux #*
[control
- hash
- [equivalence (#+ Equivalence)]]
+ [hash (#+ Hash)]
+ [equivalence (#+ Equivalence)]
+ [functor (#+ Functor)]]
[data
["." maybe]
["." product]
["." number
["." i64]]
[collection
- ["." list ("#;." fold functor monoid)]
- ["." array (#+ Array) ("#;." functor fold)]]]
+ ["." list ("#@." fold functor monoid)]
+ ["." array (#+ Array) ("#@." functor fold)]]]
])
## This implementation of Hash Array Mapped Trie (HAMT) is based on
## Clojure's PersistentHashMap implementation.
## That one is further based on Phil Bagwell's Hash Array Mapped Trie.
-## [Utils]
## Bitmaps are used to figure out which branches on a #Base node are
## populated. The number of bits that are 1s in a bitmap signal the
## size of the #Base node.
@@ -219,7 +219,7 @@
## nodes to save space.
(def: (demote-hierarchy except-idx [h-size h-array])
(All [k v] (-> Index (Hierarchy k v) [BitMap (Base k v)]))
- (product.right (list;fold (function (_ idx [insertion-idx node])
+ (product.right (list@fold (function (_ idx [insertion-idx node])
(let [[bitmap base] node]
(case (array.read idx h-array)
#.None [insertion-idx node]
@@ -243,7 +243,7 @@
(Hash k) Level
BitMap (Base k v)
(Array (Node k v))))
- (product.right (list;fold (function (_ hierarchy-idx (^@ default [base-idx h-array]))
+ (product.right (list@fold (function (_ hierarchy-idx (^@ default [base-idx h-array]))
(if (bit-position-is-set? (->bit-position hierarchy-idx)
bitmap)
[(inc base-idx)
@@ -500,10 +500,10 @@
(All [k v] (-> (Node k v) Nat))
(case node
(#Hierarchy _size hierarchy)
- (array;fold n/+ 0 (array;map size' hierarchy))
+ (array@fold n/+ 0 (array@map size' hierarchy))
(#Base _ base)
- (array;fold n/+ 0 (array;map (function (_ sub-node')
+ (array@fold n/+ 0 (array@map (function (_ sub-node')
(case sub-node'
(#.Left sub-node) (size' sub-node)
(#.Right _) 1))
@@ -517,15 +517,15 @@
(All [k v] (-> (Node k v) (List [k v])))
(case node
(#Hierarchy _size hierarchy)
- (array;fold (function (_ sub-node tail) (list;compose (entries' sub-node) tail))
+ (array@fold (function (_ sub-node tail) (list@compose (entries' sub-node) tail))
#.Nil
hierarchy)
(#Base bitmap base)
- (array;fold (function (_ branch tail)
+ (array@fold (function (_ branch tail)
(case branch
(#.Left sub-node)
- (list;compose (entries' sub-node) tail)
+ (list@compose (entries' sub-node) tail)
(#.Right [key' val'])
(#.Cons [key' val'] tail)))
@@ -533,11 +533,10 @@
base)
(#Collisions hash colls)
- (array;fold (function (_ [key' val'] tail) (#.Cons [key' val'] tail))
+ (array@fold (function (_ [key' val'] tail) (#.Cons [key' val'] tail))
#.Nil
colls)))
-## [Exports]
(type: #export (Dictionary k v)
{#.doc "A dictionary implemented as a Hash-Array Mapped Trie (HAMT)."}
{#hash (Hash k)
@@ -609,7 +608,7 @@
(def: #export (from-list Hash kvs)
(All [k v] (-> (Hash k) (List [k v]) (Dictionary k v)))
- (list;fold (function (_ [k v] dict)
+ (list@fold (function (_ [k v] dict)
(put k v dict))
(new Hash)
kvs))
@@ -617,7 +616,7 @@
(do-template [ ]
[(def: #export ( dict)
(All [k v] (-> (Dictionary k v) (List )))
- (|> dict entries (list;map )))]
+ (|> dict entries (list@map )))]
[keys k product.left]
[values v product.right]
@@ -627,7 +626,7 @@
{#.doc (doc "Merges 2 dictionaries."
"If any collisions with keys occur, the values of dict2 will overwrite those of dict1.")}
(All [k v] (-> (Dictionary k v) (Dictionary k v) (Dictionary k v)))
- (list;fold (function (_ [key val] dict) (put key val dict))
+ (list@fold (function (_ [key val] dict) (put key val dict))
dict1
(entries dict2)))
@@ -635,7 +634,7 @@
{#.doc (doc "Merges 2 dictionaries."
"If any collisions with keys occur, a new value will be computed by applying 'f' to the values of dict2 and dict1.")}
(All [k v] (-> (-> v v v) (Dictionary k v) (Dictionary k v) (Dictionary k v)))
- (list;fold (function (_ [key val2] dict)
+ (list@fold (function (_ [key val2] dict)
(case (get key dict)
#.None
(put key val2 dict)
@@ -660,23 +659,50 @@
{#.doc "Creates a sub-set of the given dict, with only the specified keys."}
(All [k v] (-> (List k) (Dictionary k v) (Dictionary k v)))
(let [[Hash _] dict]
- (list;fold (function (_ key new-dict)
+ (list@fold (function (_ key new-dict)
(case (get key dict)
#.None new-dict
(#.Some val) (put key val new-dict)))
(new Hash)
keys)))
-## [Structures]
-(structure: #export (equivalence Equivalence) (All [k v] (-> (Equivalence v) (Equivalence (Dictionary k v))))
+(structure: #export (equivalence (^open ",@."))
+ (All [k v] (-> (Equivalence v) (Equivalence (Dictionary k v))))
+
(def: (= test subject)
(and (n/= (size test)
(size subject))
(list.every? (function (_ k)
(case [(get k test) (get k subject)]
[(#.Some tk) (#.Some sk)]
- (:: Equivalence = tk sk)
+ (,@= tk sk)
_
#0))
(keys test)))))
+
+(structure: #export functor
+ (All [k] (Functor (Dictionary k)))
+ (def: (map f fa)
+ (update@ #root
+ (function (recur node)
+ (case node
+ (#Hierarchy size hierarchy)
+ (#Hierarchy size (array@map recur hierarchy))
+
+ (#Base bitmap base)
+ (#Base bitmap (array@map (function (_ either)
+ (case either
+ (#.Left node)
+ (#.Left (recur node))
+
+ (#.Right [k v])
+ (#.Right [k (f v)])))
+ base))
+
+ (#Collisions hash collisions)
+ (#Collisions hash (array@map (function (_ [k v])
+ [k (f v)])
+ collisions))))
+ fa)
+ ))
diff --git a/stdlib/source/lux/data/collection/dictionary/ordered.lux b/stdlib/source/lux/data/collection/dictionary/ordered.lux
index 8b384ca4c..e2d0f21fd 100644
--- a/stdlib/source/lux/data/collection/dictionary/ordered.lux
+++ b/stdlib/source/lux/data/collection/dictionary/ordered.lux
@@ -15,7 +15,9 @@
(def: error-message Text "Invariant violation")
-(type: Color #Red #Black)
+(type: Color
+ #Red
+ #Black)
(type: (Node k v)
{#color Color
@@ -38,19 +40,19 @@
)
(type: #export (Dictionary k v)
- {#order (Order k)
+ {#&order (Order k)
#root (Maybe (Node k v))})
-(def: #export (new Order)
+(def: #export (new order)
(All [k v] (-> (Order k) (Dictionary k v)))
- {#order Order
+ {#&order order
#root #.None})
## TODO: Doing inneficient access of Order functions due to compiler bug.
## TODO: Must improve it as soon as bug is fixed.
(def: #export (get key dict)
(All [k v] (-> k (Dictionary k v) (Maybe v)))
- (let [## (^open "T/.") (get@ #order dict)
+ (let [## (^open "T/.") (get@ #&order dict)
]
(loop [node (get@ #root dict)]
(case node
@@ -73,7 +75,7 @@
(def: #export (contains? key dict)
(All [k v] (-> k (Dictionary k v) Bit))
- (let [## (^open "T/.") (get@ #order dict)
+ (let [## (^open "T/.") (get@ #&order dict)
]
(loop [node (get@ #root dict)]
(case node
@@ -246,7 +248,7 @@
(def: #export (put key value dict)
(All [k v] (-> k v (Dictionary k v) (Dictionary k v)))
- (let [(^open "T/.") (get@ #order dict)
+ (let [(^open "T/.") (get@ #&order dict)
root' (loop [?root (get@ #root dict)]
(case ?root
#.None
@@ -469,7 +471,7 @@
(def: #export (remove key dict)
(All [k v] (-> k (Dictionary k v) (Dictionary k v)))
- (let [(^open "T/.") (get@ #order dict)
+ (let [(^open "T/.") (get@ #&order dict)
[?root found?] (loop [?root (get@ #root dict)]
(case ?root
#.None
@@ -554,9 +556,11 @@
[values v (get@ #value node')]
)
-(structure: #export (equivalence Equivalence) (All [k v] (-> (Equivalence v) (Equivalence (Dictionary k v))))
+(structure: #export (equivalence (^open ",@."))
+ (All [k v] (-> (Equivalence v) (Equivalence (Dictionary k v))))
+
(def: (= reference sample)
- (let [Equivalence (:: sample eq)]
+ (let [(^open "/@.") (get@ #&order reference)]
(loop [entriesR (entries reference)
entriesS (entries sample)]
(case [entriesR entriesS]
@@ -564,8 +568,8 @@
#1
[(#.Cons [keyR valueR] entriesR') (#.Cons [keyS valueS] entriesS')]
- (and (:: Equivalence = keyR keyS)
- (:: Equivalence = valueR valueS)
+ (and (/@= keyR keyS)
+ (,@= valueR valueS)
(recur entriesR' entriesS'))
_
diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux
index 46d47e398..46042d1d7 100644
--- a/stdlib/source/lux/data/collection/list.lux
+++ b/stdlib/source/lux/data/collection/list.lux
@@ -391,7 +391,7 @@
(-> Text Code)
[["" 0 0] (#.Identifier "" name)])
-(def: (nat;encode value)
+(def: (nat@encode value)
(-> Nat Text)
(loop [input value
output ""]
@@ -423,7 +423,7 @@
(if (n/> 0 num-lists)
(let [(^open ".") ..functor
indices (..indices num-lists)
- type-vars (: (List Code) (map (|>> nat;encode identifier$) indices))
+ type-vars (: (List Code) (map (|>> nat@encode identifier$) indices))
zip-type (` (All [(~+ type-vars)]
(-> (~+ (map (: (-> Code Code) (function (_ var) (` (List (~ var)))))
type-vars))
@@ -431,7 +431,7 @@
vars+lists (|> indices
(map inc)
(map (function (_ idx)
- (let [base (nat;encode idx)]
+ (let [base (nat@encode idx)]
[(identifier$ base)
(identifier$ ("lux text concat" base "'"))]))))
pattern (` [(~+ (map (function (_ [v vs]) (` (#.Cons (~ v) (~ vs))))
@@ -469,7 +469,7 @@
indices (..indices num-lists)
g!return-type (identifier$ "0return-type0")
g!func (identifier$ "0func0")
- type-vars (: (List Code) (map (|>> nat;encode identifier$) indices))
+ type-vars (: (List Code) (map (|>> nat@encode identifier$) indices))
zip-type (` (All [(~+ type-vars) (~ g!return-type)]
(-> (-> (~+ type-vars) (~ g!return-type))
(~+ (map (: (-> Code Code) (function (_ var) (` (List (~ var)))))
@@ -478,7 +478,7 @@
vars+lists (|> indices
(map inc)
(map (function (_ idx)
- (let [base (nat;encode idx)]
+ (let [base (nat@encode idx)]
[(identifier$ base)
(identifier$ ("lux text concat" base "'"))]))))
pattern (` [(~+ (map (function (_ [v vs]) (` (#.Cons (~ v) (~ vs))))
@@ -540,7 +540,7 @@
(All [a] (-> (List (List a)) (List a)))
(:: ..monad join xss))
-(structure: #export (with-list monad)
+(structure: #export (with monad)
(All [M] (-> (Monad M) (Monad (All [a] (M (List a))))))
(def: &functor (functor.compose (get@ #monad.&functor monad) ..functor))
diff --git a/stdlib/source/lux/data/collection/set.lux b/stdlib/source/lux/data/collection/set.lux
index 0a195f4eb..5ab374b84 100644
--- a/stdlib/source/lux/data/collection/set.lux
+++ b/stdlib/source/lux/data/collection/set.lux
@@ -2,71 +2,72 @@
[lux #*
[control
[equivalence (#+ Equivalence)]
- ["." hash (#+ Hash)]
- [predicate (#+ Predicate)]]
+ [predicate (#+ Predicate)]
+ [monoid (#+ Monoid)]
+ ["." hash (#+ Hash)]]
[data
[collection
- ["dict" dictionary (#+ Dictionary)]
- ["." list ("#;." fold)]]]
- [type
- abstract]])
+ ["//" dictionary (#+ Dictionary)]
+ ["." list ("#@." fold)]]]])
-(abstract: #export (Set a)
- {}
+(type: #export (Set a)
+ (Dictionary a Any))
+
+(def: #export new
+ (All [a] (-> (Hash a) (Set a)))
+ //.new)
+
+(def: #export size
+ (All [a] (-> (Set a) Nat))
+ //.size)
+
+(def: #export (add elem set)
+ (All [a] (-> a (Set a) (Set a)))
+ (|> set (//.put elem [])))
+
+(def: #export remove
+ (All [a] (-> a (Set a) (Set a)))
+ //.remove)
+
+(def: #export (member? set elem)
+ (All [a] (-> (Set a) a Bit))
+ (//.contains? elem set))
+
+(def: #export to-list
+ (All [a] (-> (Set a) (List a)))
+ //.keys)
+
+(def: #export union
+ (All [a] (-> (Set a) (Set a) (Set a)))
+ //.merge)
+
+(def: #export (difference sub base)
+ (All [a] (-> (Set a) (Set a) (Set a)))
+ (list@fold ..remove base (..to-list sub)))
+
+(def: #export (intersection filter base)
+ (All [a] (-> (Set a) (Set a) (Set a)))
+ (//.select (//.keys filter)
+ base))
+
+(structure: #export equivalence (All [a] (Equivalence (Set a)))
+ (def: (= (^@ reference [hash _]) sample)
+ (:: (list.equivalence (get@ #hash.&equivalence hash)) =
+ (..to-list reference) (..to-list sample))))
+
+(structure: #export hash (All [a] (Hash (Set a)))
+ (def: &equivalence ..equivalence)
- (Dictionary a a)
-
- (def: #export new
- (All [a] (-> (Hash a) (Set a)))
- (|>> dict.new :abstraction))
-
- (def: #export size
- (All [a] (-> (Set a) Nat))
- (|>> :representation dict.size))
-
- (def: #export (add elem set)
- (All [a] (-> a (Set a) (Set a)))
- (|> set :representation (dict.put elem elem) :abstraction))
-
- (def: #export (remove elem set)
- (All [a] (-> a (Set a) (Set a)))
- (|> set :representation (dict.remove elem) :abstraction))
-
- (def: #export (member? set elem)
- (All [a] (-> (Set a) a Bit))
- (|> set :representation (dict.contains? elem)))
-
- (def: #export to-list
- (All [a] (-> (Set a) (List a)))
- (|>> :representation dict.keys))
-
- (def: #export (union xs yx)
- (All [a] (-> (Set a) (Set a) (Set a)))
- (:abstraction (dict.merge (:representation xs) (:representation yx))))
-
- (def: #export (difference sub base)
- (All [a] (-> (Set a) (Set a) (Set a)))
- (list;fold ..remove base (..to-list sub)))
-
- (def: #export (intersection filter base)
- (All [a] (-> (Set a) (Set a) (Set a)))
- (:abstraction (dict.select (dict.keys (:representation filter))
- (:representation base))))
-
- (structure: #export equivalence (All [a] (Equivalence (Set a)))
- (def: (= reference sample)
- (let [[hash _] (:representation reference)]
- (:: (list.equivalence (get@ #hash.&equivalence hash)) =
- (..to-list reference) (..to-list sample)))))
-
- (structure: #export hash (All [a] (Hash (Set a)))
- (def: &equivalence ..equivalence)
-
- (def: (hash set)
- (let [[hash _] (:representation set)]
- (list;fold (function (_ elem acc) (n/+ (:: hash hash elem) acc))
- 0
- (..to-list set)))))
+ (def: (hash (^@ set [hash _]))
+ (list@fold (function (_ elem acc) (n/+ (:: hash hash elem) acc))
+ 0
+ (..to-list set))))
+
+(structure: #export (monoid hash)
+ (All [a] (-> (Hash a) (Monoid (Set a))))
+
+ (def: identity (..new hash))
+ (def: compose ..union)
)
(def: #export empty?
@@ -75,7 +76,7 @@
(def: #export (from-list hash elements)
(All [a] (-> (Hash a) (List a) (Set a)))
- (list;fold ..add (..new hash) elements))
+ (list@fold ..add (..new hash) elements))
(def: #export (sub? super sub)
(All [a] (-> (Set a) (Set a) Bit))
diff --git a/stdlib/source/lux/data/collection/set/ordered.lux b/stdlib/source/lux/data/collection/set/ordered.lux
index 32702ed7f..1be73506b 100644
--- a/stdlib/source/lux/data/collection/set/ordered.lux
+++ b/stdlib/source/lux/data/collection/set/ordered.lux
@@ -5,7 +5,7 @@
[order (#+ Order)]]
[data
[collection
- ["." list ("#;." fold)]
+ ["." list ("#@." fold)]
[dictionary
["/" ordered]]]]
[type
@@ -54,29 +54,29 @@
(All [a] (-> (Set a) (List a)))
(|>> :representation /.keys))
- (def: #export (from-list Order list)
+ (def: #export (from-list &order list)
(All [a] (-> (Order a) (List a) (Set a)))
- (list;fold add (new Order) list))
+ (list@fold add (..new &order) list))
(def: #export (union left right)
(All [a] (-> (Set a) (Set a) (Set a)))
- (list;fold ..add right (..to-list left)))
+ (list@fold ..add right (..to-list left)))
(def: #export (intersection left right)
(All [a] (-> (Set a) (Set a) (Set a)))
(|> (..to-list right)
(list.filter (..member? left))
- (..from-list (get@ #/.order (:representation right)))))
+ (..from-list (get@ #/.&order (:representation right)))))
(def: #export (difference param subject)
(All [a] (-> (Set a) (Set a) (Set a)))
(|> (..to-list subject)
(list.filter (|>> (..member? param) not))
- (..from-list (get@ #/.order (:representation subject)))))
+ (..from-list (get@ #/.&order (:representation subject)))))
(structure: #export equivalence (All [a] (Equivalence (Set a)))
(def: (= reference sample)
- (:: (list.equivalence (:: (:representation sample) eq))
+ (:: (list.equivalence (:: (:representation reference) &equivalence))
= (..to-list reference) (..to-list sample))))
)
diff --git a/stdlib/source/lux/data/collection/stack.lux b/stdlib/source/lux/data/collection/stack.lux
index 2f822ecb1..d3a937cb4 100644
--- a/stdlib/source/lux/data/collection/stack.lux
+++ b/stdlib/source/lux/data/collection/stack.lux
@@ -1,8 +1,11 @@
(.module:
[lux #*
+ [control
+ [equivalence (#+ Equivalence)]
+ [functor (#+ Functor)]]
[data
[collection
- ["." list]]]])
+ ["//" list]]]])
(type: #export (Stack a)
(List a))
@@ -11,13 +14,13 @@
Stack
(list))
-(def: #export (size stack)
+(def: #export size
(All [a] (-> (Stack a) Nat))
- (list.size stack))
+ //.size)
-(def: #export (empty? stack)
+(def: #export empty?
(All [a] (-> (Stack a) Bit))
- (list.empty? stack))
+ //.empty?)
(def: #export (peek stack)
(All [a] (-> (Stack a) (Maybe a)))
@@ -40,3 +43,13 @@
(def: #export (push value stack)
(All [a] (-> a (Stack a) (Stack a)))
(#.Cons value stack))
+
+(def: #export equivalence
+ (All [a]
+ (-> (Equivalence a)
+ (Equivalence (Stack a))))
+ //.equivalence)
+
+(def: #export functor
+ (Functor Stack)
+ //.functor)
diff --git a/stdlib/source/lux/data/collection/tree/rose.lux b/stdlib/source/lux/data/collection/tree/rose.lux
index 7043c2afd..209b6af40 100644
--- a/stdlib/source/lux/data/collection/tree/rose.lux
+++ b/stdlib/source/lux/data/collection/tree/rose.lux
@@ -13,12 +13,10 @@
["." code]
["s" syntax (#+ syntax: Syntax)]]])
-## [Types]
(type: #export (Tree a)
{#value a
#children (List (Tree a))})
-## [Values]
(def: #export (flatten tree)
(All [a] (-> (Tree a) (List a)))
(#.Cons (get@ #value tree)
@@ -34,7 +32,6 @@
{#value value
#children children})
-## [Syntax]
(type: #rec Tree-Code
[Code (List Tree-Code)])
@@ -56,7 +53,6 @@
(` {#value (~ value)
#children (list (~+ (list;map recur children)))})))))))
-## [Structs]
(structure: #export (equivalence Equivalence) (All [a] (-> (Equivalence a) (Equivalence (Tree a))))
(def: (= tx ty)
(and (:: Equivalence = (get@ #value tx) (get@ #value ty))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 3855f350f..781f3edde 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -120,24 +120,6 @@
## [concurrency
## ## [semaphore (#+)]
## ]]
- ## [data
- ## ## [collection
- ## ## [array (#+)]
- ## ## [bits (#+)]
- ## ## [list (#+)]
- ## ## [stack (#+)]
- ## ## [row (#+)]
- ## ## [sequence (#+)]
- ## ## [dictionary (#+)
- ## ## ["dictionary_." ordered]]
- ## ## [set (#+)
- ## ## ["set_." ordered]]
- ## ## [queue (#+)
- ## ## [priority (#+)]]
- ## ## [tree
- ## ## [rose (#+)
- ## ## [zipper (#+)]]]]
- ## ]
## [math (#+)
## [random (#+)]
## [modular (#+)]
diff --git a/stdlib/source/test/lux/control/fold.lux b/stdlib/source/test/lux/control/fold.lux
new file mode 100644
index 000000000..7d7ea8d83
--- /dev/null
+++ b/stdlib/source/test/lux/control/fold.lux
@@ -0,0 +1,21 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ data/text/format
+ ["r" math/random]
+ [control
+ [monad (#+ do)]]]
+ [//
+ [functor (#+ Injection Comparison)]]
+ {1
+ ["." / (#+ Fold)]})
+
+(def: #export (spec injection comparison (^open "/@."))
+ (All [f] (-> (Injection f) (Comparison f) (Fold f) Test))
+ (_.context (%name (name-of /.Fold))
+ (do r.monad
+ [subject r.nat
+ parameter r.nat]
+ (_.test "Can fold."
+ (n/= (/@fold n/+ parameter (injection subject))
+ (n/+ parameter subject))))))
diff --git a/stdlib/source/test/lux/control/functor.lux b/stdlib/source/test/lux/control/functor.lux
index a8fbfa6fc..68c8db55b 100644
--- a/stdlib/source/test/lux/control/functor.lux
+++ b/stdlib/source/test/lux/control/functor.lux
@@ -1,14 +1,12 @@
(.module:
[lux #*
+ ["_" test (#+ Test)]
+ data/text/format
+ ["r" math/random]
[control
+ [equivalence (#+ Equivalence)]
[monad (#+ do)]]
- [data
- [text
- format]]
- ["." function]
- [math
- ["r" random]]
- ["_" test (#+ Test)]]
+ ["." function]]
{1
["." / (#+ Functor)]})
@@ -17,29 +15,29 @@
(type: #export (Comparison f)
(All [a]
- (-> (-> a a Bit)
- (-> (f a) (f a) Bit))))
+ (-> (Equivalence a)
+ (Equivalence (f a)))))
-(def: (identity injection comparison (^open "_;."))
+(def: (identity injection comparison (^open "/@."))
(All [f] (-> (Injection f) (Comparison f) (Functor f) Test))
(do r.monad
[sample (:: @ map injection r.nat)]
(_.test "Identity."
((comparison n/=)
- (_;map function.identity sample)
+ (/@map function.identity sample)
sample))))
-(def: (homomorphism injection comparison (^open "_;."))
+(def: (homomorphism injection comparison (^open "/@."))
(All [f] (-> (Injection f) (Comparison f) (Functor f) Test))
(do r.monad
[sample r.nat
increase (:: @ map n/+ r.nat)]
(_.test "Homomorphism."
((comparison n/=)
- (_;map increase (injection sample))
+ (/@map increase (injection sample))
(injection (increase sample))))))
-(def: (composition injection comparison (^open "_;."))
+(def: (composition injection comparison (^open "/@."))
(All [f] (-> (Injection f) (Comparison f) (Functor f) Test))
(do r.monad
[sample (:: @ map injection r.nat)
@@ -47,8 +45,8 @@
decrease (:: @ map n/- r.nat)]
(_.test "Composition."
((comparison n/=)
- (|> sample (_;map increase) (_;map decrease))
- (|> sample (_;map (|>> increase decrease)))))))
+ (|> sample (/@map increase) (/@map decrease))
+ (|> sample (/@map (|>> increase decrease)))))))
(def: #export (spec injection comparison functor)
(All [f] (-> (Injection f) (Comparison f) (Functor f) Test))
diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux
index 9175d970e..92680f03a 100644
--- a/stdlib/source/test/lux/data.lux
+++ b/stdlib/source/test/lux/data.lux
@@ -24,7 +24,8 @@
["#/." regex]]
[format
["#." json]
- ["#." xml]]])
+ ["#." xml]]
+ ["#." collection]])
(def: number
Test
@@ -66,4 +67,5 @@
..number
..text
..format
+ /collection.test
))
diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux
new file mode 100644
index 000000000..ad86d3225
--- /dev/null
+++ b/stdlib/source/test/lux/data/collection.lux
@@ -0,0 +1,62 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]]
+ ["." / #_
+ ["#." array]
+ ["#." bits]
+ ["#." list]
+ ["#." row]
+ ["#." sequence]
+ ["#." stack]
+ ["#." dictionary
+ ["#/." ordered]]
+ ["#." queue
+ ["#/." priority]]
+ ["#." set
+ ["#/." ordered]]
+ ["#." tree #_
+ ["#/." rose
+ ["#/." zipper]]]])
+
+(def: dictionary
+ Test
+ ($_ _.and
+ /dictionary.test
+ /dictionary/ordered.test
+ ))
+
+(def: queue
+ Test
+ ($_ _.and
+ /queue.test
+ /queue/priority.test
+ ))
+
+(def: set
+ Test
+ ($_ _.and
+ /set.test
+ /set/ordered.test
+ ))
+
+(def: tree
+ Test
+ ($_ _.and
+ /tree/rose.test
+ /tree/rose/zipper.test
+ ))
+
+(def: #export test
+ Test
+ ($_ _.and
+ /array.test
+ /bits.test
+ /list.test
+ /row.test
+ /sequence.test
+ /stack.test
+ ..dictionary
+ ..queue
+ ..set
+ ..tree
+ ))
diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux
index 47c384cb7..8814a6e88 100644
--- a/stdlib/source/test/lux/data/collection/array.lux
+++ b/stdlib/source/test/lux/data/collection/array.lux
@@ -1,143 +1,117 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
+ pipe
[monad (#+ do Monad)]
- pipe]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." monoid]
+ ["$." fold]
+ ["$." functor (#+ Injection)]]}]
[data
- ["." number]
["." maybe]
+ [number
+ ["." nat]]
[collection
- ["@" array (#+ Array)]
["." list]]]
[math
- ["r" random]]]
- lux/test)
+ ["r" random (#+ Random)]]]
+ {1
+ ["." / (#+ Array)]})
+
+(def: injection
+ (Injection Array)
+ (|>> list /.from-list))
(def: bounded-size
- (r.Random Nat)
+ (Random Nat)
(|> r.nat
(:: r.monad map (|>> (n/% 100) (n/+ 1)))))
-(context: "Arrays and their copies"
- (<| (times 100)
- (do @
- [size bounded-size
- original (r.array size r.nat)
- #let [clone (@.clone original)
- copy (: (Array Nat)
- (@.new size))
- manual-copy (: (Array Nat)
- (@.new size))]]
- ($_ seq
- (test "Size function must correctly return size of array."
- (n/= size (@.size original)))
- (test "Cloning an array should yield and identical array, but not the same one."
- (and (:: (@.equivalence number.equivalence) = original clone)
- (not (is? original clone))))
- (test "Full-range manual copies should give the same result as cloning."
- (exec (@.copy size 0 original 0 copy)
- (and (:: (@.equivalence number.equivalence) = original copy)
- (not (is? original copy)))))
- (test "Array folding should go over all values."
- (exec (:: @.fold fold
- (function (_ x idx)
- (exec (@.write idx x manual-copy)
- (inc idx)))
- 0
- original)
- (:: (@.equivalence number.equivalence) = original manual-copy)))
- (test "Transformations between (full) arrays and lists shouldn't cause lose or change any values."
- (|> original
- @.to-list @.from-list
- (:: (@.equivalence number.equivalence) = original)))
- ))))
-
-(context: "Array mutation"
- (<| (times 100)
- (do @
- [size bounded-size
- idx (:: @ map (n/% size) r.nat)
- array (|> (r.array size r.nat)
- (r.filter (|>> @.to-list (list.any? n/odd?))))
- #let [value (maybe.assume (@.read idx array))]]
- ($_ seq
- (test "Shouldn't be able to find a value in an unoccupied cell."
- (case (@.read idx (@.delete idx array))
- (#.Some _) #0
- #.None #1))
- (test "You should be able to access values put into the array."
- (case (@.read idx (@.write idx value array))
- (#.Some value') (n/= value' value)
- #.None #0))
- (test "All cells should be occupied on a full array."
- (and (n/= size (@.occupied array))
- (n/= 0 (@.vacant array))))
- (test "Filtering mutates the array to remove invalid values."
- (exec (@.filter! n/even? array)
- (and (n/< size (@.occupied array))
- (n/> 0 (@.vacant array))
- (n/= size (n/+ (@.occupied array)
- (@.vacant array))))))
- ))))
-
-(context: "Finding values."
- (<| (times 100)
- (do @
- [size bounded-size
- array (|> (r.array size r.nat)
- (r.filter (|>> @.to-list (list.any? n/even?))))]
- ($_ seq
- (test "Can find values inside arrays."
- (|> (@.find n/even? array)
- (case> (#.Some _) #1
- #.None #0)))
- (test "Can find values inside arrays (with access to indices)."
- (|> (@.find+ (function (_ idx n)
- (and (n/even? n)
- (n/< size idx)))
- array)
- (case> (#.Some _) #1
- #.None #0)))))))
-
-(context: "Functor"
- (<| (times 100)
- (do @
- [size bounded-size
- array (r.array size r.nat)]
- (let [(^open ".") @.functor
- (^open ".") (@.equivalence number.equivalence)]
- ($_ seq
- (test "Functor shouldn't alter original array."
- (let [copy (map id array)]
- (and (= array copy)
- (not (is? array copy)))))
- (test "Functor should go over all available array elements."
- (let [there (map inc array)
- back-again (map dec there)]
- (and (not (= array there))
- (= array back-again)))))))))
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Array)))
+ (do r.monad
+ [size bounded-size]
+ ($_ _.and
+ ($equivalence.spec (/.equivalence nat.equivalence) (r.array size r.nat))
+ ($monoid.spec (/.equivalence nat.equivalence) /.monoid (r.array size r.nat))
+ ($functor.spec ..injection /.equivalence /.functor)
+ ($fold.spec ..injection /.equivalence /.fold)
-(context: "Monoid"
- (<| (times 100)
- (do @
- [sizeL bounded-size
- sizeR bounded-size
- left (r.array sizeL r.nat)
- right (r.array sizeR r.nat)
- #let [(^open ".") @.monoid
- (^open ".") (@.equivalence number.equivalence)
- fusion (compose left right)]]
- ($_ seq
- (test "Appending two arrays should produce a new one twice as large."
- (n/= (n/+ sizeL sizeR) (@.size fusion)))
- (test "First elements of fused array should equal the first array."
- (|> (: (Array Nat)
- (@.new sizeL))
- (@.copy sizeL 0 fusion 0)
- (= left)))
- (test "Last elements of fused array should equal the second array."
- (|> (: (Array Nat)
- (@.new sizeR))
- (@.copy sizeR sizeL fusion 0)
- (= right)))
+ (do r.monad
+ [size bounded-size
+ original (r.array size r.nat)]
+ ($_ _.and
+ (_.test "Size function must correctly return size of array."
+ (n/= size (/.size original)))
+ (_.test "Cloning an array should yield and identical array, but not the same one."
+ (let [clone (/.clone original)]
+ (and (:: (/.equivalence nat.equivalence) = original clone)
+ (not (is? original clone)))))
+ (_.test "Full-range manual copies should give the same result as cloning."
+ (let [copy (: (Array Nat)
+ (/.new size))]
+ (exec (/.copy size 0 original 0 copy)
+ (and (:: (/.equivalence nat.equivalence) = original copy)
+ (not (is? original copy))))))
+ (_.test "Array folding should go over all values."
+ (let [manual-copy (: (Array Nat)
+ (/.new size))]
+ (exec (:: /.fold fold
+ (function (_ x idx)
+ (exec (/.write idx x manual-copy)
+ (inc idx)))
+ 0
+ original)
+ (:: (/.equivalence nat.equivalence) = original manual-copy))))
+ (_.test "Transformations between (full) arrays and lists shouldn't cause lose or change any values."
+ (|> original
+ /.to-list /.from-list
+ (:: (/.equivalence nat.equivalence) = original)))
+ ))
+ (do r.monad
+ [size bounded-size
+ idx (:: @ map (n/% size) r.nat)
+ array (|> (r.array size r.nat)
+ (r.filter (|>> /.to-list (list.any? n/odd?))))
+ #let [value (maybe.assume (/.read idx array))]]
+ ($_ _.and
+ (_.test "Shouldn't be able to find a value in an unoccupied cell."
+ (case (/.read idx (/.delete idx array))
+ (#.Some _) false
+ #.None true))
+ (_.test "You should be able to access values put into the array."
+ (case (/.read idx (/.write idx value array))
+ (#.Some value') (n/= value' value)
+ #.None false))
+ (_.test "All cells should be occupied on a full array."
+ (and (n/= size (/.occupied array))
+ (n/= 0 (/.vacant array))))
+ (_.test "Filtering mutates the array to remove invalid values."
+ (exec (/.filter! n/even? array)
+ (and (n/< size (/.occupied array))
+ (n/> 0 (/.vacant array))
+ (n/= size (n/+ (/.occupied array)
+ (/.vacant array))))))
+ ))
+ (do r.monad
+ [size bounded-size
+ array (|> (r.array size r.nat)
+ (r.filter (|>> /.to-list (list.any? n/even?))))]
+ ($_ _.and
+ (_.test "Can find values inside arrays."
+ (|> (/.find n/even? array)
+ (case> (#.Some _) true
+ #.None false)))
+ (_.test "Can find values inside arrays (with access to indices)."
+ (|> (/.find+ (function (_ idx n)
+ (and (n/even? n)
+ (n/< size idx)))
+ array)
+ (case> (#.Some _) true
+ #.None false)))))
))))
diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux
index e932aacef..ac7e983f9 100644
--- a/stdlib/source/test/lux/data/collection/bits.lux
+++ b/stdlib/source/test/lux/data/collection/bits.lux
@@ -1,87 +1,82 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
[monad (#+ do)]
- ["." predicate]]
- [data
- [collection
- ["/" bits]]]
+ ["." predicate]
+ {[0 #test]
+ [/
+ ["$." equivalence]]}]
[math
- ["r" random]]]
- lux/test
- [test
- [lux
- [control
- ["_eq" equivalence]]]])
+ ["r" random (#+ Random)]]]
+ {1
+ ["." / (#+ Bits)]})
(def: (size min max)
- (-> Nat Nat (r.Random Nat))
+ (-> Nat Nat (Random Nat))
(|> r.nat
(:: r.monad map (|>> (n/% max) (n/max min)))))
-(def: bits
- (r.Random /.Bits)
+(def: #export bits
+ (Random Bits)
(do r.monad
[size (size 1 1,000)
idx (|> r.nat (:: @ map (n/% size)))]
(wrap (|> /.empty (/.set idx)))))
-(context: "Bits."
- (<| (times 100)
- (do @
- [size (size 1 1,000)
- idx (|> r.nat (:: @ map (n/% size)))
- sample bits]
- ($_ seq
- (test "Can set individual bits."
- (and (|> /.empty (/.get idx) not)
- (|> /.empty (/.set idx) (/.get idx))))
- (test "Can clear individual bits."
- (|> /.empty (/.set idx) (/.clear idx) (/.get idx) not))
- (test "Can flip individual bits."
- (and (|> /.empty (/.flip idx) (/.get idx))
- (|> /.empty (/.flip idx) (/.flip idx) (/.get idx) not)))
-
- (test "Bits (only) grow when (and as much as) necessary."
- (and (n/= 0 (/.capacity /.empty))
- (|> /.empty (/.set idx) /.capacity
- (n/- idx)
- (predicate.union (n/>= 0)
- (n/< /.chunk-size)))))
- (test "Bits (must) shrink when (and as much as) possible."
- (let [grown (/.flip idx /.empty)]
- (and (n/> 0 (/.capacity grown))
- (is? /.empty (/.flip idx grown)))))
-
- (test "Intersection can be detected when there are set bits in common."
- (and (not (/.intersects? /.empty
- /.empty))
- (/.intersects? (/.set idx /.empty)
- (/.set idx /.empty))
- (not (/.intersects? (/.set (inc idx) /.empty)
- (/.set idx /.empty)))))
- (test "Cannot intersect with one's opposite."
- (not (/.intersects? sample (/.not sample))))
-
- (test "'and' with oneself changes nothing"
- (:: /.equivalence = sample (/.and sample sample)))
- (test "'and' with one's opposite yields the empty bit-set."
- (is? /.empty (/.and sample (/.not sample))))
-
- (test "'or' with one's opposite fully saturates a bit-set."
- (n/= (/.size (/.or sample (/.not sample)))
- (/.capacity sample)))
-
- (test "'xor' with oneself yields the empty bit-set."
- (is? /.empty (/.xor sample sample)))
- (test "'xor' with one's opposite fully saturates a bit-set."
- (n/= (/.size (/.xor sample (/.not sample)))
- (/.capacity sample)))
-
- (test "Double negation results in original bit-set."
- (:: /.equivalence = sample (/.not (/.not sample))))
- (test "Negation does not affect the empty bit-set."
- (is? /.empty (/.not /.empty)))
-
- (_eq.spec /.equivalence ..bits)
- ))))
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Bits)))
+ ($_ _.and
+ ($equivalence.spec /.equivalence ..bits)
+ (do r.monad
+ [size (size 1 1,000)
+ idx (|> r.nat (:: @ map (n/% size)))
+ sample bits]
+ ($_ _.and
+ (_.test "Can set individual bits."
+ (and (|> /.empty (/.get idx) not)
+ (|> /.empty (/.set idx) (/.get idx))))
+ (_.test "Can clear individual bits."
+ (|> /.empty (/.set idx) (/.clear idx) (/.get idx) not))
+ (_.test "Can flip individual bits."
+ (and (|> /.empty (/.flip idx) (/.get idx))
+ (|> /.empty (/.flip idx) (/.flip idx) (/.get idx) not)))
+ (_.test "Bits (only) grow when (and as much as) necessary."
+ (and (n/= 0 (/.capacity /.empty))
+ (|> /.empty (/.set idx) /.capacity
+ (n/- idx)
+ (predicate.union (n/>= 0)
+ (n/< /.chunk-size)))))
+ (_.test "Bits (must) shrink when (and as much as) possible."
+ (let [grown (/.flip idx /.empty)]
+ (and (n/> 0 (/.capacity grown))
+ (is? /.empty (/.flip idx grown)))))
+ (_.test "Intersection can be detected when there are set bits in common."
+ (and (not (/.intersects? /.empty
+ /.empty))
+ (/.intersects? (/.set idx /.empty)
+ (/.set idx /.empty))
+ (not (/.intersects? (/.set (inc idx) /.empty)
+ (/.set idx /.empty)))))
+ (_.test "Cannot intersect with one's opposite."
+ (not (/.intersects? sample (/.not sample))))
+ (_.test "'and' with oneself changes nothing"
+ (:: /.equivalence = sample (/.and sample sample)))
+ (_.test "'and' with one's opposite yields the empty bit-set."
+ (is? /.empty (/.and sample (/.not sample))))
+
+ (_.test "'or' with one's opposite fully saturates a bit-set."
+ (n/= (/.size (/.or sample (/.not sample)))
+ (/.capacity sample)))
+ (_.test "'xor' with oneself yields the empty bit-set."
+ (is? /.empty (/.xor sample sample)))
+ (_.test "'xor' with one's opposite fully saturates a bit-set."
+ (n/= (/.size (/.xor sample (/.not sample)))
+ (/.capacity sample)))
+ (_.test "Double negation results in original bit-set."
+ (:: /.equivalence = sample (/.not (/.not sample))))
+ (_.test "Negation does not affect the empty bit-set."
+ (is? /.empty (/.not /.empty)))
+ )))))
diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux
index 80d673574..e559a2453 100644
--- a/stdlib/source/test/lux/data/collection/dictionary.lux
+++ b/stdlib/source/test/lux/data/collection/dictionary.lux
@@ -1,129 +1,129 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
- [monad (#+ do Monad)]
- ["eq" equivalence]]
+ [monad (#+ do)]
+ ["eq" equivalence]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." functor (#+ Injection)]]}]
[data
- ["." number]
["." maybe]
+ [number
+ ["." nat]]
[collection
- ["&" dictionary]
- ["." list ("#;." functor)]]]
+ ["." list ("#@." functor)]]]
[math
["r" random]]]
- lux/test)
+ {1
+ ["." /]})
-(context: "Dictionaries."
- (<| (times 100)
- (do @
+(def: injection
+ (Injection (/.Dictionary Nat))
+ (|>> [0] list (/.from-list nat.hash)))
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Dictionary)))
+ (do r.monad
[#let [capped-nat (:: r.monad map (n/% 100) r.nat)]
size capped-nat
- dict (r.dictionary number.hash size r.nat capped-nat)
- non-key (|> r.nat (r.filter (function (_ key) (not (&.contains? key dict)))))
- test-val (|> r.nat (r.filter (function (_ val) (not (list.member? number.equivalence (&.values dict) val)))))]
- ($_ seq
- (test "Size function should correctly represent Dictionary size."
- (n/= size (&.size dict)))
-
- (test "Dictionaries of size 0 should be considered empty."
- (if (n/= 0 size)
- (&.empty? dict)
- (not (&.empty? dict))))
-
- (test "The functions 'entries', 'keys' and 'values' should be synchronized."
- (:: (list.equivalence (eq.product number.equivalence number.equivalence)) =
- (&.entries dict)
- (list.zip2 (&.keys dict)
- (&.values dict))))
-
- (test "Dictionary should be able to recognize it's own keys."
- (list.every? (function (_ key) (&.contains? key dict))
- (&.keys dict)))
-
- (test "Should be able to get every key."
- (list.every? (function (_ key) (case (&.get key dict)
- (#.Some _) #1
- _ #0))
- (&.keys dict)))
-
- (test "Shouldn't be able to access non-existant keys."
- (case (&.get non-key dict)
- (#.Some _) #0
- _ #1))
-
- (test "Should be able to put and then get a value."
- (case (&.get non-key (&.put non-key test-val dict))
- (#.Some v) (n/= test-val v)
- _ #1))
-
- (test "Should be able to put~ and then get a value."
- (case (&.get non-key (&.put~ non-key test-val dict))
- (#.Some v) (n/= test-val v)
- _ #1))
+ dict (r.dictionary nat.hash size r.nat capped-nat)
+ non-key (|> r.nat (r.filter (function (_ key) (not (/.contains? key dict)))))
+ test-val (|> r.nat (r.filter (function (_ val) (not (list.member? nat.equivalence (/.values dict) val)))))]
+ ($_ _.and
+ ($equivalence.spec (/.equivalence nat.equivalence)
+ (r.dictionary nat.hash size r.nat r.nat))
+ ($functor.spec ..injection /.equivalence /.functor)
- (test "Shouldn't be able to put~ an existing key."
- (or (n/= 0 size)
- (let [first-key (|> dict &.keys list.head maybe.assume)]
- (case (&.get first-key (&.put~ first-key test-val dict))
- (#.Some v) (not (n/= test-val v))
- _ #1))))
-
- (test "Removing a key should make it's value inaccessible."
- (let [base (&.put non-key test-val dict)]
- (and (&.contains? non-key base)
- (not (&.contains? non-key (&.remove non-key base))))))
-
- (test "Should be possible to update values via their keys."
- (let [base (&.put non-key test-val dict)
- updt (&.update non-key inc base)]
- (case [(&.get non-key base) (&.get non-key updt)]
- [(#.Some x) (#.Some y)]
- (n/= (inc x) y)
-
- _
- #0)))
-
- (test "Additions and removals to a Dictionary should affect its size."
- (let [plus (&.put non-key test-val dict)
- base (&.remove non-key plus)]
- (and (n/= (inc (&.size dict)) (&.size plus))
- (n/= (dec (&.size plus)) (&.size base)))))
-
- (test "A Dictionary should equal itself & going to<->from lists shouldn't change that."
- (let [(^open ".") (&.equivalence number.equivalence)]
- (and (= dict dict)
- (|> dict &.entries (&.from-list number.hash) (= dict)))))
-
- (test "Merging a Dictionary to itself changes nothing."
- (let [(^open ".") (&.equivalence number.equivalence)]
- (= dict (&.merge dict dict))))
-
- (test "If you merge, and the second dict has overlapping keys, it should overwrite yours."
- (let [dict' (|> dict &.entries
- (list;map (function (_ [k v]) [k (inc v)]))
- (&.from-list number.hash))
- (^open ".") (&.equivalence number.equivalence)]
- (= dict' (&.merge dict' dict))))
-
- (test "Can merge values in such a way that they become combined."
- (list.every? (function (_ [x x*2]) (n/= (n/* 2 x) x*2))
- (list.zip2 (&.values dict)
- (&.values (&.merge-with n/+ dict dict)))))
+ (_.test "Size function should correctly represent Dictionary size."
+ (n/= size (/.size dict)))
+ (_.test "Dictionaries of size 0 should be considered empty."
+ (if (n/= 0 size)
+ (/.empty? dict)
+ (not (/.empty? dict))))
+ (_.test "The functions 'entries', 'keys' and 'values' should be synchronized."
+ (:: (list.equivalence (eq.product nat.equivalence nat.equivalence)) =
+ (/.entries dict)
+ (list.zip2 (/.keys dict)
+ (/.values dict))))
+ (_.test "Dictionary should be able to recognize it's own keys."
+ (list.every? (function (_ key) (/.contains? key dict))
+ (/.keys dict)))
+ (_.test "Should be able to get every key."
+ (list.every? (function (_ key) (case (/.get key dict)
+ (#.Some _) #1
+ _ #0))
+ (/.keys dict)))
+ (_.test "Shouldn't be able to access non-existant keys."
+ (case (/.get non-key dict)
+ (#.Some _) #0
+ _ #1))
+ (_.test "Should be able to put and then get a value."
+ (case (/.get non-key (/.put non-key test-val dict))
+ (#.Some v) (n/= test-val v)
+ _ #1))
- (test "Should be able to select subset of keys from dict."
- (|> dict
- (&.put non-key test-val)
- (&.select (list non-key))
- &.size
- (n/= 1)))
+ (_.test "Should be able to try-put and then get a value."
+ (case (/.get non-key (/.try-put non-key test-val dict))
+ (#.Some v) (n/= test-val v)
+ _ #1))
+ (_.test "Shouldn't be able to try-put an existing key."
+ (or (n/= 0 size)
+ (let [first-key (|> dict /.keys list.head maybe.assume)]
+ (case (/.get first-key (/.try-put first-key test-val dict))
+ (#.Some v) (not (n/= test-val v))
+ _ #1))))
+ (_.test "Removing a key should make it's value inaccessible."
+ (let [base (/.put non-key test-val dict)]
+ (and (/.contains? non-key base)
+ (not (/.contains? non-key (/.remove non-key base))))))
+ (_.test "Should be possible to update values via their keys."
+ (let [base (/.put non-key test-val dict)
+ updt (/.update non-key inc base)]
+ (case [(/.get non-key base) (/.get non-key updt)]
+ [(#.Some x) (#.Some y)]
+ (n/= (inc x) y)
- (test "Should be able to re-bind existing values to different keys."
- (or (n/= 0 size)
- (let [first-key (|> dict &.keys list.head maybe.assume)
- rebound (&.re-bind first-key non-key dict)]
- (and (n/= (&.size dict) (&.size rebound))
- (&.contains? non-key rebound)
- (not (&.contains? first-key rebound))
- (n/= (maybe.assume (&.get first-key dict))
- (maybe.assume (&.get non-key rebound)))))))
+ _
+ #0)))
+ (_.test "Additions and removals to a Dictionary should affect its size."
+ (let [plus (/.put non-key test-val dict)
+ base (/.remove non-key plus)]
+ (and (n/= (inc (/.size dict)) (/.size plus))
+ (n/= (dec (/.size plus)) (/.size base)))))
+ (_.test "A Dictionary should equal itself & going to<->from lists shouldn't change that."
+ (let [(^open ".") (/.equivalence nat.equivalence)]
+ (and (= dict dict)
+ (|> dict /.entries (/.from-list nat.hash) (= dict)))))
+ (_.test "Merging a Dictionary to itself changes nothing."
+ (let [(^open ".") (/.equivalence nat.equivalence)]
+ (= dict (/.merge dict dict))))
+ (_.test "If you merge, and the second dict has overlapping keys, it should overwrite yours."
+ (let [dict' (|> dict /.entries
+ (list@map (function (_ [k v]) [k (inc v)]))
+ (/.from-list nat.hash))
+ (^open ".") (/.equivalence nat.equivalence)]
+ (= dict' (/.merge dict' dict))))
+ (_.test "Can merge values in such a way that they become combined."
+ (list.every? (function (_ [x x*2]) (n/= (n/* 2 x) x*2))
+ (list.zip2 (/.values dict)
+ (/.values (/.merge-with n/+ dict dict)))))
+ (_.test "Should be able to select subset of keys from dict."
+ (|> dict
+ (/.put non-key test-val)
+ (/.select (list non-key))
+ /.size
+ (n/= 1)))
+ (_.test "Should be able to re-bind existing values to different keys."
+ (or (n/= 0 size)
+ (let [first-key (|> dict /.keys list.head maybe.assume)
+ rebound (/.re-bind first-key non-key dict)]
+ (and (n/= (/.size dict) (/.size rebound))
+ (/.contains? non-key rebound)
+ (not (/.contains? first-key rebound))
+ (n/= (maybe.assume (/.get first-key dict))
+ (maybe.assume (/.get non-key rebound)))))))
))))
diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux
index 2d1f5a0ba..4cd7880ba 100644
--- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux
+++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux
@@ -1,91 +1,110 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
- [monad (#+ Monad do)]
- [equivalence (#+ Equivalence)]]
+ [monad (#+ do)]
+ [equivalence (#+ Equivalence)]
+ [order (#+ Order)]
+ {[0 #test]
+ [/
+ ["$." equivalence]]}]
[data
["." product]
- ["." number]
+ [number
+ ["." nat]]
[collection
- ["s" set]
- ["dict" dictionary
- ["&" ordered]]
- ["." list ("#;." functor)]]]
+ ["." set]
+ ["." list ("#@." functor)]]]
[math
- ["r" random]]]
- lux/test)
+ ["r" random (#+ Random) ("#@." monad)]]]
+ {1
+ ["." /]})
-(context: "Dictionary"
- (<| (times 100)
- (do @
+(def: #export (dictionary order gen-key gen-value size)
+ (All [k v]
+ (-> (Order k) (Random k) (Random v) Nat (Random (/.Dictionary k v))))
+ (case size
+ 0
+ (r@wrap (/.new order))
+
+ _
+ (do r.monad
+ [partial (dictionary order gen-key gen-value (dec size))
+ key (r.filter (function (_ candidate)
+ (not (/.contains? candidate partial)))
+ gen-key)
+ value gen-value]
+ (wrap (/.put key value partial)))))
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Dictionary)))
+ (do r.monad
[size (|> r.nat (:: @ map (n/% 100)))
- keys (r.set number.nat-hash size r.nat)
- values (r.set number.nat-hash size r.nat)
- extra-key (|> r.nat (r.filter (|>> (s.member? keys) not)))
+ keys (r.set nat.hash size r.nat)
+ values (r.set nat.hash size r.nat)
+ extra-key (|> r.nat (r.filter (|>> (set.member? keys) not)))
extra-value r.nat
- #let [pairs (list.zip2 (s.to-list keys)
- (s.to-list values))
- sample (&.from-list number.nat-order pairs)
+ #let [pairs (list.zip2 (set.to-list keys)
+ (set.to-list values))
+ sample (/.from-list nat.order pairs)
sorted-pairs (list.sort (function (_ [left _] [right _])
(n/< left right))
pairs)
- sorted-values (list;map product.right sorted-pairs)
- (^open "&;.") (&.equivalence number.nat-equivalence)]]
- ($_ seq
- (test "Can query the size of a dictionary."
- (n/= size (&.size sample)))
-
- (test "Can query value for minimum key."
- (case [(&.min sample) (list.head sorted-values)]
- [#.None #.None]
- #1
-
- [(#.Some reference) (#.Some sample)]
- (n/= reference sample)
-
- _
- #0))
-
- (test "Can query value for maximum key."
- (case [(&.max sample) (list.last sorted-values)]
- [#.None #.None]
- #1
-
- [(#.Some reference) (#.Some sample)]
- (n/= reference sample)
-
- _
- #0))
+ sorted-values (list@map product.right sorted-pairs)
+ (^open "/@.") (/.equivalence nat.equivalence)]]
+ ($_ _.and
+ ($equivalence.spec (/.equivalence nat.equivalence) (..dictionary nat.order r.nat r.nat size))
+
+ (_.test "Can query the size of a dictionary."
+ (n/= size (/.size sample)))
+ (_.test "Can query value for minimum key."
+ (case [(/.min sample) (list.head sorted-values)]
+ [#.None #.None]
+ #1
- (test "Converting dictionaries to/from lists cannot change their values."
- (|> sample
- &.entries (&.from-list number.nat-order)
- (&;= sample)))
+ [(#.Some reference) (#.Some sample)]
+ (n/= reference sample)
- (test "Order is preserved."
- (let [(^open "list;.") (list.equivalence (: (Equivalence [Nat Nat])
- (function (_ [kr vr] [ks vs])
- (and (n/= kr ks)
- (n/= vr vs)))))]
- (list;= (&.entries sample)
- sorted-pairs)))
+ _
+ #0))
+ (_.test "Can query value for maximum key."
+ (case [(/.max sample) (list.last sorted-values)]
+ [#.None #.None]
+ #1
- (test "Every key in a dictionary must be identifiable."
- (list.every? (function (_ key) (&.contains? key sample))
- (&.keys sample)))
+ [(#.Some reference) (#.Some sample)]
+ (n/= reference sample)
- (test "Can add and remove elements in a dictionary."
- (and (not (&.contains? extra-key sample))
- (let [sample' (&.put extra-key extra-value sample)
- sample'' (&.remove extra-key sample')]
- (and (&.contains? extra-key sample')
- (not (&.contains? extra-key sample''))
- (case [(&.get extra-key sample')
- (&.get extra-key sample'')]
- [(#.Some found) #.None]
- (n/= extra-value found)
+ _
+ #0))
+ (_.test "Converting dictionaries to/from lists cannot change their values."
+ (|> sample
+ /.entries (/.from-list nat.order)
+ (/@= sample)))
+ (_.test "Order is preserved."
+ (let [(^open "list@.") (list.equivalence (: (Equivalence [Nat Nat])
+ (function (_ [kr vr] [ks vs])
+ (and (n/= kr ks)
+ (n/= vr vs)))))]
+ (list@= (/.entries sample)
+ sorted-pairs)))
+ (_.test "Every key in a dictionary must be identifiable."
+ (list.every? (function (_ key) (/.contains? key sample))
+ (/.keys sample)))
+ (_.test "Can add and remove elements in a dictionary."
+ (and (not (/.contains? extra-key sample))
+ (let [sample' (/.put extra-key extra-value sample)
+ sample'' (/.remove extra-key sample')]
+ (and (/.contains? extra-key sample')
+ (not (/.contains? extra-key sample''))
+ (case [(/.get extra-key sample')
+ (/.get extra-key sample'')]
+ [(#.Some found) #.None]
+ (n/= extra-value found)
- _
- #0)))
- ))
+ _
+ #0)))
+ ))
))))
diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux
index e5ec2b5b2..958025e8b 100644
--- a/stdlib/source/test/lux/data/collection/list.lux
+++ b/stdlib/source/test/lux/data/collection/list.lux
@@ -1,239 +1,193 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
["." io]
[control
- [monad (#+ do Monad)]
- pipe]
+ pipe
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." monoid]
+ ["$." fold]
+ ["$." functor]
+ ["$." apply]
+ ["$." monad]]}]
[data
- ["." number]
["." bit]
["." product]
["." maybe]
- [collection
- ["&" list]]]
+ [number
+ ["." nat]
+ ["." int]]]
[math
["r" random]]]
- lux/test)
+ {1
+ ["." / ("#@." monad)]})
(def: bounded-size
(r.Random Nat)
(|> r.nat
(:: r.monad map (|>> (n/% 100) (n/+ 10)))))
-(context: "Lists: Part 1"
- (<| (times 100)
- (do @
+(def: signatures
+ Test
+ (do r.monad
+ [size bounded-size]
+ ($_ _.and
+ ($equivalence.spec (/.equivalence nat.equivalence) (r.list size r.nat))
+ ($monoid.spec (/.equivalence nat.equivalence) /.monoid (r.list size r.nat))
+ ($fold.spec /@wrap /.equivalence /.fold)
+ ($functor.spec /@wrap /.equivalence /.functor)
+ ($apply.spec /@wrap /.equivalence /.apply)
+ ($monad.spec /@wrap /.equivalence /.monad)
+
+ (do @
+ [parameter r.nat
+ subject r.nat]
+ (let [lift (/.lift io.monad)
+ (^open "io@.") io.monad
+ expected (n/+ parameter subject)]
+ (_.test "Can add list functionality to any monad."
+ (|> (io.run (do (/.with io.monad)
+ [a (lift (io@wrap parameter))
+ b (wrap subject)]
+ (wrap (n/+ a b))))
+ (case> (^ (list actual))
+ (n/= expected actual)
+
+ _
+ false)))))
+ )))
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of .List)))
+ (do r.monad
[size bounded-size
+ #let [(^open "/@.") (/.equivalence nat.equivalence)
+ (^open "/@.") /.functor
+ (^open "/@.") /.monoid]
idx (:: @ map (n/% size) r.nat)
sample (r.list size r.nat)
other-size bounded-size
other-sample (r.list other-size r.nat)
- separator r.nat
- #let [(^open ".") (&.equivalence number.equivalence)
- (^open "&;.") &.functor]]
- ($_ seq
- (test "The size function should correctly portray the size of the list."
- (n/= size (&.size sample)))
-
- (test "The repeat function should produce as many elements as asked of it."
- (n/= size (&.size (&.repeat size []))))
-
- (test "Reversing a list does not change it's size."
- (n/= (&.size sample)
- (&.size (&.reverse sample))))
+ separator r.nat]
+ ($_ _.and
+ ..signatures
- (test "Reversing a list twice results in the original list."
- (= sample
- (&.reverse (&.reverse sample))))
-
- (test "Filtering by a predicate and its complement should result in a number of elements equal to the original list."
- (and (n/= (&.size sample)
- (n/+ (&.size (&.filter n/even? sample))
- (&.size (&.filter (bit.complement n/even?) sample))))
- (let [[plus minus] (&.partition n/even? sample)]
- (n/= (&.size sample)
- (n/+ (&.size plus)
- (&.size minus))))))
-
- (test "If every element in a list satisfies a predicate, there can't be any that satisfy its complement."
- (if (&.every? n/even? sample)
- (and (not (&.any? (bit.complement n/even?) sample))
- (&.empty? (&.filter (bit.complement n/even?) sample)))
- (&.any? (bit.complement n/even?) sample)))
-
- (test "Any element of the list can be considered its member."
- (let [elem (maybe.assume (&.nth idx sample))]
- (&.member? number.equivalence sample elem)))
+ (_.test "The size function should correctly portray the size of the list."
+ (n/= size (/.size sample)))
+ (_.test "The repeat function should produce as many elements as asked of it."
+ (n/= size (/.size (/.repeat size []))))
+ (_.test "Reversing a list does not change it's size."
+ (n/= (/.size sample)
+ (/.size (/.reverse sample))))
+ (_.test "Reversing a list twice results in the original list."
+ (/@= sample
+ (/.reverse (/.reverse sample))))
+ (_.test "Filtering by a predicate and its complement should result in a number of elements equal to the original list."
+ (and (n/= (/.size sample)
+ (n/+ (/.size (/.filter n/even? sample))
+ (/.size (/.filter (bit.complement n/even?) sample))))
+ (let [[plus minus] (/.partition n/even? sample)]
+ (n/= (/.size sample)
+ (n/+ (/.size plus)
+ (/.size minus))))))
+ (_.test "If every element in a list satisfies a predicate, there can't be any that satisfy its complement."
+ (if (/.every? n/even? sample)
+ (and (not (/.any? (bit.complement n/even?) sample))
+ (/.empty? (/.filter (bit.complement n/even?) sample)))
+ (/.any? (bit.complement n/even?) sample)))
+ (_.test "Any element of the list can be considered its member."
+ (let [elem (maybe.assume (/.nth idx sample))]
+ (/.member? nat.equivalence sample elem)))
+ (_.test "Appending the head and the tail should yield the original list."
+ (let [head (maybe.assume (/.head sample))
+ tail (maybe.assume (/.tail sample))]
+ (/@= sample
+ (#.Cons head tail))))
+ (_.test "Appending the inits and the last should yield the original list."
+ (let [inits (maybe.assume (/.inits sample))
+ last (maybe.assume (/.last sample))]
+ (/@= sample
+ (/@compose inits (list last)))))
+ (_.test "Splitting a list into chunks and re-appending them should yield the original list."
+ (let [[left right] (/.split idx sample)
+ [left' right'] (/.split-with n/even? sample)]
+ (and (/@= sample
+ (/@compose left right))
+ (/@= sample
+ (/@compose left' right'))
+ (/@= sample
+ (/@compose (/.take idx sample)
+ (/.drop idx sample)))
+ (/@= sample
+ (/@compose (/.take-while n/even? sample)
+ (/.drop-while n/even? sample)))
+ )))
+ (_.test "Segmenting the list in pairs should yield as many elements as N/2."
+ (n/= (n// 2 size)
+ (/.size (/.as-pairs sample))))
+ (_.test "Sorting a list shouldn't change it's size."
+ (n/= (/.size sample)
+ (/.size (/.sort n/< sample))))
+ (_.test "Sorting a list with one order should yield the reverse of sorting it with the opposite order."
+ (/@= (/.sort n/< sample)
+ (/.reverse (/.sort n/> sample))))
+ (_.test "If you zip 2 lists, the result's size will be that of the smaller list."
+ (n/= (/.size (/.zip2 sample other-sample))
+ (n/min (/.size sample) (/.size other-sample))))
+ (_.test "I can pair-up elements of a list in order."
+ (let [zipped (/.zip2 sample other-sample)
+ num-zipper (/.size zipped)]
+ (and (|> zipped (/@map product.left) (/@= (/.take num-zipper sample)))
+ (|> zipped (/@map product.right) (/@= (/.take num-zipper other-sample))))))
+ (_.test "You can generate indices for any size, and they will be in ascending order."
+ (let [indices (/.indices size)]
+ (and (n/= size (/.size indices))
+ (/@= indices
+ (/.sort n/< indices))
+ (/.every? (n/= (dec size))
+ (/.zip2-with n/+
+ indices
+ (/.sort n/> indices)))
+ )))
+ (_.test "The 'interpose' function places a value between every member of a list."
+ (let [sample+ (/.interpose separator sample)]
+ (and (n/= (|> size (n/* 2) dec)
+ (/.size sample+))
+ (|> sample+ /.as-pairs (/@map product.right) (/.every? (n/= separator))))))
+ (_.test "You can find any value that satisfies some criterium, if such values exist in the list."
+ (case (/.find n/even? sample)
+ (#.Some found)
+ (and (n/even? found)
+ (/.any? n/even? sample)
+ (not (/.every? (bit.complement n/even?) sample)))
+
+ #.None
+ (and (not (/.any? n/even? sample))
+ (/.every? (bit.complement n/even?) sample))))
+ (_.test "You can iteratively construct a list, generating values until you're done."
+ (/@= (/.n/range 0 (dec size))
+ (/.iterate (function (_ n) (if (n/< size n) (#.Some (inc n)) #.None))
+ 0)))
+ (_.test "Can enumerate all elements in a list."
+ (let [enum-sample (/.enumerate sample)]
+ (and (/@= (/.indices (/.size enum-sample))
+ (/@map product.left enum-sample))
+ (/@= sample
+ (/@map product.right enum-sample)))))
+ (do r.monad
+ [from (|> r.nat (:: @ map (n/% 10)))
+ to (|> r.nat (:: @ map (n/% 10)))]
+ (_.test "Ranges can be constructed forward and backwards."
+ (and (/@= (/.n/range from to)
+ (/.reverse (/.n/range to from)))
+ (let [from (.int from)
+ to (.int to)
+ (^open "/@.") (/.equivalence int.equivalence)]
+ (/@= (/.i/range from to)
+ (/.reverse (/.i/range to from)))))))
))))
-
-(context: "Lists: Part 2"
- (<| (times 100)
- (do @
- [size bounded-size
- idx (:: @ map (n/% size) r.nat)
- sample (r.list size r.nat)
- other-size bounded-size
- other-sample (r.list other-size r.nat)
- separator r.nat
- #let [(^open ".") (&.equivalence number.equivalence)
- (^open "&;.") &.functor]]
- ($_ seq
- (test "Appending the head and the tail should yield the original list."
- (let [head (maybe.assume (&.head sample))
- tail (maybe.assume (&.tail sample))]
- (= sample
- (#.Cons head tail))))
-
- (test "Appending the inits and the last should yield the original list."
- (let [(^open ".") &.monoid
- inits (maybe.assume (&.inits sample))
- last (maybe.assume (&.last sample))]
- (= sample
- (compose inits (list last)))))
-
- (test "Functor should go over every element of the list."
- (let [(^open ".") &.functor
- there (map inc sample)
- back-again (map dec there)]
- (and (not (= sample there))
- (= sample back-again))))
-
- (test "Splitting a list into chunks and re-appending them should yield the original list."
- (let [(^open ".") &.monoid
- [left right] (&.split idx sample)
- [left' right'] (&.split-with n/even? sample)]
- (and (= sample
- (compose left right))
- (= sample
- (compose left' right'))
- (= sample
- (compose (&.take idx sample)
- (&.drop idx sample)))
- (= sample
- (compose (&.take-while n/even? sample)
- (&.drop-while n/even? sample)))
- )))
-
- (test "Segmenting the list in pairs should yield as many elements as N/2."
- (n/= (n// 2 size)
- (&.size (&.as-pairs sample))))
-
- (test "Sorting a list shouldn't change it's size."
- (n/= (&.size sample)
- (&.size (&.sort n/< sample))))
-
- (test "Sorting a list with one order should yield the reverse of sorting it with the opposite order."
- (= (&.sort n/< sample)
- (&.reverse (&.sort n/> sample))))
- ))))
-
-(context: "Lists: Part 3"
- (<| (times 100)
- (do @
- [size bounded-size
- idx (:: @ map (n/% size) r.nat)
- sample (r.list size r.nat)
- other-size bounded-size
- other-sample (r.list other-size r.nat)
- separator r.nat
- from (|> r.nat (:: @ map (n/% 10)))
- to (|> r.nat (:: @ map (n/% 10)))
- #let [(^open ".") (&.equivalence number.equivalence)
- (^open "&;.") &.functor]]
- ($_ seq
- (test "If you zip 2 lists, the result's size will be that of the smaller list."
- (n/= (&.size (&.zip2 sample other-sample))
- (n/min (&.size sample) (&.size other-sample))))
-
- (test "I can pair-up elements of a list in order."
- (let [(^open ".") &.functor
- zipped (&.zip2 sample other-sample)
- num-zipper (&.size zipped)]
- (and (|> zipped (map product.left) (= (&.take num-zipper sample)))
- (|> zipped (map product.right) (= (&.take num-zipper other-sample))))))
-
- (test "You can generate indices for any size, and they will be in ascending order."
- (let [(^open ".") &.functor
- indices (&.indices size)]
- (and (n/= size (&.size indices))
- (= indices
- (&.sort n/< indices))
- (&.every? (n/= (dec size))
- (&.zip2-with n/+
- indices
- (&.sort n/> indices)))
- )))
-
- (test "The 'interpose' function places a value between every member of a list."
- (let [(^open ".") &.functor
- sample+ (&.interpose separator sample)]
- (and (n/= (|> size (n/* 2) dec)
- (&.size sample+))
- (|> sample+ &.as-pairs (map product.right) (&.every? (n/= separator))))))
-
- (test "List append is a monoid."
- (let [(^open ".") &.monoid]
- (and (= sample (compose identity sample))
- (= sample (compose sample identity))
- (let [[left right] (&.split size (compose sample other-sample))]
- (and (= sample left)
- (= other-sample right))))))
-
- (test "Apply allows you to create singleton lists, and apply lists of functions to lists of values."
- (let [(^open ".") &.monad
- (^open ".") &.apply]
- (and (= (list separator) (wrap separator))
- (= (map inc sample)
- (apply (wrap inc) sample)))))
-
- (test "List concatenation is a monad."
- (let [(^open ".") &.monad
- (^open ".") &.monoid]
- (= (compose sample other-sample)
- (join (list sample other-sample)))))
-
- (test "You can find any value that satisfies some criterium, if such values exist in the list."
- (case (&.find n/even? sample)
- (#.Some found)
- (and (n/even? found)
- (&.any? n/even? sample)
- (not (&.every? (bit.complement n/even?) sample)))
-
- #.None
- (and (not (&.any? n/even? sample))
- (&.every? (bit.complement n/even?) sample))))
-
- (test "You can iteratively construct a list, generating values until you're done."
- (= (&.n/range 0 (dec size))
- (&.iterate (function (_ n) (if (n/< size n) (#.Some (inc n)) #.None))
- 0)))
-
- (test "Can enumerate all elements in a list."
- (let [enum-sample (&.enumerate sample)]
- (and (= (&.indices (&.size enum-sample))
- (&;map product.left enum-sample))
- (= sample
- (&;map product.right enum-sample)))))
-
- (test "Ranges can be constructed forward and backwards."
- (and (let [(^open "list;.") (&.equivalence number.equivalence)]
- (list;= (&.n/range from to)
- (&.reverse (&.n/range to from))))
- (let [(^open "list;.") (&.equivalence number.equivalence)
- from (.int from)
- to (.int to)]
- (list;= (&.i/range from to)
- (&.reverse (&.i/range to from))))))
- ))))
-
-## TODO: Add again once new-luxc becomes the standard compiler.
-(context: "Monad transformer"
- (let [lift (&.lift io.monad)
- (^open "io;.") io.monad]
- (test "Can add list functionality to any monad."
- (|> (io.run (do (&.ListT io.monad)
- [a (lift (io;wrap +123))
- b (wrap +456)]
- (wrap (i/+ a b))))
- (case> (^ (list +579)) #1
- _ #0)))))
diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux
index f84246a7f..c377fccc3 100644
--- a/stdlib/source/test/lux/data/collection/queue.lux
+++ b/stdlib/source/test/lux/data/collection/queue.lux
@@ -1,54 +1,64 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
- [monad (#+ do Monad)]]
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." functor (#+ Injection)]]}]
[data
- ["." number]
- [collection
- ["&" queue]]]
+ [number
+ ["." nat]]]
[math
["r" random]]]
- lux/test)
+ {1
+ ["." /]})
-(context: "Queues"
- (<| (times 100)
- (do @
+(def: injection
+ (Injection /.Queue)
+ (|>> list /.from-list))
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Queue)))
+ (do r.monad
[size (:: @ map (n/% 100) r.nat)
sample (r.queue size r.nat)
non-member (|> r.nat
- (r.filter (|>> (&.member? number.equivalence sample) not)))]
- ($_ seq
- (test "I can query the size of a queue (and empty queues have size 0)."
- (if (n/= 0 size)
- (&.empty? sample)
- (n/= size (&.size sample))))
-
- (test "Enqueueing and dequeing affects the size of queues."
- (and (n/= (inc size) (&.size (&.push non-member sample)))
- (or (&.empty? sample)
- (n/= (dec size) (&.size (&.pop sample))))
- (n/= size (&.size (&.pop (&.push non-member sample))))))
-
- (test "Transforming to/from list can't change the queue."
- (let [(^open "&;.") (&.equivalence number.equivalence)]
- (|> sample
- &.to-list &.from-list
- (&;= sample))))
-
- (test "I can always peek at a non-empty queue."
- (case (&.peek sample)
- #.None (&.empty? sample)
- (#.Some _) #1))
-
- (test "I can query whether an element belongs to a queue."
- (and (not (&.member? number.equivalence sample non-member))
- (&.member? number.equivalence (&.push non-member sample)
- non-member)
- (case (&.peek sample)
- #.None
- (&.empty? sample)
-
- (#.Some first)
- (and (&.member? number.equivalence sample first)
- (not (&.member? number.equivalence (&.pop sample) first))))))
+ (r.filter (|>> (/.member? nat.equivalence sample) not)))]
+ ($_ _.and
+ ($equivalence.spec (/.equivalence nat.equivalence) (r.queue size r.nat))
+ ($functor.spec ..injection /.equivalence /.functor)
+
+ (_.test "I can query the size of a queue (and empty queues have size 0)."
+ (if (n/= 0 size)
+ (/.empty? sample)
+ (n/= size (/.size sample))))
+ (_.test "Enqueueing and dequeing affects the size of queues."
+ (and (n/= (inc size) (/.size (/.push non-member sample)))
+ (or (/.empty? sample)
+ (n/= (dec size) (/.size (/.pop sample))))
+ (n/= size (/.size (/.pop (/.push non-member sample))))))
+ (_.test "Transforming to/from list can't change the queue."
+ (let [(^open "/;.") (/.equivalence nat.equivalence)]
+ (|> sample
+ /.to-list /.from-list
+ (/;= sample))))
+ (_.test "I can always peek at a non-empty queue."
+ (case (/.peek sample)
+ #.None (/.empty? sample)
+ (#.Some _) #1))
+ (_.test "I can query whether an element belongs to a queue."
+ (and (not (/.member? nat.equivalence sample non-member))
+ (/.member? nat.equivalence (/.push non-member sample)
+ non-member)
+ (case (/.peek sample)
+ #.None
+ (/.empty? sample)
+
+ (#.Some first)
+ (and (/.member? nat.equivalence sample first)
+ (not (/.member? nat.equivalence (/.pop sample) first))))))
))))
diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux
index 3868a01a8..df24b8368 100644
--- a/stdlib/source/test/lux/data/collection/queue/priority.lux
+++ b/stdlib/source/test/lux/data/collection/queue/priority.lux
@@ -1,57 +1,56 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
- ["." monad (#+ do Monad)]]
+ ["." monad (#+ do)]]
[data
- [number
- ["." nat]]
["." maybe]
- [collection
- [queue
- ["&" priority]]]]
+ [number
+ ["." nat]]]
[math
- ["r" random]]]
- lux/test)
+ ["r" random (#+ Random)]]]
+ {1
+ ["." / (#+ Queue)]})
-(def: (gen-queue size)
- (-> Nat (r.Random (&.Queue Nat)))
+(def: #export (queue size)
+ (-> Nat (Random (Queue Nat)))
(do r.monad
[inputs (r.list size r.nat)]
(monad.fold @ (function (_ head tail)
(do @
[priority r.nat]
- (wrap (&.push priority head tail))))
- &.empty
+ (wrap (/.push priority head tail))))
+ /.empty
inputs)))
-(context: "Queues"
- (<| (times 100)
- (do @
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Queue)))
+ (do r.monad
[size (|> r.nat (:: @ map (n/% 100)))
- sample (gen-queue size)
+ sample (..queue size)
non-member-priority r.nat
- non-member (|> r.nat (r.filter (|>> (&.member? nat.equivalence sample) not)))]
- ($_ seq
- (test "I can query the size of a queue (and empty queues have size 0)."
- (n/= size (&.size sample)))
-
- (test "Enqueueing and dequeing affects the size of queues."
- (and (n/= (inc size)
- (&.size (&.push non-member-priority non-member sample)))
- (or (n/= 0 (&.size sample))
- (n/= (dec size)
- (&.size (&.pop sample))))))
-
- (test "I can query whether an element belongs to a queue."
- (and (and (not (&.member? nat.equivalence sample non-member))
- (&.member? nat.equivalence
- (&.push non-member-priority non-member sample)
- non-member))
- (or (n/= 0 (&.size sample))
- (and (&.member? nat.equivalence
- sample
- (maybe.assume (&.peek sample)))
- (not (&.member? nat.equivalence
- (&.pop sample)
- (maybe.assume (&.peek sample))))))))
+ non-member (|> r.nat (r.filter (|>> (/.member? nat.equivalence sample) not)))]
+ ($_ _.and
+ (_.test "I can query the size of a queue (and empty queues have size 0)."
+ (n/= size (/.size sample)))
+ (_.test "Enqueueing and dequeing affects the size of queues."
+ (and (n/= (inc size)
+ (/.size (/.push non-member-priority non-member sample)))
+ (or (n/= 0 (/.size sample))
+ (n/= (dec size)
+ (/.size (/.pop sample))))))
+ (_.test "I can query whether an element belongs to a queue."
+ (and (and (not (/.member? nat.equivalence sample non-member))
+ (/.member? nat.equivalence
+ (/.push non-member-priority non-member sample)
+ non-member))
+ (or (n/= 0 (/.size sample))
+ (and (/.member? nat.equivalence
+ sample
+ (maybe.assume (/.peek sample)))
+ (not (/.member? nat.equivalence
+ (/.pop sample)
+ (maybe.assume (/.peek sample))))))))
))))
diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux
index f4c7ad3a0..cf678e0b4 100644
--- a/stdlib/source/test/lux/data/collection/row.lux
+++ b/stdlib/source/test/lux/data/collection/row.lux
@@ -1,82 +1,76 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
- [monad (#+ Monad do)]]
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." monoid]
+ ["$." fold]
+ ["$." functor (#+ Injection)]
+ ["$." apply]
+ ["$." monad]]}]
[data
- ["." number]
["." maybe]
+ [number
+ ["." nat]]
[collection
- ["&" row]
- ["." list ("#;." fold)]]]
+ ["." list ("#@." fold)]]]
[math
["r" random]]]
- lux/test)
+ {1
+ ["." / ("#@." monad)]})
-(context: "Rows"
- (<| (times 100)
- (do @
- [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1))))
- idx (|> r.nat (:: @ map (n/% size)))
- sample (r.row size r.nat)
- other-sample (r.row size r.nat)
- non-member (|> r.nat (r.filter (|>> (&.member? number.equivalence sample) not)))
- #let [(^open "&;.") (&.equivalence number.equivalence)
- (^open "&;.") &.apply
- (^open "&;.") &.monad
- (^open "&;.") &.fold
- (^open "&;.") &.monoid]]
- ($_ seq
- (test "Can query size of row."
- (if (&.empty? sample)
- (and (n/= 0 size)
- (n/= 0 (&.size sample)))
- (n/= size (&.size sample))))
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Row)))
+ (do r.monad
+ [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1))))]
+ ($_ _.and
+ ($equivalence.spec (/.equivalence nat.equivalence) (r.row size r.nat))
+ ($monoid.spec (/.equivalence nat.equivalence) /.monoid (r.row size r.nat))
+ ($fold.spec /@wrap /.equivalence /.fold)
+ ($functor.spec /@wrap /.equivalence /.functor)
+ ($apply.spec /@wrap /.equivalence /.apply)
+ ($monad.spec /@wrap /.equivalence /.monad)
- (test "Can add and remove elements to rows."
- (and (n/= (inc size) (&.size (&.add non-member sample)))
- (n/= (dec size) (&.size (&.pop sample)))))
-
- (test "Can put and get elements into rows."
- (|> sample
- (&.put idx non-member)
- (&.nth idx)
- maybe.assume
- (is? non-member)))
-
- (test "Can update elements of rows."
- (|> sample
- (&.put idx non-member) (&.update idx inc)
- (&.nth idx) maybe.assume
- (n/= (inc non-member))))
-
- (test "Can safely transform to/from lists."
- (|> sample &.to-list &.from-list (&;= sample)))
-
- (test "Can identify members of a row."
- (and (not (&.member? number.equivalence sample non-member))
- (&.member? number.equivalence (&.add non-member sample) non-member)))
-
- (test "Can fold over elements of row."
- (n/= (list;fold n/+ 0 (&.to-list sample))
- (&;fold n/+ 0 sample)))
-
- (test "Functor goes over every element."
- (let [there (&;map inc sample)
- back-again (&;map dec there)]
- (and (not (&;= sample there))
- (&;= sample back-again))))
-
- (test "Apply allows you to create singleton rows, and apply rows of functions to rows of values."
- (and (&;= (&.row non-member) (&;wrap non-member))
- (&;= (&;map inc sample) (&;apply (&;wrap inc) sample))))
-
- (test "Row concatenation is a monad."
- (&;= (&;compose sample other-sample)
- (&;join (&.row sample other-sample))))
-
- (test "Can reverse."
- (and (not (&;= sample
- (&.reverse sample)))
- (not (&;= sample
- (&.reverse (&.reverse sample))))))
+ (do @
+ [idx (|> r.nat (:: @ map (n/% size)))
+ sample (r.row size r.nat)
+ other-sample (r.row size r.nat)
+ non-member (|> r.nat (r.filter (|>> (/.member? nat.equivalence sample) not)))
+ #let [(^open "/@.") (/.equivalence nat.equivalence)]]
+ ($_ _.and
+ (_.test "Can query size of row."
+ (if (/.empty? sample)
+ (and (n/= 0 size)
+ (n/= 0 (/.size sample)))
+ (n/= size (/.size sample))))
+ (_.test "Can add and remove elements to rows."
+ (and (n/= (inc size) (/.size (/.add non-member sample)))
+ (n/= (dec size) (/.size (/.pop sample)))))
+ (_.test "Can put and get elements into rows."
+ (|> sample
+ (/.put idx non-member)
+ (/.nth idx)
+ maybe.assume
+ (is? non-member)))
+ (_.test "Can update elements of rows."
+ (|> sample
+ (/.put idx non-member) (/.update idx inc)
+ (/.nth idx) maybe.assume
+ (n/= (inc non-member))))
+ (_.test "Can safely transform to/from lists."
+ (|> sample /.to-list /.from-list (/@= sample)))
+ (_.test "Can identify members of a row."
+ (and (not (/.member? nat.equivalence sample non-member))
+ (/.member? nat.equivalence (/.add non-member sample) non-member)))
+ (_.test "Can reverse."
+ (and (not (/@= sample
+ (/.reverse sample)))
+ (not (/@= sample
+ (/.reverse (/.reverse sample))))))
+ ))
))))
diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux
index 90971d2e9..edacef996 100644
--- a/stdlib/source/test/lux/data/collection/sequence.lux
+++ b/stdlib/source/test/lux/data/collection/sequence.lux
@@ -1,104 +1,100 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
- [monad (#+ do Monad)]
- comonad]
+ comonad
+ [monad (#+ do Monad)]]
[data
["." maybe]
[number
- ["." nat ("#;." codec)]]
- ["." text ("#;." monoid)]
+ ["." nat ("#@." decimal)]]
+ ["." text ("#@." monoid)]
[collection
- ["." list]
- ["&" sequence]]]
+ ["." list]]]
[math
["r" random]]]
- lux/test)
+ {1
+ ["." /]})
-(context: "Sequences"
- (<| (times 100)
- (do @
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Sequence)))
+ (do r.monad
[size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 2))))
offset (|> r.nat (:: @ map (n/% 100)))
factor (|> r.nat (:: @ map (|>> (n/% 100) (n/max 2))))
elem r.nat
cycle-seed (r.list size r.nat)
cycle-sample-idx (|> r.nat (:: @ map (n/% 1000)))
- #let [(^open "List;.") (list.equivalence number.equivalence)
- sample0 (&.iterate inc 0)
- sample1 (&.iterate inc offset)]]
- ($_ seq
- (test "Can move along a sequence and take slices off it."
- (and (and (List;= (list.n/range 0 (dec size))
- (&.take size sample0))
- (List;= (list.n/range offset (dec (n/+ offset size)))
- (&.take size (&.drop offset sample0)))
- (let [[drops takes] (&.split size sample0)]
- (and (List;= (list.n/range 0 (dec size))
- drops)
- (List;= (list.n/range size (dec (n/* 2 size)))
- (&.take size takes)))))
- (and (List;= (list.n/range 0 (dec size))
- (&.take-while (n/< size) sample0))
- (List;= (list.n/range offset (dec (n/+ offset size)))
- (&.take-while (n/< (n/+ offset size))
- (&.drop-while (n/< offset) sample0)))
- (let [[drops takes] (&.split-while (n/< size) sample0)]
- (and (List;= (list.n/range 0 (dec size))
- drops)
- (List;= (list.n/range size (dec (n/* 2 size)))
- (&.take-while (n/< (n/* 2 size)) takes)))))
- ))
-
- (test "Can repeat any element and infinite number of times."
- (n/= elem (&.nth offset (&.repeat elem))))
-
- (test "Can obtain the head & tail of a sequence."
- (and (n/= offset (&.head sample1))
- (List;= (list.n/range (inc offset) (n/+ offset size))
- (&.take size (&.tail sample1)))))
-
- (test "Can filter sequences."
- (and (n/= (n/* 2 offset)
- (&.nth offset
- (&.filter n/even? sample0)))
- (let [[evens odds] (&.partition n/even? (&.iterate inc 0))]
- (and (n/= (n/* 2 offset)
- (&.nth offset evens))
- (n/= (inc (n/* 2 offset))
- (&.nth offset odds))))))
-
- (test "Functor goes over 'all' elements in a sequence."
- (let [(^open "&;.") &.functor
- there (&;map (n/* factor) sample0)
- back-again (&;map (n// factor) there)]
- (and (not (List;= (&.take size sample0)
- (&.take size there)))
- (List;= (&.take size sample0)
- (&.take size back-again)))))
-
- (test "CoMonad produces a value for every element in a sequence."
- (let [(^open "&;.") &.functor]
- (List;= (&.take size (&;map (n/* factor) sample1))
- (&.take size
- (be &.comonad
- [inputs sample1]
- (n/* factor (&.head inputs)))))))
-
- (test "'unfold' generalizes 'iterate'."
- (let [(^open "&;.") &.functor
- (^open "List;.") (list.equivalence text.equivalence)]
- (List;= (&.take size
- (&;map nat;encode (&.iterate inc offset)))
- (&.take size
- (&.unfold (function (_ n) [(inc n) (nat;encode n)])
- offset)))))
-
- (test "Can cycle over the same elements as an infinite sequence."
- (|> (&.cycle cycle-seed)
- maybe.assume
- (&.nth cycle-sample-idx)
- (n/= (|> cycle-seed
- (list.nth (n/% size cycle-sample-idx))
- maybe.assume))))
+ #let [(^open "list@.") (list.equivalence nat.equivalence)
+ sample0 (/.iterate inc 0)
+ sample1 (/.iterate inc offset)]]
+ ($_ _.and
+ (_.test "Can move along a sequence and take slices off it."
+ (and (and (list@= (list.n/range 0 (dec size))
+ (/.take size sample0))
+ (list@= (list.n/range offset (dec (n/+ offset size)))
+ (/.take size (/.drop offset sample0)))
+ (let [[drops takes] (/.split size sample0)]
+ (and (list@= (list.n/range 0 (dec size))
+ drops)
+ (list@= (list.n/range size (dec (n/* 2 size)))
+ (/.take size takes)))))
+ (and (list@= (list.n/range 0 (dec size))
+ (/.take-while (n/< size) sample0))
+ (list@= (list.n/range offset (dec (n/+ offset size)))
+ (/.take-while (n/< (n/+ offset size))
+ (/.drop-while (n/< offset) sample0)))
+ (let [[drops takes] (/.split-while (n/< size) sample0)]
+ (and (list@= (list.n/range 0 (dec size))
+ drops)
+ (list@= (list.n/range size (dec (n/* 2 size)))
+ (/.take-while (n/< (n/* 2 size)) takes)))))
+ ))
+ (_.test "Can repeat any element and infinite number of times."
+ (n/= elem (/.nth offset (/.repeat elem))))
+ (_.test "Can obtain the head & tail of a sequence."
+ (and (n/= offset (/.head sample1))
+ (list@= (list.n/range (inc offset) (n/+ offset size))
+ (/.take size (/.tail sample1)))))
+ (_.test "Can filter sequences."
+ (and (n/= (n/* 2 offset)
+ (/.nth offset
+ (/.filter n/even? sample0)))
+ (let [[evens odds] (/.partition n/even? (/.iterate inc 0))]
+ (and (n/= (n/* 2 offset)
+ (/.nth offset evens))
+ (n/= (inc (n/* 2 offset))
+ (/.nth offset odds))))))
+ (_.test "Functor goes over 'all' elements in a sequence."
+ (let [(^open "/@.") /.functor
+ there (/@map (n/* factor) sample0)
+ back-again (/@map (n// factor) there)]
+ (and (not (list@= (/.take size sample0)
+ (/.take size there)))
+ (list@= (/.take size sample0)
+ (/.take size back-again)))))
+ (_.test "CoMonad produces a value for every element in a sequence."
+ (let [(^open "/@.") /.functor]
+ (list@= (/.take size (/@map (n/* factor) sample1))
+ (/.take size
+ (be /.comonad
+ [inputs sample1]
+ (n/* factor (/.head inputs)))))))
+ (_.test "'unfold' generalizes 'iterate'."
+ (let [(^open "/@.") /.functor
+ (^open "list@.") (list.equivalence text.equivalence)]
+ (list@= (/.take size
+ (/@map nat@encode (/.iterate inc offset)))
+ (/.take size
+ (/.unfold (function (_ n) [(inc n) (nat@encode n)])
+ offset)))))
+ (_.test "Can cycle over the same elements as an infinite sequence."
+ (|> (/.cycle cycle-seed)
+ maybe.assume
+ (/.nth cycle-sample-idx)
+ (n/= (|> cycle-seed
+ (list.nth (n/% size cycle-sample-idx))
+ maybe.assume))))
))))
diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux
index b383f32c2..f319af295 100644
--- a/stdlib/source/test/lux/data/collection/set.lux
+++ b/stdlib/source/test/lux/data/collection/set.lux
@@ -1,67 +1,74 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
- [monad (#+ do Monad)]]
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." monoid]]}]
[data
- ["." number]
+ [number
+ ["." nat]]
[collection
- ["&" set (#+ Set)]
["." list]]]
[math
["r" random]]]
- lux/test)
+ {1
+ ["." /]})
(def: gen-nat
(r.Random Nat)
(|> r.nat
(:: r.monad map (n/% 100))))
-(context: "Sets"
- (<| (times 100)
- (do @
- [sizeL gen-nat
- sizeR gen-nat
- setL (r.set number.hash sizeL gen-nat)
- setR (r.set number.hash sizeR gen-nat)
- non-member (|> gen-nat
- (r.filter (|>> (&.member? setL) not)))
- #let [(^open "&;.") &.equivalence]]
- ($_ seq
- (test "I can query the size of a set."
- (and (n/= sizeL (&.size setL))
- (n/= sizeR (&.size setR))))
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Set)))
+ (do r.monad
+ [size gen-nat]
+ ($_ _.and
+ ($equivalence.spec /.equivalence (r.set nat.hash size r.nat))
+ ($monoid.spec /.equivalence (/.monoid nat.hash) (r.set nat.hash size r.nat))
- (test "Converting sets to/from lists can't change their values."
- (|> setL
- &.to-list (&.from-list number.hash)
- (&;= setL)))
-
- (test "Every set is a sub-set of the union of itself with another."
- (let [setLR (&.union setL setR)]
- (and (&.sub? setLR setL)
- (&.sub? setLR setR))))
-
- (test "Every set is a super-set of the intersection of itself with another."
- (let [setLR (&.intersection setL setR)]
- (and (&.super? setLR setL)
- (&.super? setLR setR))))
-
- (test "Union with the empty set leaves a set unchanged."
- (&;= setL
- (&.union (&.new number.hash)
- setL)))
-
- (test "Intersection with the empty set results in the empty set."
- (let [empty-set (&.new number.hash)]
- (&;= empty-set
- (&.intersection empty-set setL))))
-
- (test "After substracting a set A from another B, no member of A can be a member of B."
- (let [sub (&.difference setR setL)]
- (not (list.any? (&.member? sub) (&.to-list setR)))))
-
- (test "Every member of a set must be identifiable."
- (and (not (&.member? setL non-member))
- (&.member? (&.add non-member setL) non-member)
- (not (&.member? (&.remove non-member (&.add non-member setL)) non-member))))
- ))))
+ (do r.monad
+ [sizeL gen-nat
+ sizeR gen-nat
+ setL (r.set nat.hash sizeL gen-nat)
+ setR (r.set nat.hash sizeR gen-nat)
+ non-member (|> gen-nat
+ (r.filter (|>> (/.member? setL) not)))
+ #let [(^open "/@.") /.equivalence]]
+ ($_ _.and
+ (_.test "I can query the size of a set."
+ (and (n/= sizeL (/.size setL))
+ (n/= sizeR (/.size setR))))
+ (_.test "Converting sets to/from lists can't change their values."
+ (|> setL
+ /.to-list (/.from-list nat.hash)
+ (/@= setL)))
+ (_.test "Every set is a sub-set of the union of itself with another."
+ (let [setLR (/.union setL setR)]
+ (and (/.sub? setLR setL)
+ (/.sub? setLR setR))))
+ (_.test "Every set is a super-set of the intersection of itself with another."
+ (let [setLR (/.intersection setL setR)]
+ (and (/.super? setLR setL)
+ (/.super? setLR setR))))
+ (_.test "Union with the empty set leaves a set unchanged."
+ (/@= setL
+ (/.union (/.new nat.hash)
+ setL)))
+ (_.test "Intersection with the empty set results in the empty set."
+ (let [empty-set (/.new nat.hash)]
+ (/@= empty-set
+ (/.intersection empty-set setL))))
+ (_.test "After substracting a set A from another B, no member of A can be a member of B."
+ (let [sub (/.difference setR setL)]
+ (not (list.any? (/.member? sub) (/.to-list setR)))))
+ (_.test "Every member of a set must be identifiable."
+ (and (not (/.member? setL non-member))
+ (/.member? (/.add non-member setL) non-member)
+ (not (/.member? (/.remove non-member (/.add non-member setL)) non-member))))
+ ))))))
diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux
index 78d096cef..7f143a9cd 100644
--- a/stdlib/source/test/lux/data/collection/set/ordered.lux
+++ b/stdlib/source/test/lux/data/collection/set/ordered.lux
@@ -1,98 +1,113 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
- [monad (#+ do Monad)]]
+ [monad (#+ do)]
+ [order (#+ Order)]
+ {[0 #test]
+ [/
+ ["$." equivalence]]}]
[data
- ["." number]
- [text
- format]
+ [number
+ ["." nat]]
[collection
- ["." set
- ["&" ordered]]
["." list]]]
[math
- ["r" random]]]
- lux/test)
+ ["r" random (#+ Random) ("#@." monad)]]]
+ {1
+ ["." / (#+ Set)
+ ["." //]]})
(def: gen-nat
(r.Random Nat)
(|> r.nat
(:: r.monad map (n/% 100))))
-(context: "Sets"
- (<| (times 100)
- (do @
- [sizeL gen-nat
- sizeR gen-nat
- listL (|> (r.set number.hash sizeL gen-nat) (:: @ map set.to-list))
- listR (|> (r.set number.hash sizeR gen-nat) (:: @ map set.to-list))
- #let [(^open "&;.") &.equivalence
- setL (&.from-list number.order listL)
- setR (&.from-list number.order listR)
- sortedL (list.sort n/< listL)
- minL (list.head sortedL)
- maxL (list.last sortedL)]]
- ($_ seq
- (test "I can query the size of a set."
- (n/= sizeL (&.size setL)))
-
- (test "Can query minimum value."
- (case [(&.min setL) minL]
- [#.None #.None]
- #1
-
- [(#.Some reference) (#.Some sample)]
- (n/= reference sample)
-
- _
- #0))
-
- (test "Can query maximum value."
- (case [(&.max setL) maxL]
- [#.None #.None]
- #1
-
- [(#.Some reference) (#.Some sample)]
- (n/= reference sample)
-
- _
- #0))
-
- (test "Converting sets to/from lists can't change their values."
- (|> setL
- &.to-list (&.from-list number.order)
- (&;= setL)))
-
- (test "Order is preserved."
- (let [listL (&.to-list setL)
- (^open "L/.") (list.equivalence number.equivalence)]
- (L/= listL
- (list.sort n/< listL))))
-
- (test "Every set is a sub-set of the union of itself with another."
- (let [setLR (&.union setL setR)]
- (and (&.sub? setLR setL)
- (&.sub? setLR setR))))
-
- (test "Every set is a super-set of the intersection of itself with another."
- (let [setLR (&.intersection setL setR)]
- (and (&.super? setLR setL)
- (&.super? setLR setR))))
-
- (test "Union with the empty set leaves a set unchanged."
- (&;= setL
- (&.union (&.new number.order)
- setL)))
-
- (test "Intersection with the empty set results in the empty set."
- (let [empty-set (&.new number.order)]
- (&;= empty-set
- (&.intersection empty-set setL))))
-
- (test "After substracting a set A from another B, no member of A can be a member of B."
- (let [sub (&.difference setR setL)]
- (not (list.any? (&.member? sub) (&.to-list setR)))))
-
- (test "Every member of a set must be identifiable."
- (list.every? (&.member? setL) (&.to-list setL)))
- ))))
+(def: #export (set &order gen-value size)
+ (All [a] (-> (Order a) (Random a) Nat (Random (Set a))))
+ (case size
+ 0
+ (r@wrap (/.new &order))
+
+ _
+ (do r.monad
+ [partial (set &order gen-value (dec size))
+ value (r.filter (|>> (/.member? partial) not)
+ gen-value)]
+ (wrap (/.add value partial)))))
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Set)))
+ ($_ _.and
+ (do r.monad
+ [size gen-nat]
+ ($_ _.and
+ ($equivalence.spec /.equivalence (..set nat.order r.nat size))
+ ))
+ (do r.monad
+ [sizeL gen-nat
+ sizeR gen-nat
+ listL (|> (r.set nat.hash sizeL gen-nat) (:: @ map //.to-list))
+ listR (|> (r.set nat.hash sizeR gen-nat) (:: @ map //.to-list))
+ #let [(^open "/@.") /.equivalence
+ setL (/.from-list nat.order listL)
+ setR (/.from-list nat.order listR)
+ sortedL (list.sort n/< listL)
+ minL (list.head sortedL)
+ maxL (list.last sortedL)]]
+ ($_ _.and
+ (_.test "I can query the size of a set."
+ (n/= sizeL (/.size setL)))
+ (_.test "Can query minimum value."
+ (case [(/.min setL) minL]
+ [#.None #.None]
+ true
+
+ [(#.Some reference) (#.Some sample)]
+ (n/= reference sample)
+
+ _
+ false))
+ (_.test "Can query maximum value."
+ (case [(/.max setL) maxL]
+ [#.None #.None]
+ true
+
+ [(#.Some reference) (#.Some sample)]
+ (n/= reference sample)
+
+ _
+ false))
+ (_.test "Converting sets to/from lists can't change their values."
+ (|> setL
+ /.to-list (/.from-list nat.order)
+ (/@= setL)))
+ (_.test "Order is preserved."
+ (let [listL (/.to-list setL)
+ (^open "list@.") (list.equivalence nat.equivalence)]
+ (list@= listL
+ (list.sort n/< listL))))
+ (_.test "Every set is a sub-set of the union of itself with another."
+ (let [setLR (/.union setL setR)]
+ (and (/.sub? setLR setL)
+ (/.sub? setLR setR))))
+ (_.test "Every set is a super-set of the intersection of itself with another."
+ (let [setLR (/.intersection setL setR)]
+ (and (/.super? setLR setL)
+ (/.super? setLR setR))))
+ (_.test "Union with the empty set leaves a set unchanged."
+ (/@= setL
+ (/.union (/.new nat.order)
+ setL)))
+ (_.test "Intersection with the empty set results in the empty set."
+ (let [empty-set (/.new nat.order)]
+ (/@= empty-set
+ (/.intersection empty-set setL))))
+ (_.test "After substracting a set A from another B, no member of A can be a member of B."
+ (let [sub (/.difference setR setL)]
+ (not (list.any? (/.member? sub) (/.to-list setR)))))
+ (_.test "Every member of a set must be identifiable."
+ (list.every? (/.member? setL) (/.to-list setL)))
+ )))))
diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux
index d203b4246..0a6fcf698 100644
--- a/stdlib/source/test/lux/data/collection/stack.lux
+++ b/stdlib/source/test/lux/data/collection/stack.lux
@@ -1,46 +1,69 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
- [monad (#+ do)]]
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." functor (#+ Injection)]]}]
[data
["." maybe]
- [collection
- ["&" stack]]]
+ [number
+ ["." nat]]]
[math
["r" random]]]
- lux/test)
+ {1
+ ["." /]})
+
+(def: (injection value)
+ (Injection /.Stack)
+ (/.push value /.empty))
(def: gen-nat
(r.Random Nat)
(|> r.nat
(:: r.monad map (n/% 100))))
-(context: "Stacks"
- (<| (times 100)
- (do @
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Stack)))
+ (do r.monad
[size gen-nat
sample (r.stack size gen-nat)
new-top gen-nat]
- ($_ seq
- (test "Can query the size of a stack."
- (n/= size (&.size sample)))
-
- (test "Can peek inside non-empty stacks."
- (case (&.peek sample)
- #.None (&.empty? sample)
- (#.Some _) (not (&.empty? sample))))
-
- (test "Popping empty stacks doesn't change anything.
- But, if they're non-empty, the top of the stack is removed."
- (let [sample' (&.pop sample)]
- (or (n/= (&.size sample) (inc (&.size sample')))
- (and (&.empty? sample) (&.empty? sample')))
- ))
-
- (test "Pushing onto a stack always increases it by 1, adding a new value at the top."
- (and (is? sample
- (&.pop (&.push new-top sample)))
- (n/= (inc (&.size sample)) (&.size (&.push new-top sample)))
- (|> (&.push new-top sample) &.peek maybe.assume
- (is? new-top))))
+ ($_ _.and
+ ($equivalence.spec (/.equivalence nat.equivalence) (r.stack size r.nat))
+ ($functor.spec ..injection /.equivalence /.functor)
+
+ (_.test "Can query the size of a stack."
+ (n/= size (/.size sample)))
+ (_.test "Can peek inside non-empty stacks."
+ (case (/.peek sample)
+ #.None (/.empty? sample)
+ (#.Some _) (not (/.empty? sample))))
+ (_.test (format "Popping empty stacks doesn't change anything."
+ "But, if they're non-empty, the top of the stack is removed.")
+ (case (/.size sample)
+ 0 (case (/.pop sample)
+ #.None
+ (/.empty? sample)
+
+ (#.Some _)
+ false)
+ expected (case (/.pop sample)
+ (#.Some sample')
+ (and (n/= expected (/.size sample'))
+ (not (/.empty? sample)))
+
+ #.None
+ false)))
+ (_.test "Pushing onto a stack always increases it by 1, adding a new value at the top."
+ (and (is? sample
+ (|> sample (/.push new-top) /.pop maybe.assume))
+ (n/= (inc (/.size sample))
+ (/.size (/.push new-top sample)))
+ (|> (/.push new-top sample) /.peek maybe.assume
+ (is? new-top))))
))))
diff --git a/stdlib/source/test/lux/data/collection/tree/rose.lux b/stdlib/source/test/lux/data/collection/tree/rose.lux
index f4ddee14e..383e250b5 100644
--- a/stdlib/source/test/lux/data/collection/tree/rose.lux
+++ b/stdlib/source/test/lux/data/collection/tree/rose.lux
@@ -1,51 +1,55 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
- [monad (#+ do Monad)]]
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." fold]
+ ["$." functor]]}]
[data
- ["." product]
- ["." number]
- ["." text ("#;." equivalence)
- format]
+ [number
+ ["." nat]]
[collection
- ["." list ("#;." functor fold)]
- [tree
- ["&" rose]]]]
+ ["." list ("#@." functor fold)]]]
[math
- ["r" random]]]
- lux/test)
+ ["r" random (#+ Random)]]]
+ {1
+ ["." / (#+ Tree)]})
-(def: gen-tree
- (r.Random [Nat (&.Tree Nat)])
- (r.rec
- (function (_ gen-tree)
- (r.either (:: r.monad map (|>> &.leaf [1]) r.nat)
- (do r.monad
- [value r.nat
- num-children (|> r.nat (:: @ map (n/% 3)))
- children' (r.list num-children gen-tree)
- #let [size' (list;fold n/+ 0 (list;map product.left children'))
- children (list;map product.right children')]]
- (wrap [(inc size')
- (&.branch value children)]))
- ))))
+(def: #export (tree size gen-value)
+ (All [a] (-> Nat (Random a) (Random (Tree a))))
+ (let [singleton (:: r.monad map /.leaf gen-value)]
+ (case size
+ 0
+ singleton
+
+ 1
+ singleton
+
+ _
+ (do r.monad
+ [value gen-value
+ children (r.list (n/+ 2 (n/% 2 size))
+ (tree (n// 2 size) gen-value))]
+ (wrap (/.branch value children)))
+ )))
-(context: "Trees"
- (<| (times 100)
- (do @
- [[size sample] gen-tree
- #let [(^open "&;.") (&.equivalence number.equivalence)
- (^open "&;.") &.fold
- concat (function (_ addition partial) (format partial (%n addition)))]]
- ($_ seq
- (test "Can compare trees for equivalence."
- (&;= sample sample))
-
- (test "Can flatten a tree to get all the nodes as a flat tree."
- (n/= size
- (list.size (&.flatten sample))))
-
- (test "Can fold trees."
- (text;= (&;fold concat "" sample)
- (list;fold concat "" (&.flatten sample))))
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Tree)))
+ (do r.monad
+ [size (:: @ map (|>> (n/% 100) (n/max 10)) r.nat)]
+ ($_ _.and
+ ($equivalence.spec (/.equivalence nat.equivalence) (..tree size r.nat))
+ ($fold.spec /.leaf /.equivalence /.fold)
+ ($functor.spec /.leaf /.equivalence /.functor)
+
+ (do @
+ [sample (..tree size r.nat)]
+ (_.test "Can flatten a tree to get all the nodes as a flat tree."
+ (n/= size
+ (list.size (/.flatten sample)))))
))))
diff --git a/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux b/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux
index 769e11293..379b17c16 100644
--- a/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux
+++ b/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux
@@ -1,128 +1,117 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
[monad (#+ do Monad)]
pipe]
[data
- ["." number]
["." maybe]
- ["." text
- format]
+ ["." text]
+ [number
+ ["." nat]]
[collection
["." list]
[tree
- ["." rose
- ["&" zipper]]]]]
+ ["." rose]]]]
[math
["r" random]]]
- lux/test)
-
-(def: gen-tree
- (r.Random (rose.Tree Nat))
- (r.rec (function (_ gen-tree)
- (do r.monad
- ## Each branch can have, at most, 1 child.
- [size (|> r.nat (:: @ map (n/% 2)))]
- (r.and r.nat
- (r.list size gen-tree))))))
+ ["." //]
+ {1
+ ["." / (#+ Zipper)]}
+ )
(def: (to-end zipper)
- (All [a] (-> (&.Zipper a) (&.Zipper a)))
+ (All [a] (-> (Zipper a) (Zipper a)))
(loop [zipper zipper]
- (if (&.end? zipper)
+ (if (/.end? zipper)
zipper
- (recur (&.next zipper)))))
+ (recur (/.next zipper)))))
-(context: "Zippers."
- (<| (times 100)
- (do @
- [sample gen-tree
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Zipper)))
+ (do r.monad
+ [size (:: @ map (|>> (n/% 100) (n/max 10)) r.nat)
+ sample (//.tree size r.nat)
new-val r.nat
pre-val r.nat
post-val r.nat
- #let [(^open "tree/.") (rose.equivalence number.equivalence)
- (^open "list;.") (list.equivalence number.equivalence)]]
- ($_ seq
- (test "Trees can be converted to/from zippers."
- (|> sample
- &.zip &.unzip
- (tree/= sample)))
-
- (test "Creating a zipper gives you a root node."
- (|> sample &.zip &.root?))
-
- (test "Can move down inside branches. Can move up from lower nodes."
- (let [zipper (&.zip sample)]
- (if (&.branch? zipper)
- (let [child (|> zipper &.down)]
- (and (not (tree/= sample (&.unzip child)))
- (|> child &.up (is? zipper) not)
- (|> child &.root (is? zipper) not)))
- (and (&.leaf? zipper)
- (|> zipper (&.prepend-child new-val) &.branch?)))))
-
- (test "Can prepend and append children."
- (let [zipper (&.zip sample)]
- (if (&.branch? zipper)
- (let [mid-val (|> zipper &.down &.value)
- zipper (|> zipper
- (&.prepend-child pre-val)
- (&.append-child post-val))]
- (and (|> zipper &.down &.value (is? pre-val))
- (|> zipper &.down &.right &.value (is? mid-val))
- (|> zipper &.down &.right &.right &.value (is? post-val))
- (|> zipper &.down &.rightmost &.leftmost &.value (is? pre-val))
- (|> zipper &.down &.right &.left &.value (is? pre-val))
- (|> zipper &.down &.rightmost &.value (is? post-val))))
- #1)))
-
- (test "Can insert children around a node (unless it's root)."
- (let [zipper (&.zip sample)]
- (if (&.branch? zipper)
- (let [mid-val (|> zipper &.down &.value)
- zipper (|> zipper
- &.down
- (&.insert-left pre-val)
- maybe.assume
- (&.insert-right post-val)
- maybe.assume
- &.up)]
- (and (|> zipper &.down &.value (is? pre-val))
- (|> zipper &.down &.right &.value (is? mid-val))
- (|> zipper &.down &.right &.right &.value (is? post-val))
- (|> zipper &.down &.rightmost &.leftmost &.value (is? pre-val))
- (|> zipper &.down &.right &.left &.value (is? pre-val))
- (|> zipper &.down &.rightmost &.value (is? post-val))))
- (and (|> zipper (&.insert-left pre-val) (case> (#.Some _) #0
- #.None #1))
- (|> zipper (&.insert-right post-val) (case> (#.Some _) #0
- #.None #1))))))
-
- (test "Can set and update the value of a node."
- (|> sample &.zip (&.set new-val) &.value (n/= new-val)))
-
- (test "Zipper traversal follows the outline of the tree depth-first."
- (list;= (rose.flatten sample)
- (loop [zipper (&.zip sample)]
- (if (&.end? zipper)
- (list (&.value zipper))
- (#.Cons (&.value zipper)
- (recur (&.next zipper)))))))
-
- (test "Backwards zipper traversal yield reverse tree flatten."
- (list;= (list.reverse (rose.flatten sample))
- (loop [zipper (to-end (&.zip sample))]
- (if (&.root? zipper)
- (list (&.value zipper))
- (#.Cons (&.value zipper)
- (recur (&.prev zipper)))))))
-
- (test "Can remove nodes (except root nodes)."
- (let [zipper (&.zip sample)]
- (if (&.branch? zipper)
- (and (|> zipper &.down &.root? not)
- (|> zipper &.down &.remove (case> #.None #0
- (#.Some node) (&.root? node))))
- (|> zipper &.remove (case> #.None #1
- (#.Some _) #0)))))
+ #let [(^open "tree@.") (rose.equivalence nat.equivalence)
+ (^open "list@.") (list.equivalence nat.equivalence)]]
+ ($_ _.and
+ (_.test "Trees can be converted to/from zippers."
+ (|> sample
+ /.zip /.unzip
+ (tree@= sample)))
+ (_.test "Creating a zipper gives you a root node."
+ (|> sample /.zip /.root?))
+ (_.test "Can move down inside branches. Can move up from lower nodes."
+ (let [zipper (/.zip sample)]
+ (if (/.branch? zipper)
+ (let [child (|> zipper /.down)]
+ (and (not (tree@= sample (/.unzip child)))
+ (|> child /.up (is? zipper) not)
+ (|> child /.root (is? zipper) not)))
+ (and (/.leaf? zipper)
+ (|> zipper (/.prepend-child new-val) /.branch?)))))
+ (_.test "Can prepend and append children."
+ (let [zipper (/.zip sample)]
+ (if (/.branch? zipper)
+ (let [mid-val (|> zipper /.down /.value)
+ zipper (|> zipper
+ (/.prepend-child pre-val)
+ (/.append-child post-val))]
+ (and (|> zipper /.down /.value (is? pre-val))
+ (|> zipper /.down /.right /.value (is? mid-val))
+ (|> zipper /.down /.right /.right /.value (is? post-val))
+ (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val))
+ (|> zipper /.down /.right /.left /.value (is? pre-val))
+ (|> zipper /.down /.rightmost /.value (is? post-val))))
+ true)))
+ (_.test "Can insert children around a node (unless it's root)."
+ (let [zipper (/.zip sample)]
+ (if (/.branch? zipper)
+ (let [mid-val (|> zipper /.down /.value)
+ zipper (|> zipper
+ /.down
+ (/.insert-left pre-val)
+ maybe.assume
+ (/.insert-right post-val)
+ maybe.assume
+ /.up)]
+ (and (|> zipper /.down /.value (is? pre-val))
+ (|> zipper /.down /.right /.value (is? mid-val))
+ (|> zipper /.down /.right /.right /.value (is? post-val))
+ (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val))
+ (|> zipper /.down /.right /.left /.value (is? pre-val))
+ (|> zipper /.down /.rightmost /.value (is? post-val))))
+ (and (|> zipper (/.insert-left pre-val) (case> (#.Some _) false
+ #.None true))
+ (|> zipper (/.insert-right post-val) (case> (#.Some _) false
+ #.None true))))))
+ (_.test "Can set and update the value of a node."
+ (|> sample /.zip (/.set new-val) /.value (n/= new-val)))
+ (_.test "Zipper traversal follows the outline of the tree depth-first."
+ (list@= (rose.flatten sample)
+ (loop [zipper (/.zip sample)]
+ (if (/.end? zipper)
+ (list (/.value zipper))
+ (#.Cons (/.value zipper)
+ (recur (/.next zipper)))))))
+ (_.test "Backwards zipper traversal yield reverse tree flatten."
+ (list@= (list.reverse (rose.flatten sample))
+ (loop [zipper (to-end (/.zip sample))]
+ (if (/.root? zipper)
+ (list (/.value zipper))
+ (#.Cons (/.value zipper)
+ (recur (/.prev zipper)))))))
+ (_.test "Can remove nodes (except root nodes)."
+ (let [zipper (/.zip sample)]
+ (if (/.branch? zipper)
+ (and (|> zipper /.down /.root? not)
+ (|> zipper /.down /.remove (case> #.None false
+ (#.Some node) (/.root? node))))
+ (|> zipper /.remove (case> #.None true
+ (#.Some _) false)))))
))))
diff --git a/stdlib/source/test/lux/data/maybe.lux b/stdlib/source/test/lux/data/maybe.lux
index 9b3a77ff9..4aa89f85f 100644
--- a/stdlib/source/test/lux/data/maybe.lux
+++ b/stdlib/source/test/lux/data/maybe.lux
@@ -6,10 +6,10 @@
[monad (#+ do)]
{[0 #test]
[/
- ["$." functor (#+ Injection Comparison)]
+ ["$." equivalence]
+ ["$." functor]
["$." apply]
- ["$." monad]
- ["$." equivalence]]}]
+ ["$." monad]]}]
[data
["." text
format]
@@ -19,16 +19,7 @@
[math
["r" random (#+ Random)]]]
{1
- ["." / ("#@." monoid)]})
-
-(def: injection
- (Injection Maybe)
- (|>> #.Some))
-
-(def: comparison
- (Comparison Maybe)
- (function (_ ==)
- (:: (/.equivalence ==) =)))
+ ["." / ("#@." monoid monad)]})
(def: #export maybe
(All [a] (-> (Random a) (Random (Maybe a))))
@@ -39,9 +30,9 @@
(<| (_.context (%name (name-of .Maybe)))
($_ _.and
($equivalence.spec (/.equivalence nat.equivalence) (..maybe r.nat))
- ($functor.spec ..injection ..comparison /.functor)
- ($apply.spec ..injection ..comparison /.apply)
- ($monad.spec ..injection ..comparison /.monad)
+ ($functor.spec /@wrap /.equivalence /.functor)
+ ($apply.spec /@wrap /.equivalence /.apply)
+ ($monad.spec /@wrap /.equivalence /.monad)
(do r.monad
[left r.nat
--
cgit v1.2.3