From 25609806f670b4e6a5ef0b132929c1f4f96ed100 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 16 Oct 2017 19:55:24 -0400 Subject: - Re-named "Vector" to "Sequence" to avoid confusion with mathematical vectors. --- stdlib/source/lux.lux | 6 +- stdlib/source/lux/data/coll/sequence.lux | 441 ++++++++++++++++++++++++++++++ stdlib/source/lux/data/coll/vector.lux | 444 ------------------------------- stdlib/source/lux/data/format/json.lux | 22 +- stdlib/source/lux/host.jvm.lux | 10 +- stdlib/source/lux/macro/poly/eq.lux | 16 +- stdlib/source/lux/macro/poly/json.lux | 8 +- stdlib/source/lux/math/random.lux | 22 +- stdlib/source/lux/time/date.lux | 12 +- stdlib/source/lux/time/instant.lux | 44 +-- 10 files changed, 511 insertions(+), 514 deletions(-) create mode 100644 stdlib/source/lux/data/coll/sequence.lux delete mode 100644 stdlib/source/lux/data/coll/vector.lux (limited to 'stdlib/source') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 7d26ce777..e8bd4d3ea 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -2192,7 +2192,7 @@ (|> data' (join-map (. apply (make-env bindings'))) return) - (fail "Irregular arguments vectors for do-template."))) + (fail "Irregular arguments tuples for do-template."))) _ (fail "Wrong syntax for do-template")) @@ -5625,9 +5625,9 @@ {#;doc (doc "Allows you to refer to the type-variables in a polymorphic function's type, by their index." "In the example below, +0 corresponds to the 'a' variable." (def: #export (from-list list) - (All [a] (-> (List a) (Vector a))) + (All [a] (-> (List a) (Sequence a))) (list/fold add - (: (Vector ($ +0)) + (: (Sequence ($ +0)) empty) list)))} (case tokens diff --git a/stdlib/source/lux/data/coll/sequence.lux b/stdlib/source/lux/data/coll/sequence.lux new file mode 100644 index 000000000..f85558c5e --- /dev/null +++ b/stdlib/source/lux/data/coll/sequence.lux @@ -0,0 +1,441 @@ +(;module: + lux + (lux (control [functor #+ Functor] + [applicative #+ Applicative] + [monad #+ do Monad] + [eq #+ Eq] + monoid + fold + ["p" parser]) + (data [maybe] + (coll [list "list/" Fold Functor Monoid] + [array "array/" Functor Fold]) + [bit] + [product]) + [macro #+ with-gensyms] + (macro [code] + ["s" syntax #+ syntax: Syntax]) + )) + +## [Utils] +(type: (Node a) + (#Base (Array a)) + (#Hierarchy (Array (Node a)))) + +(type: (Base a) (Array a)) +(type: (Hierarchy a) (Array (Node a))) + +(type: Level Nat) + +(type: Index Nat) + +(def: branching-exponent + Nat + +5) + +(def: root-level + Level + +0) + +(do-template [ ] + [(def: + (-> Level Level) + ( branching-exponent))] + + [level-up n.+] + [level-down n.-] + ) + +(def: full-node-size + Nat + (bit;shift-left branching-exponent +1)) + +(def: branch-idx-mask + Nat + (n.dec full-node-size)) + +(def: branch-idx + (-> Index Index) + (bit;and branch-idx-mask)) + +(def: (new-hierarchy _) + (All [a] (-> Top (Hierarchy a))) + (array;new full-node-size)) + +(def: (tail-off vec-size) + (-> Nat Nat) + (if (n.< full-node-size vec-size) + +0 + (|> (n.dec vec-size) + (bit;shift-right branching-exponent) + (bit;shift-left branching-exponent)))) + +(def: (new-path level tail) + (All [a] (-> Level (Base a) (Node a))) + (if (n.= +0 level) + (#Base tail) + (|> (: (Hierarchy ($ +0)) + (new-hierarchy [])) + (array;write +0 (new-path (level-down level) tail)) + #Hierarchy))) + +(def: (new-tail singleton) + (All [a] (-> a (Base a))) + (|> (: (Base ($ +0)) + (array;new +1)) + (array;write +0 singleton))) + +(def: (push-tail size level tail parent) + (All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) + (let [sub-idx (branch-idx (bit;shift-right level (n.dec size))) + ## If we're currently on a bottom node + sub-node (if (n.= branching-exponent level) + ## Just add the tail to it + (#Base tail) + ## Otherwise, check whether there's a vacant spot + (case (array;read sub-idx parent) + ## If so, set the path to the tail + #;None + (new-path (level-down level) tail) + ## If not, push the tail onto the sub-node. + (#;Some (#Hierarchy sub-node)) + (#Hierarchy (push-tail size (level-down level) tail sub-node)) + + _ + (undefined)) + )] + (|> (array;clone parent) + (array;write sub-idx sub-node)))) + +(def: (expand-tail val tail) + (All [a] (-> a (Base a) (Base a))) + (let [tail-size (array;size tail)] + (|> (: (Base ($ +0)) + (array;new (n.inc tail-size))) + (array;copy tail-size +0 tail +0) + (array;write tail-size val) + ))) + +(def: (put' level idx val hierarchy) + (All [a] (-> Level Index a (Hierarchy a) (Hierarchy a))) + (let [sub-idx (branch-idx (bit;shift-right level idx))] + (case (array;read sub-idx hierarchy) + (#;Some (#Hierarchy sub-node)) + (|> (array;clone hierarchy) + (array;write sub-idx (#Hierarchy (put' (level-down level) idx val sub-node)))) + + (^multi (#;Some (#Base base)) + (n.= +0 (level-down level))) + (|> (array;clone hierarchy) + (array;write sub-idx (|> (array;clone base) + (array;write (branch-idx idx) val) + #Base))) + + _ + (undefined)))) + +(def: (pop-tail size level hierarchy) + (All [a] (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a)))) + (let [sub-idx (branch-idx (bit;shift-right level (n.- +2 size)))] + (cond (n.= +0 sub-idx) + #;None + + (n.> branching-exponent level) + (do maybe;Monad + [base|hierarchy (array;read sub-idx hierarchy) + sub (case base|hierarchy + (#Hierarchy sub) + (pop-tail size (level-down level) sub) + + (#Base _) + (undefined))] + (|> (array;clone hierarchy) + (array;write sub-idx (#Hierarchy sub)) + #;Some)) + + ## Else... + (|> (array;clone hierarchy) + (array;delete sub-idx) + #;Some) + ))) + +(def: (to-list' node) + (All [a] (-> (Node a) (List a))) + (case node + (#Base base) + (array;to-list base) + + (#Hierarchy hierarchy) + (|> hierarchy + array;to-list + list;reverse + (list/fold (function [sub acc] (list/compose (to-list' sub) acc)) + #;Nil)))) + +## [Types] +(type: #export (Sequence a) + {#level Level + #size Nat + #root (Hierarchy a) + #tail (Base a)}) + +## [Exports] +(def: #export empty + Sequence + {#level (level-up root-level) + #size +0 + #root (array;new full-node-size) + #tail (array;new +0)}) + +(def: #export (size sequence) + (All [a] (-> (Sequence a) Nat)) + (get@ #size sequence)) + +(def: #export (add val vec) + (All [a] (-> a (Sequence a) (Sequence a))) + ## Check if there is room in the tail. + (let [vec-size (get@ #size vec)] + (if (|> vec-size (n.- (tail-off vec-size)) (n.< full-node-size)) + ## If so, append to it. + (|> vec + (update@ #size n.inc) + (update@ #tail (expand-tail val))) + ## Otherwise, push tail into the tree + ## -------------------------------------------------------- + ## Will the root experience an overflow with this addition? + (|> (if (n.> (bit;shift-left (get@ #level vec) +1) + (bit;shift-right branching-exponent vec-size)) + ## If so, a brand-new root must be established, that is + ## 1-level taller. + (|> vec + (set@ #root (|> (: (Hierarchy ($ +0)) + (new-hierarchy [])) + (array;write +0 (#Hierarchy (get@ #root vec))) + (array;write +1 (new-path (get@ #level vec) (get@ #tail vec))))) + (update@ #level level-up)) + ## Otherwise, just push the current tail onto the root. + (|> vec + (update@ #root (push-tail vec-size (get@ #level vec) (get@ #tail vec))))) + ## Finally, update the size of the Sequence and grow a new + ## tail with the new element as it's sole member. + (update@ #size n.inc) + (set@ #tail (new-tail val))) + ))) + +(def: (base-for idx vec) + (All [a] (-> Index (Sequence a) (Maybe (Base a)))) + (let [vec-size (get@ #size vec)] + (if (and (n.>= +0 idx) + (n.< vec-size idx)) + (if (n.>= (tail-off vec-size) idx) + (#;Some (get@ #tail vec)) + (loop [level (get@ #level vec) + hierarchy (get@ #root vec)] + (case [(n.> branching-exponent level) + (array;read (branch-idx (bit;shift-right level idx)) hierarchy)] + [true (#;Some (#Hierarchy sub))] + (recur (level-down level) sub) + + [false (#;Some (#Base base))] + (#;Some base) + + [_ #;None] + #;None + + _ + (error! "Incorrect sequence structure.")))) + #;None))) + +(def: #export (nth idx vec) + (All [a] (-> Nat (Sequence a) (Maybe a))) + (do maybe;Monad + [base (base-for idx vec)] + (array;read (branch-idx idx) base))) + +(def: #export (put idx val vec) + (All [a] (-> Nat a (Sequence a) (Sequence a))) + (let [vec-size (get@ #size vec)] + (if (and (n.>= +0 idx) + (n.< vec-size idx)) + (if (n.>= (tail-off vec-size) idx) + (|> vec + (update@ #tail (: (-> (Base ($ +0)) (Base ($ +0))) + (|>. array;clone (array;write (branch-idx idx) val))))) + (|> vec + (update@ #root (put' (get@ #level vec) idx val)))) + vec))) + +(def: #export (update idx f vec) + (All [a] (-> Nat (-> a a) (Sequence a) (Sequence a))) + (case (nth idx vec) + (#;Some val) + (put idx (f val) vec) + + #;None + vec)) + +(def: #export (pop vec) + (All [a] (-> (Sequence a) (Sequence a))) + (case (get@ #size vec) + +0 + empty + + +1 + empty + + vec-size + (if (|> vec-size (n.- (tail-off vec-size)) (n.> +1)) + (let [old-tail (get@ #tail vec) + new-tail-size (n.dec (array;size old-tail))] + (|> vec + (update@ #size n.dec) + (set@ #tail (|> (array;new new-tail-size) + (array;copy new-tail-size +0 old-tail +0))))) + (maybe;assume + (do maybe;Monad + [new-tail (base-for (n.- +2 vec-size) vec) + #let [[level' root'] (: [Level (Hierarchy ($ +0))] + (let [init-level (get@ #level vec)] + (loop [level init-level + root (: (Hierarchy ($ +0)) + (maybe;default (new-hierarchy []) + (pop-tail vec-size init-level (get@ #root vec))))] + (if (n.> branching-exponent level) + (case [(array;read +1 root) (array;read +0 root)] + [#;None (#;Some (#Hierarchy sub-node))] + (recur (level-down level) sub-node) + + [#;None (#;Some (#Base _))] + (undefined) + + _ + [level root]) + [level root]))))]] + (wrap (|> vec + (update@ #size n.dec) + (set@ #level level') + (set@ #root root') + (set@ #tail new-tail)))))) + )) + +(def: #export (to-list vec) + (All [a] (-> (Sequence a) (List a))) + (list/compose (to-list' (#Hierarchy (get@ #root vec))) + (to-list' (#Base (get@ #tail vec))))) + +(def: #export (from-list list) + (All [a] (-> (List a) (Sequence a))) + (list/fold add + (: (Sequence ($ +0)) + empty) + list)) + +(def: #export (member? a/Eq vec val) + (All [a] (-> (Eq a) (Sequence a) a Bool)) + (list;member? a/Eq (to-list vec) val)) + +(def: #export empty? + (All [a] (-> (Sequence a) Bool)) + (|>. (get@ #size) (n.= +0))) + +## [Syntax] +(syntax: #export (sequence [elems (p;some s;any)]) + {#;doc (doc "Sequence literals." + (sequence 10 20 30 40))} + (wrap (list (` (from-list (list (~@ elems))))))) + +## [Structures] +(struct: #export (Eq Eq) (All [a] (-> (Eq a) (Eq (Node a)))) + (def: (= v1 v2) + (case [v1 v2] + [(#Base b1) (#Base b2)] + (:: (array;Eq Eq) = b1 b2) + + [(#Hierarchy h1) (#Hierarchy h2)] + (:: (array;Eq (Eq Eq)) = h1 h2) + ))) + +(struct: #export (Eq Eq) (All [a] (-> (Eq a) (Eq (Sequence a)))) + (def: (= v1 v2) + (and (n.= (get@ #size v1) (get@ #size v2)) + (let [(^open "Node/") (Eq Eq)] + (and (Node/= (#Base (get@ #tail v1)) + (#Base (get@ #tail v2))) + (Node/= (#Hierarchy (get@ #root v1)) + (#Hierarchy (get@ #root v2)))))))) + +(struct: _ (Fold Node) + (def: (fold f init xs) + (case xs + (#Base base) + (array/fold f init base) + + (#Hierarchy hierarchy) + (array/fold (function [node init'] (fold f init' node)) + init + hierarchy)) + )) + +(struct: #export _ (Fold Sequence) + (def: (fold f init xs) + (let [(^open) Fold] + (fold f + (fold f + init + (#Hierarchy (get@ #root xs))) + (#Base (get@ #tail xs)))) + )) + +(struct: #export Monoid (All [a] + (Monoid (Sequence a))) + (def: identity empty) + (def: (compose xs ys) + (list/fold add xs (to-list ys)))) + +(struct: _ (Functor Node) + (def: (map f xs) + (case xs + (#Base base) + (#Base (array/map f base)) + + (#Hierarchy hierarchy) + (#Hierarchy (array/map (map f) hierarchy))) + )) + +(struct: #export _ (Functor Sequence) + (def: (map f xs) + {#level (get@ #level xs) + #size (get@ #size xs) + #root (|> xs (get@ #root) (array/map (:: Functor map f))) + #tail (|> xs (get@ #tail) (array/map f)) + })) + +(struct: #export _ (Applicative Sequence) + (def: functor Functor) + + (def: (wrap x) + (sequence x)) + + (def: (apply ff fa) + (let [(^open) Functor + (^open) Fold + (^open) Monoid + results (map (function [f] (map f fa)) + ff)] + (fold compose identity results))) + ) + +(struct: #export _ (Monad Sequence) + (def: applicative Applicative) + + (def: join + (let [(^open) Fold + (^open) Monoid] + (fold (function [post pre] (compose pre post)) identity))) + ) + +(def: #export (reverse xs) + (All [a] (-> (Sequence a) (Sequence a))) + (let [(^open) Fold + (^open) Monoid] + (fold add identity xs))) diff --git a/stdlib/source/lux/data/coll/vector.lux b/stdlib/source/lux/data/coll/vector.lux deleted file mode 100644 index 956850a87..000000000 --- a/stdlib/source/lux/data/coll/vector.lux +++ /dev/null @@ -1,444 +0,0 @@ -(;module: - lux - (lux (control [functor #+ Functor] - [applicative #+ Applicative] - [monad #+ do Monad] - [eq #+ Eq] - monoid - fold - ["p" parser]) - (data [maybe] - (coll [list "list/" Fold Functor Monoid] - [array "array/" Functor Fold]) - [bit] - [product]) - [macro #+ with-gensyms] - (macro [code] - ["s" syntax #+ syntax: Syntax]) - )) - -## This implementation of vectors is based on Clojure's -## PersistentVector implementation. - -## [Utils] -(type: (Node a) - (#Base (Array a)) - (#Hierarchy (Array (Node a)))) - -(type: (Base a) (Array a)) -(type: (Hierarchy a) (Array (Node a))) - -(type: Level Nat) - -(type: Index Nat) - -(def: branching-exponent - Nat - +5) - -(def: root-level - Level - +0) - -(do-template [ ] - [(def: - (-> Level Level) - ( branching-exponent))] - - [level-up n.+] - [level-down n.-] - ) - -(def: full-node-size - Nat - (bit;shift-left branching-exponent +1)) - -(def: branch-idx-mask - Nat - (n.dec full-node-size)) - -(def: branch-idx - (-> Index Index) - (bit;and branch-idx-mask)) - -(def: (new-hierarchy _) - (All [a] (-> Top (Hierarchy a))) - (array;new full-node-size)) - -(def: (tail-off vec-size) - (-> Nat Nat) - (if (n.< full-node-size vec-size) - +0 - (|> (n.dec vec-size) - (bit;shift-right branching-exponent) - (bit;shift-left branching-exponent)))) - -(def: (new-path level tail) - (All [a] (-> Level (Base a) (Node a))) - (if (n.= +0 level) - (#Base tail) - (|> (: (Hierarchy ($ +0)) - (new-hierarchy [])) - (array;write +0 (new-path (level-down level) tail)) - #Hierarchy))) - -(def: (new-tail singleton) - (All [a] (-> a (Base a))) - (|> (: (Base ($ +0)) - (array;new +1)) - (array;write +0 singleton))) - -(def: (push-tail size level tail parent) - (All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (bit;shift-right level (n.dec size))) - ## If we're currently on a bottom node - sub-node (if (n.= branching-exponent level) - ## Just add the tail to it - (#Base tail) - ## Otherwise, check whether there's a vacant spot - (case (array;read sub-idx parent) - ## If so, set the path to the tail - #;None - (new-path (level-down level) tail) - ## If not, push the tail onto the sub-node. - (#;Some (#Hierarchy sub-node)) - (#Hierarchy (push-tail size (level-down level) tail sub-node)) - - _ - (undefined)) - )] - (|> (array;clone parent) - (array;write sub-idx sub-node)))) - -(def: (expand-tail val tail) - (All [a] (-> a (Base a) (Base a))) - (let [tail-size (array;size tail)] - (|> (: (Base ($ +0)) - (array;new (n.inc tail-size))) - (array;copy tail-size +0 tail +0) - (array;write tail-size val) - ))) - -(def: (put' level idx val hierarchy) - (All [a] (-> Level Index a (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (bit;shift-right level idx))] - (case (array;read sub-idx hierarchy) - (#;Some (#Hierarchy sub-node)) - (|> (array;clone hierarchy) - (array;write sub-idx (#Hierarchy (put' (level-down level) idx val sub-node)))) - - (^multi (#;Some (#Base base)) - (n.= +0 (level-down level))) - (|> (array;clone hierarchy) - (array;write sub-idx (|> (array;clone base) - (array;write (branch-idx idx) val) - #Base))) - - _ - (undefined)))) - -(def: (pop-tail size level hierarchy) - (All [a] (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a)))) - (let [sub-idx (branch-idx (bit;shift-right level (n.- +2 size)))] - (cond (n.= +0 sub-idx) - #;None - - (n.> branching-exponent level) - (do maybe;Monad - [base|hierarchy (array;read sub-idx hierarchy) - sub (case base|hierarchy - (#Hierarchy sub) - (pop-tail size (level-down level) sub) - - (#Base _) - (undefined))] - (|> (array;clone hierarchy) - (array;write sub-idx (#Hierarchy sub)) - #;Some)) - - ## Else... - (|> (array;clone hierarchy) - (array;delete sub-idx) - #;Some) - ))) - -(def: (to-list' node) - (All [a] (-> (Node a) (List a))) - (case node - (#Base base) - (array;to-list base) - - (#Hierarchy hierarchy) - (|> hierarchy - array;to-list - list;reverse - (list/fold (function [sub acc] (list/compose (to-list' sub) acc)) - #;Nil)))) - -## [Types] -(type: #export (Vector a) - {#level Level - #size Nat - #root (Hierarchy a) - #tail (Base a)}) - -## [Exports] -(def: #export empty - Vector - {#level (level-up root-level) - #size +0 - #root (array;new full-node-size) - #tail (array;new +0)}) - -(def: #export (size vector) - (All [a] (-> (Vector a) Nat)) - (get@ #size vector)) - -(def: #export (add val vec) - (All [a] (-> a (Vector a) (Vector a))) - ## Check if there is room in the tail. - (let [vec-size (get@ #size vec)] - (if (|> vec-size (n.- (tail-off vec-size)) (n.< full-node-size)) - ## If so, append to it. - (|> vec - (update@ #size n.inc) - (update@ #tail (expand-tail val))) - ## Otherwise, push tail into the tree - ## -------------------------------------------------------- - ## Will the root experience an overflow with this addition? - (|> (if (n.> (bit;shift-left (get@ #level vec) +1) - (bit;shift-right branching-exponent vec-size)) - ## If so, a brand-new root must be established, that is - ## 1-level taller. - (|> vec - (set@ #root (|> (: (Hierarchy ($ +0)) - (new-hierarchy [])) - (array;write +0 (#Hierarchy (get@ #root vec))) - (array;write +1 (new-path (get@ #level vec) (get@ #tail vec))))) - (update@ #level level-up)) - ## Otherwise, just push the current tail onto the root. - (|> vec - (update@ #root (push-tail vec-size (get@ #level vec) (get@ #tail vec))))) - ## Finally, update the size of the Vector and grow a new - ## tail with the new element as it's sole member. - (update@ #size n.inc) - (set@ #tail (new-tail val))) - ))) - -(def: (base-for idx vec) - (All [a] (-> Index (Vector a) (Maybe (Base a)))) - (let [vec-size (get@ #size vec)] - (if (and (n.>= +0 idx) - (n.< vec-size idx)) - (if (n.>= (tail-off vec-size) idx) - (#;Some (get@ #tail vec)) - (loop [level (get@ #level vec) - hierarchy (get@ #root vec)] - (case [(n.> branching-exponent level) - (array;read (branch-idx (bit;shift-right level idx)) hierarchy)] - [true (#;Some (#Hierarchy sub))] - (recur (level-down level) sub) - - [false (#;Some (#Base base))] - (#;Some base) - - [_ #;None] - #;None - - _ - (error! "Incorrect vector structure.")))) - #;None))) - -(def: #export (nth idx vec) - (All [a] (-> Nat (Vector a) (Maybe a))) - (do maybe;Monad - [base (base-for idx vec)] - (array;read (branch-idx idx) base))) - -(def: #export (put idx val vec) - (All [a] (-> Nat a (Vector a) (Vector a))) - (let [vec-size (get@ #size vec)] - (if (and (n.>= +0 idx) - (n.< vec-size idx)) - (if (n.>= (tail-off vec-size) idx) - (|> vec - (update@ #tail (: (-> (Base ($ +0)) (Base ($ +0))) - (|>. array;clone (array;write (branch-idx idx) val))))) - (|> vec - (update@ #root (put' (get@ #level vec) idx val)))) - vec))) - -(def: #export (update idx f vec) - (All [a] (-> Nat (-> a a) (Vector a) (Vector a))) - (case (nth idx vec) - (#;Some val) - (put idx (f val) vec) - - #;None - vec)) - -(def: #export (pop vec) - (All [a] (-> (Vector a) (Vector a))) - (case (get@ #size vec) - +0 - empty - - +1 - empty - - vec-size - (if (|> vec-size (n.- (tail-off vec-size)) (n.> +1)) - (let [old-tail (get@ #tail vec) - new-tail-size (n.dec (array;size old-tail))] - (|> vec - (update@ #size n.dec) - (set@ #tail (|> (array;new new-tail-size) - (array;copy new-tail-size +0 old-tail +0))))) - (maybe;assume - (do maybe;Monad - [new-tail (base-for (n.- +2 vec-size) vec) - #let [[level' root'] (: [Level (Hierarchy ($ +0))] - (let [init-level (get@ #level vec)] - (loop [level init-level - root (: (Hierarchy ($ +0)) - (maybe;default (new-hierarchy []) - (pop-tail vec-size init-level (get@ #root vec))))] - (if (n.> branching-exponent level) - (case [(array;read +1 root) (array;read +0 root)] - [#;None (#;Some (#Hierarchy sub-node))] - (recur (level-down level) sub-node) - - [#;None (#;Some (#Base _))] - (undefined) - - _ - [level root]) - [level root]))))]] - (wrap (|> vec - (update@ #size n.dec) - (set@ #level level') - (set@ #root root') - (set@ #tail new-tail)))))) - )) - -(def: #export (to-list vec) - (All [a] (-> (Vector a) (List a))) - (list/compose (to-list' (#Hierarchy (get@ #root vec))) - (to-list' (#Base (get@ #tail vec))))) - -(def: #export (from-list list) - (All [a] (-> (List a) (Vector a))) - (list/fold add - (: (Vector ($ +0)) - empty) - list)) - -(def: #export (member? a/Eq vec val) - (All [a] (-> (Eq a) (Vector a) a Bool)) - (list;member? a/Eq (to-list vec) val)) - -(def: #export empty? - (All [a] (-> (Vector a) Bool)) - (|>. (get@ #size) (n.= +0))) - -## [Syntax] -(syntax: #export (vector [elems (p;some s;any)]) - {#;doc (doc "Vector literals." - (vector 10 20 30 40))} - (wrap (list (` (from-list (list (~@ elems))))))) - -## [Structures] -(struct: #export (Eq Eq) (All [a] (-> (Eq a) (Eq (Node a)))) - (def: (= v1 v2) - (case [v1 v2] - [(#Base b1) (#Base b2)] - (:: (array;Eq Eq) = b1 b2) - - [(#Hierarchy h1) (#Hierarchy h2)] - (:: (array;Eq (Eq Eq)) = h1 h2) - ))) - -(struct: #export (Eq Eq) (All [a] (-> (Eq a) (Eq (Vector a)))) - (def: (= v1 v2) - (and (n.= (get@ #size v1) (get@ #size v2)) - (let [(^open "Node/") (Eq Eq)] - (and (Node/= (#Base (get@ #tail v1)) - (#Base (get@ #tail v2))) - (Node/= (#Hierarchy (get@ #root v1)) - (#Hierarchy (get@ #root v2)))))))) - -(struct: _ (Fold Node) - (def: (fold f init xs) - (case xs - (#Base base) - (array/fold f init base) - - (#Hierarchy hierarchy) - (array/fold (function [node init'] (fold f init' node)) - init - hierarchy)) - )) - -(struct: #export _ (Fold Vector) - (def: (fold f init xs) - (let [(^open) Fold] - (fold f - (fold f - init - (#Hierarchy (get@ #root xs))) - (#Base (get@ #tail xs)))) - )) - -(struct: #export Monoid (All [a] - (Monoid (Vector a))) - (def: identity empty) - (def: (compose xs ys) - (list/fold add xs (to-list ys)))) - -(struct: _ (Functor Node) - (def: (map f xs) - (case xs - (#Base base) - (#Base (array/map f base)) - - (#Hierarchy hierarchy) - (#Hierarchy (array/map (map f) hierarchy))) - )) - -(struct: #export _ (Functor Vector) - (def: (map f xs) - {#level (get@ #level xs) - #size (get@ #size xs) - #root (|> xs (get@ #root) (array/map (:: Functor map f))) - #tail (|> xs (get@ #tail) (array/map f)) - })) - -(struct: #export _ (Applicative Vector) - (def: functor Functor) - - (def: (wrap x) - (vector x)) - - (def: (apply ff fa) - (let [(^open) Functor - (^open) Fold - (^open) Monoid - results (map (function [f] (map f fa)) - ff)] - (fold compose identity results))) - ) - -(struct: #export _ (Monad Vector) - (def: applicative Applicative) - - (def: join - (let [(^open) Fold - (^open) Monoid] - (fold (function [post pre] (compose pre post)) identity))) - ) - -(def: #export (reverse xs) - (All [a] (-> (Vector a) (Vector a))) - (let [(^open) Fold - (^open) Monoid] - (fold add identity xs))) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 7eac167e1..e00783c0b 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -15,7 +15,7 @@ [sum] [product] (coll [list "list/" Fold Monad] - [vector #+ Vector vector "vector/" Monad] + [sequence #+ Sequence sequence "sequence/" Monad] [dict #+ Dict])) [macro #+ Monad with-gensyms] (macro ["s" syntax #+ syntax:] @@ -38,13 +38,13 @@ (#Boolean Boolean) (#Number Number) (#String String) - (#Array (Vector JSON)) + (#Array (Sequence JSON)) (#Object (Dict String JSON))) (do-template [ ] [(type: #export )] - [Array (Vector JSON)] + [Array (Sequence JSON)] [Object (Dict String JSON)] ) @@ -75,7 +75,7 @@ (wrap (list (` (: JSON #Null)))) [_ (#;Tuple members)] - (wrap (list (` (: JSON (#Array (vector (~@ (list/map wrapper members)))))))) + (wrap (list (` (: JSON (#Array (sequence (~@ (list/map wrapper members)))))))) [_ (#;Record pairs)] (do Monad @@ -164,16 +164,16 @@ [#String text;Eq]) [(#Array xs) (#Array ys)] - (and (n.= (vector;size xs) (vector;size ys)) + (and (n.= (sequence;size xs) (sequence;size ys)) (list/fold (function [idx prev] (and prev (maybe;default false (do maybe;Monad - [x' (vector;nth idx xs) - y' (vector;nth idx ys)] + [x' (sequence;nth idx xs) + y' (sequence;nth idx ys)] (wrap (= x' y')))))) true - (list;indices (vector;size xs)))) + (list;indices (sequence;size xs)))) [(#Object xs) (#Object ys)] (and (n.= (dict;size xs) (dict;size ys)) @@ -288,7 +288,7 @@ [head any] (case head (#Array values) - (case (p;run (vector;to-list values) parser) + (case (p;run (sequence;to-list values) parser) (#E;Error error) (fail error) @@ -367,7 +367,7 @@ (def: (show-array show-json elems) (-> (-> JSON Text) (-> Array Text)) ($_ text/compose "[" - (|> elems (vector/map show-json) vector;to-list (text;join-with ",")) + (|> elems (sequence/map show-json) sequence;to-list (text;join-with ",")) "]")) (def: (show-object show-json object) @@ -490,7 +490,7 @@ _ (l;this )] (wrap ( elems))))] - [array~ Array "[" "]" (json~ []) vector;from-list] + [array~ Array "[" "]" (json~ []) sequence;from-list] [object~ Object "{" "}" (kv~ json~) (dict;from-list text;Hash)] ) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index d5e9a7837..c4ee39c4b 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1295,8 +1295,8 @@ []) ) - "The vector corresponds to parent interfaces." - "An optional super-class can be specified before the vector. If not specified, java.lang.Object will be assumed." + "The tuple corresponds to parent interfaces." + "An optional super-class can be specified before the tuple. If not specified, java.lang.Object will be assumed." "Fields and methods defined in the class can be used with special syntax." "For example:" ".resolved, for accessing the \"resolved\" field." @@ -1352,9 +1352,9 @@ [constructor-args (constructor-args^ imports class-vars)] [methods (p;some (overriden-method-def^ imports))]) {#;doc (doc "Allows defining anonymous classes." - "The 1st vector corresponds to parent interfaces." - "The 2nd vector corresponds to arguments to the super class constructor." - "An optional super-class can be specified before the 1st vector. If not specified, java.lang.Object will be assumed." + "The 1st tuple corresponds to parent interfaces." + "The 2nd tuple corresponds to arguments to the super class constructor." + "An optional super-class can be specified before the 1st tuple. If not specified, java.lang.Object will be assumed." (object [Runnable] [] (Runnable [] (run) void diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index 13af05adc..4c376d742 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -6,7 +6,7 @@ (data [text "text/" Monoid] text/format (coll [list "list/" Monad] - [vector] + [sequence] [array] [queue] [set] @@ -62,13 +62,13 @@ (wrap (` (: (~ (@Eq inputT)) ( (~ argC))))))] - [;Maybe maybe;Eq] - [;List list;Eq] - [vector;Vector vector;Eq] - [;Array array;Eq] - [queue;Queue queue;Eq] - [set;Set set;Eq] - [rose;Tree rose;Eq] + [;Maybe maybe;Eq] + [;List list;Eq] + [sequence;Sequence sequence;Eq] + [;Array array;Eq] + [queue;Queue queue;Eq] + [set;Set set;Eq] + [rose;Tree rose;Eq] )] (do @ [#let [g!_ (code;local-symbol "\u0000_")] diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 1b66e39f5..ab0dab936 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -14,7 +14,7 @@ [sum] [product] (coll [list "list/" Fold Monad] - [vector #+ Vector vector "vector/" Monad] + [sequence #+ Sequence sequence "sequence/" Monad] ["d" dict]) (format [".." json #+ JSON])) (time ["i" instant] @@ -50,8 +50,8 @@ (def: (encode input) (let [high (|> input (bit;and high-mask) (bit;shift-right +32)) low (bit;and low-mask input)] - (#..;Array (vector (|> high nat-to-int int-to-frac #..;Number) - (|> low nat-to-int int-to-frac #..;Number))))) + (#..;Array (sequence (|> high nat-to-int int-to-frac #..;Number) + (|> low nat-to-int int-to-frac #..;Number))))) (def: (decode input) (<| (..;run input) (do p;Monad @@ -143,7 +143,7 @@ (poly;this ;List) Codec//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (|>. (;;_map_ (~ .sub.)) vector;from-list #..;Array))))) + (|>. (;;_map_ (~ .sub.)) sequence;from-list #..;Array))))) (do @ [#let [g!input (code;local-symbol "\u0000input")] members (poly;variant (p;many Codec//encode))] diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 00852b46d..138f9723e 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -17,7 +17,7 @@ [queue #+ Queue] [set #+ Set] [stack #+ Stack] - [vector #+ Vector])) + [sequence #+ Sequence])) )) (type: #export #rec PRNG @@ -189,8 +189,8 @@ (wrap ( x xs))) (:: Monad wrap )))] - [list List (;list) #;Cons] - [vector Vector vector;empty vector;add] + [list List (;list) #;Cons] + [sequence Sequence sequence;empty sequence;add] ) (do-template [ ] @@ -272,21 +272,21 @@ )) (def: (swap from to vec) - (All [a] (-> Nat Nat (Vector a) (Vector a))) + (All [a] (-> Nat Nat (Sequence a) (Sequence a))) (|> vec - (vector;put to (maybe;assume (vector;nth from vec))) - (vector;put from (maybe;assume (vector;nth to vec))))) + (sequence;put to (maybe;assume (sequence;nth from vec))) + (sequence;put from (maybe;assume (sequence;nth to vec))))) -(def: #export (shuffle seed vector) - {#;doc "Shuffle a vector randomly based on a seed value."} - (All [a] (-> Nat (Vector a) (Vector a))) - (let [_size (vector;size vector) +(def: #export (shuffle seed sequence) + {#;doc "Shuffle a sequence randomly based on a seed value."} + (All [a] (-> Nat (Sequence a) (Sequence a))) + (let [_size (sequence;size sequence) _shuffle (monad;fold Monad (function [idx vec] (do Monad [rand nat] (wrap (swap idx (n.% _size rand) vec)))) - vector + sequence (list;n.range +0 (n.dec _size)))] (|> _shuffle (run (pcg-32 [+123 seed])) diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index b513ef07c..3f2dc7255 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -11,7 +11,7 @@ [number "int/" Codec] [text "text/" Monoid] (text ["l" lexer]) - (coll ["v" vector])))) + (coll [sequence #+ Sequence sequence])))) (type: #export Year Int) @@ -252,15 +252,15 @@ (i.+ (i./ 400 year)))) (def: normal-months - (v;Vector Nat) - (v;vector +31 +28 +31 + (Sequence Nat) + (sequence +31 +28 +31 +30 +31 +30 +31 +31 +30 +31 +30 +31)) (def: leap-year-months - (v;Vector Nat) - (v;update [+1] n.inc normal-months)) + (Sequence Nat) + (sequence;update [+1] n.inc normal-months)) (def: (divisible? factor input) (-> Int Int Bool) @@ -286,7 +286,7 @@ leap-year-months normal-months) month-days (|> months - (v;nth (int-to-nat (i.dec utc-month))) + (sequence;nth (int-to-nat (i.dec utc-month))) maybe;assume)] _ (l;this "-") utc-day lex-section diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 31da7dc29..d04b7c845 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -13,7 +13,7 @@ ["E" error] [maybe] (coll [list "L/" Fold Functor] - ["v" vector "v/" Functor Fold])) + [sequence #+ Sequence sequence "sequence/" Functor Fold])) (type opaque)) (.. [duration "duration/" Order] [date])) @@ -102,33 +102,33 @@ )))) (def: normal-months - (v;Vector Nat) - (v;vector +31 +28 +31 + (Sequence Nat) + (sequence +31 +28 +31 +30 +31 +30 +31 +31 +30 +31 +30 +31)) (def: leap-year-months - (v;Vector Nat) - (v;update [+1] n.inc normal-months)) + (Sequence Nat) + (sequence;update [+1] n.inc normal-months)) (def: (find-month months time) - (-> (v;Vector Nat) duration;Duration [Nat duration;Duration]) + (-> (Sequence Nat) duration;Duration [Nat duration;Duration]) (if (duration/>= duration;empty time) - (v/fold (function [month-days [current-month time-left]] - (let [month-duration (duration;scale (nat-to-int month-days) duration;day)] - (if (i.= 0 (duration;query month-duration time-left)) - [current-month time-left] - [(n.inc current-month) (duration;merge (duration;scale -1 month-duration) time-left)]))) - [+0 time] - months) - (v/fold (function [month-days [current-month time-left]] - (let [month-duration (duration;scale (nat-to-int month-days) duration;day)] - (if (i.= 0 (duration;query month-duration time-left)) - [current-month time-left] - [(n.dec current-month) (duration;merge month-duration time-left)]))) - [+11 time] - (v;reverse months)))) + (sequence/fold (function [month-days [current-month time-left]] + (let [month-duration (duration;scale (nat-to-int month-days) duration;day)] + (if (i.= 0 (duration;query month-duration time-left)) + [current-month time-left] + [(n.inc current-month) (duration;merge (duration;scale -1 month-duration) time-left)]))) + [+0 time] + months) + (sequence/fold (function [month-days [current-month time-left]] + (let [month-duration (duration;scale (nat-to-int month-days) duration;day)] + (if (i.= 0 (duration;query month-duration time-left)) + [current-month time-left] + [(n.dec current-month) (duration;merge month-duration time-left)]))) + [+11 time] + (sequence;reverse months)))) (def: (pad value) (-> Int Text) @@ -252,7 +252,7 @@ leap-year-months normal-months) month-days (|> months - (v;nth (int-to-nat (i.dec utc-month))) + (sequence;nth (int-to-nat (i.dec utc-month))) maybe;assume)] _ (l;this "-") utc-day lex-section @@ -282,7 +282,7 @@ year-days-so-far (|> (i.* 365 years-since-epoch) (i.+ previous-leap-days)) month-days-so-far (|> months - v;to-list + sequence;to-list (list;take (int-to-nat (i.dec utc-month))) (L/fold n.+ +0)) total-days (|> year-days-so-far -- cgit v1.2.3