diff options
29 files changed, 1414 insertions, 1339 deletions
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<a>) +(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<a> = 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) [])] [(<op> 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<k> 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<k>) kvs)) @@ -617,7 +616,7 @@ (do-template [<name> <elem-type> <side>] [(def: #export (<name> dict) (All [k v] (-> (Dictionary k v) (List <elem-type>))) - (|> dict entries (list;map <side>)))] + (|> dict entries (list@map <side>)))] [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<k> _] 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<k>) keys))) -## [Structures] -(structure: #export (equivalence Equivalence<v>) (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<v> = 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<k>) +(def: #export (new order) (All [k v] (-> (Order k) (Dictionary k v))) - {#order Order<k> + {#&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<v>) (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<k> (:: 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<k> = keyR keyS) - (:: Equivalence<v> = 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<a> list) + (def: #export (from-list &order list) (All [a] (-> (Order a) (List a) (Set a))) - (list;fold add (new Order<a>) 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<a>) (All [a] (-> (Equivalence a) (Equivalence (Tree a)))) (def: (= tx ty) (and (:: Equivalence<a> = (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 |