From 9d0eaa97963d4e37a6afbe30f62c5bb9991ef49e Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 16 Oct 2017 18:13:12 -0400
Subject: - Moved Array type to lux.lux. - Re-named some array functions. -
Minor refactorings.
---
stdlib/source/lux.lux | 4 +
stdlib/source/lux/data/coll/array.lux | 65 +++----
stdlib/source/lux/data/coll/dict.lux | 292 +++++++++++++++----------------
stdlib/source/lux/data/coll/vector.lux | 75 ++++----
stdlib/source/lux/data/format/json.lux | 2 +-
stdlib/source/lux/data/number.lux | 2 +-
stdlib/source/lux/host.jvm.lux | 281 +++++++++++++++--------------
stdlib/source/lux/macro/poly.lux | 24 +--
stdlib/source/lux/macro/poly/eq.lux | 24 +--
stdlib/source/lux/macro/poly/json.lux | 40 ++---
stdlib/source/lux/math/random.lux | 72 ++++----
stdlib/source/lux/world/net/udp.jvm.lux | 2 +-
stdlib/test/test/lux/data/coll/array.lux | 80 ++++-----
13 files changed, 479 insertions(+), 484 deletions(-)
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 3c1edac4b..7d26ce777 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -5863,3 +5863,7 @@
(if test
(f value)
value)))
+
+(type: #export (Array a)
+ {#;doc "Mutable arrays."}
+ (#;Host "#Array" (#;Cons a #;Nil)))
diff --git a/stdlib/source/lux/data/coll/array.lux b/stdlib/source/lux/data/coll/array.lux
index 750e6b610..833da6230 100644
--- a/stdlib/source/lux/data/coll/array.lux
+++ b/stdlib/source/lux/data/coll/array.lux
@@ -1,19 +1,13 @@
(;module:
lux
(lux (control monoid
- ["F" functor]
+ [functor #+ Functor]
[eq #+ Eq]
fold)
- (data (coll [list "List/" Fold<List>])
+ (data (coll [list "list/" Fold<List>])
[product])
))
-## [Types]
-(type: #export (Array a)
- {#;doc "Mutable arrays."}
- (#;Host "#Array" (#;Cons a #;Nil)))
-
-## [Functions]
(def: #export (new size)
(All [a] (-> Nat (Array a)))
(_lux_proc ["array" "new"] [size]))
@@ -22,17 +16,17 @@
(All [a] (-> (Array a) Nat))
(_lux_proc ["array" "size"] [xs]))
-(def: #export (get i xs)
+(def: #export (read i xs)
(All [a]
(-> Nat (Array a) (Maybe a)))
(_lux_proc ["array" "get"] [xs i]))
-(def: #export (put i x xs)
+(def: #export (write i x xs)
(All [a]
(-> Nat a (Array a) (Array a)))
(_lux_proc ["array" "put"] [xs i x]))
-(def: #export (remove i xs)
+(def: #export (delete i xs)
(All [a]
(-> Nat (Array a) (Array a)))
(_lux_proc ["array" "remove"] [xs i]))
@@ -42,21 +36,21 @@
(Array a)))
(if (n.= +0 length)
dest-array
- (List/fold (function [offset target]
- (case (get (n.+ offset src-start) src-array)
+ (list/fold (function [offset target]
+ (case (read (n.+ offset src-start) src-array)
#;None
target
(#;Some value)
- (put (n.+ offset dest-start) value target)))
+ (write (n.+ offset dest-start) value target)))
dest-array
(list;n.range +0 (n.dec length)))))
(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]
- (case (get idx array)
+ (list/fold (function [idx count]
+ (case (read idx array)
#;None
count
@@ -73,16 +67,16 @@
(def: #export (filter p xs)
(All [a]
(-> (-> a Bool) (Array a) (Array a)))
- (List/fold (: (-> Nat (Array ($ +0)) (Array ($ +0)))
+ (list/fold (: (-> Nat (Array ($ +0)) (Array ($ +0)))
(function [idx xs']
- (case (get idx xs)
+ (case (read idx xs)
#;None
xs'
(#;Some x)
(if (p x)
xs'
- (remove idx xs')))))
+ (delete idx xs')))))
xs
(list;indices (size xs))))
@@ -92,7 +86,7 @@
(let [arr-size (size xs)]
(loop [idx +0]
(if (n.< arr-size idx)
- (case (get idx xs)
+ (case (read idx xs)
#;None
(recur (n.inc idx))
@@ -109,7 +103,7 @@
(let [arr-size (size xs)]
(loop [idx +0]
(if (n.< arr-size idx)
- (case (get idx xs)
+ (case (read idx xs)
#;None
(recur (n.inc idx))
@@ -122,28 +116,28 @@
(def: #export (clone xs)
(All [a] (-> (Array a) (Array a)))
(let [arr-size (size xs)]
- (List/fold (function [idx ys]
- (case (get idx xs)
+ (list/fold (function [idx ys]
+ (case (read idx xs)
#;None
ys
(#;Some x)
- (put idx x ys)))
+ (write idx x ys)))
(new arr-size)
(list;indices arr-size))))
(def: #export (from-list xs)
(All [a] (-> (List a) (Array a)))
- (product;right (List/fold (function [x [idx arr]]
- [(n.inc idx) (put idx x arr)])
+ (product;right (list/fold (function [x [idx arr]]
+ [(n.inc idx) (write idx x arr)])
[+0 (new (list;size xs))]
xs)))
(def: #export (to-list array)
(All [a] (-> (Array a) (List a)))
(let [_size (size array)]
- (product;right (List/fold (function [_ [idx tail]]
- (case (get idx array)
+ (product;right (list/fold (function [_ [idx tail]]
+ (case (read idx array)
(#;Some head)
[(n.dec idx) (#;Cons head tail)]
@@ -153,16 +147,15 @@
(list;repeat _size [])
))))
-## [Structures]
(struct: #export (Eq<Array> Eq<a>)
(All [a] (-> (Eq a) (Eq (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 [(get idx xs) (get idx ys)]
+ (case [(read idx xs) (read idx ys)]
[#;None #;None]
true
@@ -186,19 +179,19 @@
(copy sxs +0 xs +0)
(copy sxy +0 ys sxs)))))
-(struct: #export _ (F;Functor Array)
+(struct: #export _ (Functor Array)
(def: (map f ma)
(let [arr-size (size ma)]
(if (n.= +0 arr-size)
(new arr-size)
- (List/fold (: (-> Nat (Array ($ +1)) (Array ($ +1)))
+ (list/fold (: (-> Nat (Array ($ +1)) (Array ($ +1)))
(function [idx mb]
- (case (get idx ma)
+ (case (read idx ma)
#;None
mb
(#;Some x)
- (put idx (f x) mb))))
+ (write idx (f x) mb))))
(new arr-size)
(list;n.range +0 (n.dec arr-size)))))))
@@ -208,7 +201,7 @@
(loop [so-far init
idx +0]
(if (n.< arr-size idx)
- (case (get idx xs)
+ (case (read idx xs)
#;None
(recur so-far (n.inc idx))
diff --git a/stdlib/source/lux/data/coll/dict.lux b/stdlib/source/lux/data/coll/dict.lux
index 531953a87..d5528dc09 100644
--- a/stdlib/source/lux/data/coll/dict.lux
+++ b/stdlib/source/lux/data/coll/dict.lux
@@ -3,8 +3,8 @@
(lux (control hash
[eq #+ Eq])
(data maybe
- (coll [list "L/" Fold<List> Functor<List> Monoid<List>]
- [array #+ Array "Array/" Functor<Array> Fold<Array>])
+ (coll [list "list/" Fold<List> Functor<List> Monoid<List>]
+ [array "array/" Functor<Array> Fold<Array>])
[bit]
[product]
[number])
@@ -55,7 +55,7 @@
[Nat (Array (Node k v))])
## #Base nodes may point down to other nodes, but also to leaves,
-## which are KV pairs.
+## which are KV-pairs.
(type: (Base k v)
(Array (Either (Node k v)
[k v])))
@@ -123,18 +123,18 @@
(|> (: (Array ($ +0))
(array;new (n.inc old-size)))
(array;copy idx +0 old-array +0)
- (array;put idx value)
+ (array;write idx value)
(array;copy (n.- idx old-size) idx old-array (n.inc idx)))))
## Creates a copy of an array with an index set to a particular value.
(def: (update! idx value array)
(All [a] (-> Index a (Array a) (Array a)))
- (|> array array;clone (array;put idx value)))
+ (|> array array;clone (array;write idx value)))
## Creates a clone of the array, with an empty position at index.
(def: (vacant! idx array)
(All [a] (-> Index (Array a) (Array a)))
- (|> array array;clone (array;remove idx)))
+ (|> array array;clone (array;delete idx)))
## Shrinks a copy of the array by removing the space at index.
(def: (remove! idx array)
@@ -211,68 +211,68 @@
bitmap)))
## Produces the index of a KV-pair within a #Collisions node.
-(def: (collision-index Hash<K> key colls)
- (All [K V] (-> (Hash K) K (Collisions K V) (Maybe Index)))
+(def: (collision-index Hash<k> key colls)
+ (All [k v] (-> (Hash k) k (Collisions k v) (Maybe Index)))
(:: Monad<Maybe> map product;left
(array;find+ (function [idx [key' val']]
- (:: Hash<K> = key key'))
+ (:: Hash<k> = key key'))
colls)))
## When #Hierarchy nodes grow too small, they're demoted to #Base
## 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 (L/fold (function [idx [insertion-idx node]]
- (let [[bitmap base] node]
- (case (array;get idx h-array)
- #;None [insertion-idx node]
- (#;Some sub-node) (if (n.= except-idx idx)
- [insertion-idx node]
- [(n.inc insertion-idx)
- [(set-bit-position (->bit-position idx) bitmap)
- (array;put insertion-idx (#;Left sub-node) base)]])
- )))
- [+0 [clean-bitmap
- (: (Base ($ +0) ($ +1))
- (array;new (n.dec h-size)))]]
- (list;indices (array;size h-array)))))
+ (product;right (list/fold (function [idx [insertion-idx node]]
+ (let [[bitmap base] node]
+ (case (array;read idx h-array)
+ #;None [insertion-idx node]
+ (#;Some sub-node) (if (n.= except-idx idx)
+ [insertion-idx node]
+ [(n.inc insertion-idx)
+ [(set-bit-position (->bit-position idx) bitmap)
+ (array;write insertion-idx (#;Left sub-node) base)]])
+ )))
+ [+0 [clean-bitmap
+ (: (Base ($ +0) ($ +1))
+ (array;new (n.dec h-size)))]]
+ (list;indices (array;size h-array)))))
## When #Base nodes grow too large, they're promoted to #Hierarchy to
## add some depth to the tree and help keep it's balance.
(def: hierarchy-indices (List Index) (indices-for hierarchy-nodes-size))
-(def: (promote-base put' Hash<K> level bitmap base)
- (All [K V]
- (-> (-> Level Hash-Code K V (Hash K) (Node K V) (Node K V))
- (Hash K) Level
- BitMap (Base K V)
- (Array (Node K V))))
- (product;right (L/fold (function [hierarchy-idx (^@ default [base-idx h-array])]
- (if (bit-position-is-set? (->bit-position hierarchy-idx)
- bitmap)
- [(n.inc base-idx)
- (case (array;get base-idx base)
- (#;Some (#;Left sub-node))
- (array;put hierarchy-idx sub-node h-array)
-
- (#;Some (#;Right [key' val']))
- (array;put hierarchy-idx
- (put' (level-up level) (:: Hash<K> hash key') key' val' Hash<K> empty)
- h-array)
-
- #;None
- (undefined))]
- default))
- [+0
- (: (Array (Node ($ +0) ($ +1)))
- (array;new hierarchy-nodes-size))]
- hierarchy-indices)))
+(def: (promote-base put' Hash<k> level bitmap base)
+ (All [k v]
+ (-> (-> Level Hash-Code k v (Hash k) (Node k v) (Node k v))
+ (Hash k) Level
+ BitMap (Base k v)
+ (Array (Node k v))))
+ (product;right (list/fold (function [hierarchy-idx (^@ default [base-idx h-array])]
+ (if (bit-position-is-set? (->bit-position hierarchy-idx)
+ bitmap)
+ [(n.inc base-idx)
+ (case (array;read base-idx base)
+ (#;Some (#;Left sub-node))
+ (array;write hierarchy-idx sub-node h-array)
+
+ (#;Some (#;Right [key' val']))
+ (array;write hierarchy-idx
+ (put' (level-up level) (:: Hash<k> hash key') key' val' Hash<k> empty)
+ h-array)
+
+ #;None
+ (undefined))]
+ default))
+ [+0
+ (: (Array (Node ($ +0) ($ +1)))
+ (array;new hierarchy-nodes-size))]
+ hierarchy-indices)))
## All empty nodes look the same (a #Base node with clean bitmap is
## used).
## So, this test is introduced to detect them.
(def: (empty?' node)
- (All [K V] (-> (Node K V) Bool))
+ (All [k v] (-> (Node k v) Bool))
(case node
(^~ (#Base ;;clean-bitmap _))
true
@@ -280,22 +280,22 @@
_
false))
-(def: (put' level hash key val Hash<K> node)
- (All [K V] (-> Level Hash-Code K V (Hash K) (Node K V) (Node K V)))
+(def: (put' level hash key val Hash<k> node)
+ (All [k v] (-> Level Hash-Code k v (Hash k) (Node k v) (Node k v)))
(case node
## For #Hierarchy nodes, I check whether I can add the element to
## a sub-node. If impossible, I introduced a new singleton sub-node.
(#Hierarchy _size hierarchy)
(let [idx (level-index level hash)
[_size' sub-node] (: [Nat (Node ($ +0) ($ +1))]
- (case (array;get idx hierarchy)
+ (case (array;read idx hierarchy)
(#;Some sub-node)
[_size sub-node]
_
[(n.inc _size) empty]))]
(#Hierarchy _size'
- (update! idx (put' (level-up level) hash key val Hash<K> sub-node)
+ (update! idx (put' (level-up level) hash key val Hash<k> sub-node)
hierarchy)))
## For #Base nodes, I check if the corresponding BitPosition has
@@ -305,23 +305,23 @@
(if (bit-position-is-set? bit bitmap)
## If so...
(let [idx (base-index bit bitmap)]
- (case (array;get idx base)
+ (case (array;read idx base)
#;None
(undefined)
## If it's being used by a node, I add the KV to it.
(#;Some (#;Left sub-node))
- (let [sub-node' (put' (level-up level) hash key val Hash<K> sub-node)]
+ (let [sub-node' (put' (level-up level) hash key val Hash<k> sub-node)]
(#Base bitmap (update! idx (#;Left sub-node') base)))
## Otherwise, if it's being used by a KV, I compare the keys.
(#;Some (#;Right key' val'))
- (if (:: Hash<K> = key key')
+ (if (:: Hash<k> = key key')
## If the same key is found, I replace the value.
(#Base bitmap (update! idx (#;Right key val) base))
## Otherwise, I compare the hashes of the keys.
(#Base bitmap (update! idx
- (#;Left (let [hash' (:: Hash<K> hash key')]
+ (#;Left (let [hash' (:: Hash<k> hash key')]
(if (n.= hash hash')
## If the hashes are
## the same, a new
@@ -329,17 +329,17 @@
## is added.
(#Collisions hash (|> (: (Array [($ +0) ($ +1)])
(array;new +2))
- (array;put +0 [key' val'])
- (array;put +1 [key val])))
+ (array;write +0 [key' val'])
+ (array;write +1 [key val])))
## Otherwise, I can
## just keep using
## #Base nodes, so I
- ## add both KV pairs
+ ## add both KV-pairs
## to the empty one.
(let [next-level (level-up level)]
(|> empty
- (put' next-level hash' key' val' Hash<K>)
- (put' next-level hash key val Hash<K>))))))
+ (put' next-level hash' key' val' Hash<k>)
+ (put' next-level hash key val Hash<k>))))))
base)))))
## However, if the BitPosition has not been used yet, I check
## whether this #Base node is ready for a promotion.
@@ -348,9 +348,9 @@
## If so, I promote it to a #Hierarchy node, and add the new
## KV-pair as a singleton node to it.
(#Hierarchy (n.inc base-count)
- (|> (promote-base put' Hash<K> level bitmap base)
- (array;put (level-index level hash)
- (put' (level-up level) hash key val Hash<K> empty))))
+ (|> (promote-base put' Hash<k> level bitmap base)
+ (array;write (level-index level hash)
+ (put' (level-up level) hash key val Hash<k> empty))))
## Otherwise, I just resize the #Base node to accommodate the
## new KV-pair.
(#Base (set-bit-position bit bitmap)
@@ -361,7 +361,7 @@
(if (n.= hash _hash)
## If they're equal, that means the new KV contributes to the
## collisions.
- (case (collision-index Hash<K> key _colls)
+ (case (collision-index Hash<k> key _colls)
## If the key was already present in the collisions-list, it's
## value gets updated.
(#;Some coll-idx)
@@ -375,25 +375,25 @@
(|> (#Base (bit-position level _hash)
(|> (: (Base ($ +0) ($ +1))
(array;new +1))
- (array;put +0 (#;Left node))))
- (put' level hash key val Hash<K>)))
+ (array;write +0 (#;Left node))))
+ (put' level hash key val Hash<k>)))
))
-(def: (remove' level hash key Hash<K> node)
- (All [K V] (-> Level Hash-Code K (Hash K) (Node K V) (Node K V)))
+(def: (remove' level hash key Hash<k> node)
+ (All [k v] (-> Level Hash-Code k (Hash k) (Node k v) (Node k v)))
(case node
## For #Hierarchy nodes, find out if there's a valid sub-node for
## the Hash-Code.
(#Hierarchy h-size h-array)
(let [idx (level-index level hash)]
- (case (array;get idx h-array)
+ (case (array;read idx h-array)
## If not, there's nothing to remove.
#;None
node
## But if there is, try to remove the key from the sub-node.
(#;Some sub-node)
- (let [sub-node' (remove' (level-up level) hash key Hash<K> sub-node)]
+ (let [sub-node' (remove' (level-up level) hash key Hash<k> sub-node)]
## Then check if a removal was actually done.
(if (is sub-node sub-node')
## If not, then there's nothing to change here either.
@@ -415,14 +415,14 @@
(let [bit (bit-position level hash)]
(if (bit-position-is-set? bit bitmap)
(let [idx (base-index bit bitmap)]
- (case (array;get idx base)
+ (case (array;read idx base)
#;None
(undefined)
## If set, check if it's a sub-node, and remove the KV
## from it.
(#;Some (#;Left sub-node))
- (let [sub-node' (remove' (level-up level) hash key Hash<K> sub-node)]
+ (let [sub-node' (remove' (level-up level) hash key Hash<k> sub-node)]
## Verify that it was removed.
(if (is sub-node sub-node')
## If not, there's also nothing to change here.
@@ -442,11 +442,11 @@
(#Base bitmap
(update! idx (#;Left sub-node') base)))))
- ## If, however, there was a KV pair instead of a sub-node.
+ ## If, however, there was a KV-pair instead of a sub-node.
(#;Some (#;Right [key' val']))
## Check if the keys match.
- (if (:: Hash<K> = key key')
- ## If so, remove the KV pair and unset the BitPosition.
+ (if (:: Hash<k> = key key')
+ ## If so, remove the KV-pair and unset the BitPosition.
(#Base (unset-bit-position bit bitmap)
(remove! idx base))
## Otherwise, there's nothing to remove.
@@ -456,7 +456,7 @@
## For #Collisions nodes, It need to find out if the key already existst.
(#Collisions _hash _colls)
- (case (collision-index Hash<K> key _colls)
+ (case (collision-index Hash<k> key _colls)
## If not, then there's nothing to remove.
#;None
node
@@ -467,32 +467,32 @@
## If there's only one left, then removing it leaves us with
## an empty node.
empty
- ## Otherwise, just shrink the array by removing the KV pair.
+ ## Otherwise, just shrink the array by removing the KV-pair.
(#Collisions _hash (remove! idx _colls))))
))
-(def: (get' level hash key Hash<K> node)
- (All [K V] (-> Level Hash-Code K (Hash K) (Node K V) (Maybe V)))
+(def: (get' level hash key Hash<k> node)
+ (All [k v] (-> Level Hash-Code k (Hash k) (Node k v) (Maybe v)))
(case node
## For #Hierarchy nodes, just look-up the key on its children.
(#Hierarchy _size hierarchy)
- (case (array;get (level-index level hash) hierarchy)
+ (case (array;read (level-index level hash) hierarchy)
#;None #;None
- (#;Some sub-node) (get' (level-up level) hash key Hash<K> sub-node))
+ (#;Some sub-node) (get' (level-up level) hash key Hash<k> sub-node))
## For #Base nodes, check the leaves, and recursively check the branches.
(#Base bitmap base)
(let [bit (bit-position level hash)]
(if (bit-position-is-set? bit bitmap)
- (case (array;get (base-index bit bitmap) base)
+ (case (array;read (base-index bit bitmap) base)
#;None
(undefined)
(#;Some (#;Left sub-node))
- (get' (level-up level) hash key Hash<K> sub-node)
+ (get' (level-up level) hash key Hash<k> sub-node)
(#;Some (#;Right [key' val']))
- (if (:: Hash<K> = key key')
+ (if (:: Hash<k> = key key')
(#;Some val')
#;None))
#;None))
@@ -500,18 +500,18 @@
## For #Collisions nodes, do a linear scan of all the known KV-pairs.
(#Collisions _hash _colls)
(:: Monad<Maybe> map product;right
- (array;find (|>. product;left (:: Hash<K> = key))
+ (array;find (|>. product;left (:: Hash<k> = key))
_colls))
))
(def: (size' node)
- (All [K V] (-> (Node K V) Nat))
+ (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))
@@ -522,18 +522,18 @@
))
(def: (entries' node)
- (All [K V] (-> (Node K V) (List [K V])))
+ (All [k v] (-> (Node k v) (List [k v])))
(case node
(#Hierarchy _size hierarchy)
- (Array/fold (function [sub-node tail] (L/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)
- (L/compose (entries' sub-node) tail)
+ (list/compose (entries' sub-node) tail)
(#;Right [key' val'])
(#;Cons [key' val'] tail)))
@@ -541,7 +541,7 @@
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)))
@@ -551,42 +551,42 @@
{#hash (Hash k)
#root (Node k v)})
-(def: #export (new Hash<K>)
- (All [K V] (-> (Hash K) (Dict K V)))
- {#hash Hash<K>
+(def: #export (new Hash<k>)
+ (All [k v] (-> (Hash k) (Dict k v)))
+ {#hash Hash<k>
#root empty})
(def: #export (put key val dict)
- (All [K V] (-> K V (Dict K V) (Dict K V)))
- (let [[Hash<K> node] dict]
- [Hash<K> (put' root-level (:: Hash<K> hash key) key val Hash<K> node)]))
+ (All [k v] (-> k v (Dict k v) (Dict k v)))
+ (let [[Hash<k> node] dict]
+ [Hash<k> (put' root-level (:: Hash<k> hash key) key val Hash<k> node)]))
(def: #export (remove key dict)
- (All [K V] (-> K (Dict K V) (Dict K V)))
- (let [[Hash<K> node] dict]
- [Hash<K> (remove' root-level (:: Hash<K> hash key) key Hash<K> node)]))
+ (All [k v] (-> k (Dict k v) (Dict k v)))
+ (let [[Hash<k> node] dict]
+ [Hash<k> (remove' root-level (:: Hash<k> hash key) key Hash<k> node)]))
(def: #export (get key dict)
- (All [K V] (-> K (Dict K V) (Maybe V)))
- (let [[Hash<K> node] dict]
- (get' root-level (:: Hash<K> hash key) key Hash<K> node)))
+ (All [k v] (-> k (Dict k v) (Maybe v)))
+ (let [[Hash<k> node] dict]
+ (get' root-level (:: Hash<k> hash key) key Hash<k> node)))
(def: #export (contains? key dict)
- (All [K V] (-> K (Dict K V) Bool))
+ (All [k v] (-> k (Dict k v) Bool))
(case (get key dict)
#;None false
(#;Some _) true))
(def: #export (put~ key val dict)
{#;doc "Only puts the KV-pair if the key is not already present."}
- (All [K V] (-> K V (Dict K V) (Dict K V)))
+ (All [k v] (-> k v (Dict k v) (Dict k v)))
(if (contains? key dict)
dict
(put key val dict)))
(def: #export (update key f dict)
{#;doc "Transforms the value located at key (if available), using the given function."}
- (All [K V] (-> K (-> V V) (Dict K V) (Dict K V)))
+ (All [k v] (-> k (-> v v) (Dict k v) (Dict k v)))
(case (get key dict)
#;None
dict
@@ -595,59 +595,59 @@
(put key (f val) dict)))
(def: #export size
- (All [K V] (-> (Dict K V) Nat))
+ (All [k v] (-> (Dict k v) Nat))
(|>. product;right size'))
(def: #export empty?
- (All [K V] (-> (Dict K V) Bool))
+ (All [k v] (-> (Dict k v) Bool))
(|>. size (n.= +0)))
(def: #export (entries dict)
- (All [K V] (-> (Dict K V) (List [K V])))
+ (All [k v] (-> (Dict k v) (List [k v])))
(entries' (product;right dict)))
-(def: #export (from-list Hash<K> kvs)
- (All [K V] (-> (Hash K) (List [K V]) (Dict K V)))
- (L/fold (function [[k v] dict]
- (put k v dict))
- (new Hash<K>)
- kvs))
+(def: #export (from-list Hash<k> kvs)
+ (All [k v] (-> (Hash k) (List [k v]) (Dict k v)))
+ (list/fold (function [[k v] dict]
+ (put k v dict))
+ (new Hash<k>)
+ kvs))
(do-template [<name> <elem-type> <side>]
[(def: #export (<name> dict)
- (All [K V] (-> (Dict K V) (List <elem-type>)))
- (|> dict entries (L/map <side>)))]
+ (All [k v] (-> (Dict k v) (List <elem-type>)))
+ (|> dict entries (list/map <side>)))]
- [keys K product;left]
- [values V product;right]
+ [keys k product;left]
+ [values v product;right]
)
(def: #export (merge dict2 dict1)
{#;doc "Merges 2 dictionaries.
If any collisions with keys occur, the values of dict2 will overwrite those of dict1."}
- (All [K V] (-> (Dict K V) (Dict K V) (Dict K V)))
- (L/fold (function [[key val] dict] (put key val dict))
- dict1
- (entries dict2)))
+ (All [k v] (-> (Dict k v) (Dict k v) (Dict k v)))
+ (list/fold (function [[key val] dict] (put key val dict))
+ dict1
+ (entries dict2)))
(def: #export (merge-with f dict2 dict1)
{#;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) (Dict K V) (Dict K V) (Dict K V)))
- (L/fold (function [[key val2] dict]
- (case (get key dict)
- #;None
- (put key val2 dict)
+ (All [k v] (-> (-> v v v) (Dict k v) (Dict k v) (Dict k v)))
+ (list/fold (function [[key val2] dict]
+ (case (get key dict)
+ #;None
+ (put key val2 dict)
- (#;Some val1)
- (put key (f val2 val1) dict)))
- dict1
- (entries dict2)))
+ (#;Some val1)
+ (put key (f val2 val1) dict)))
+ dict1
+ (entries dict2)))
(def: #export (re-bind from-key to-key dict)
- (All [K V] (-> K K (Dict K V) (Dict K V)))
+ (All [k v] (-> k k (Dict k v) (Dict k v)))
(case (get from-key dict)
#;None
dict
@@ -659,14 +659,14 @@
(def: #export (select keys dict)
{#;doc "Creates a sub-set of the given dict, with only the specified keys."}
- (All [K V] (-> (List K) (Dict K V) (Dict K V)))
- (let [[Hash<K> _] dict]
- (L/fold (function [key new-dict]
- (case (get key dict)
- #;None new-dict
- (#;Some val) (put key val new-dict)))
- (new Hash<K>)
- keys)))
+ (All [k v] (-> (List k) (Dict k v) (Dict k v)))
+ (let [[Hash<k> _] 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]
(struct: #export (Eq<Dict> Eq<v>) (All [k v] (-> (Eq v) (Eq (Dict k v))))
diff --git a/stdlib/source/lux/data/coll/vector.lux b/stdlib/source/lux/data/coll/vector.lux
index ebdd6235c..956850a87 100644
--- a/stdlib/source/lux/data/coll/vector.lux
+++ b/stdlib/source/lux/data/coll/vector.lux
@@ -1,17 +1,16 @@
(;module:
lux
- (lux (control ["F" functor]
- ["A" applicative]
- ["M" monad #+ do Monad]
+ (lux (control [functor #+ Functor]
+ [applicative #+ Applicative]
+ [monad #+ do Monad]
[eq #+ Eq]
monoid
fold
["p" parser])
(data [maybe]
- (coll [list "List/" Fold<List> Functor<List> Monoid<List>]
- [array #+ Array "Array/" Functor<Array> Fold<Array>])
+ (coll [list "list/" Fold<List> Functor<List> Monoid<List>]
+ [array "array/" Functor<Array> Fold<Array>])
[bit]
- [number "Int/" Number<Int>]
[product])
[macro #+ with-gensyms]
(macro [code]
@@ -80,14 +79,14 @@
(#Base tail)
(|> (: (Hierarchy ($ +0))
(new-hierarchy []))
- (array;put +0 (new-path (level-down level) tail))
+ (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;put +0 singleton)))
+ (array;write +0 singleton)))
(def: (push-tail size level tail parent)
(All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a)))
@@ -97,7 +96,7 @@
## Just add the tail to it
(#Base tail)
## Otherwise, check whether there's a vacant spot
- (case (array;get sub-idx parent)
+ (case (array;read sub-idx parent)
## If so, set the path to the tail
#;None
(new-path (level-down level) tail)
@@ -109,7 +108,7 @@
(undefined))
)]
(|> (array;clone parent)
- (array;put sub-idx sub-node))))
+ (array;write sub-idx sub-node))))
(def: (expand-tail val tail)
(All [a] (-> a (Base a) (Base a)))
@@ -117,23 +116,23 @@
(|> (: (Base ($ +0))
(array;new (n.inc tail-size)))
(array;copy tail-size +0 tail +0)
- (array;put tail-size val)
+ (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;get sub-idx hierarchy)
+ (case (array;read sub-idx hierarchy)
(#;Some (#Hierarchy sub-node))
(|> (array;clone hierarchy)
- (array;put sub-idx (#Hierarchy (put' (level-down level) idx val sub-node))))
+ (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;put sub-idx (|> (array;clone base)
- (array;put (branch-idx idx) val)
- #Base)))
+ (array;write sub-idx (|> (array;clone base)
+ (array;write (branch-idx idx) val)
+ #Base)))
_
(undefined))))
@@ -146,7 +145,7 @@
(n.> branching-exponent level)
(do maybe;Monad<Maybe>
- [base|hierarchy (array;get sub-idx hierarchy)
+ [base|hierarchy (array;read sub-idx hierarchy)
sub (case base|hierarchy
(#Hierarchy sub)
(pop-tail size (level-down level) sub)
@@ -154,12 +153,12 @@
(#Base _)
(undefined))]
(|> (array;clone hierarchy)
- (array;put sub-idx (#Hierarchy sub))
+ (array;write sub-idx (#Hierarchy sub))
#;Some))
## Else...
(|> (array;clone hierarchy)
- (array;remove sub-idx)
+ (array;delete sub-idx)
#;Some)
)))
@@ -173,7 +172,7 @@
(|> hierarchy
array;to-list
list;reverse
- (List/fold (function [sub acc] (List/compose (to-list' sub) acc))
+ (list/fold (function [sub acc] (list/compose (to-list' sub) acc))
#;Nil))))
## [Types]
@@ -214,8 +213,8 @@
(|> vec
(set@ #root (|> (: (Hierarchy ($ +0))
(new-hierarchy []))
- (array;put +0 (#Hierarchy (get@ #root vec)))
- (array;put +1 (new-path (get@ #level vec) (get@ #tail vec)))))
+ (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
@@ -236,7 +235,7 @@
(loop [level (get@ #level vec)
hierarchy (get@ #root vec)]
(case [(n.> branching-exponent level)
- (array;get (branch-idx (bit;shift-right level idx)) hierarchy)]
+ (array;read (branch-idx (bit;shift-right level idx)) hierarchy)]
[true (#;Some (#Hierarchy sub))]
(recur (level-down level) sub)
@@ -254,7 +253,7 @@
(All [a] (-> Nat (Vector a) (Maybe a)))
(do maybe;Monad<Maybe>
[base (base-for idx vec)]
- (array;get (branch-idx idx) base)))
+ (array;read (branch-idx idx) base)))
(def: #export (put idx val vec)
(All [a] (-> Nat a (Vector a) (Vector a)))
@@ -264,7 +263,7 @@
(if (n.>= (tail-off vec-size) idx)
(|> vec
(update@ #tail (: (-> (Base ($ +0)) (Base ($ +0)))
- (|>. array;clone (array;put (branch-idx idx) val)))))
+ (|>. array;clone (array;write (branch-idx idx) val)))))
(|> vec
(update@ #root (put' (get@ #level vec) idx val))))
vec)))
@@ -305,7 +304,7 @@
(maybe;default (new-hierarchy [])
(pop-tail vec-size init-level (get@ #root vec))))]
(if (n.> branching-exponent level)
- (case [(array;get +1 root) (array;get +0 root)]
+ (case [(array;read +1 root) (array;read +0 root)]
[#;None (#;Some (#Hierarchy sub-node))]
(recur (level-down level) sub-node)
@@ -324,12 +323,12 @@
(def: #export (to-list vec)
(All [a] (-> (Vector a) (List a)))
- (List/compose (to-list' (#Hierarchy (get@ #root vec)))
+ (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
+ (list/fold add
(: (Vector ($ +0))
empty)
list))
@@ -372,10 +371,10 @@
(def: (fold f init xs)
(case xs
(#Base base)
- (Array/fold f init base)
+ (array/fold f init base)
(#Hierarchy hierarchy)
- (Array/fold (function [node init'] (fold f init' node))
+ (array/fold (function [node init'] (fold f init' node))
init
hierarchy))
))
@@ -394,27 +393,27 @@
(Monoid (Vector a)))
(def: identity empty)
(def: (compose xs ys)
- (List/fold add xs (to-list ys))))
+ (list/fold add xs (to-list ys))))
-(struct: _ (F;Functor Node)
+(struct: _ (Functor Node)
(def: (map f xs)
(case xs
(#Base base)
- (#Base (Array/map f base))
+ (#Base (array/map f base))
(#Hierarchy hierarchy)
- (#Hierarchy (Array/map (map f) hierarchy)))
+ (#Hierarchy (array/map (map f) hierarchy)))
))
-(struct: #export _ (F;Functor Vector)
+(struct: #export _ (Functor Vector)
(def: (map f xs)
{#level (get@ #level xs)
#size (get@ #size xs)
- #root (|> xs (get@ #root) (Array/map (:: Functor<Node> map f)))
- #tail (|> xs (get@ #tail) (Array/map f))
+ #root (|> xs (get@ #root) (array/map (:: Functor<Node> map f)))
+ #tail (|> xs (get@ #tail) (array/map f))
}))
-(struct: #export _ (A;Applicative Vector)
+(struct: #export _ (Applicative Vector)
(def: functor Functor<Vector>)
(def: (wrap x)
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 1f787b8e4..867cec189 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -1,7 +1,7 @@
(;module: {#;doc "Functionality for reading and writing values in the JSON format.
For more information, please see: http://www.json.org/"}
- lux
+ [lux #- Array]
(lux (control [monad #+ do Monad]
[eq #+ Eq]
codec
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 332ce6562..4f0c2b9d9 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -595,7 +595,7 @@
## write the encoding/decoding algorithm once, in pure Lux, rather
## than having to implement it on the compiler for every platform
## targeted by Lux.
-(type: Digits (#;Host "#Array" (#;Cons Nat #;Nil)))
+(type: Digits (Array Nat))
(def: (make-digits _)
(-> Top Digits)
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index 28ea5a24e..be8a4bf7b 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1,17 +1,16 @@
(;module:
[lux #- type]
- (lux (control ["M" monad #+ do Monad]
+ (lux (control [monad #+ do Monad]
[enum]
["p" parser])
[io #+ IO Monad<IO> io]
- (data (coll [list "L/" Monad<List> Fold<List> Monoid<List>]
- [array #+ Array])
+ (data (coll [list "list/" Monad<List> Fold<List> Monoid<List>])
number
[maybe]
[product]
- [text "Text/" Eq<Text> Monoid<Text>]
+ [text "text/" Eq<Text> Monoid<Text>]
text/format
- [bool "Bool/" Codec<Text,Bool>])
+ [bool "bool/" Codec<Text,Bool>])
[macro #+ with-gensyms Functor<Lux> Monad<Lux>]
(macro [code]
["s" syntax #+ syntax: Syntax])
@@ -284,7 +283,7 @@
output
[[name params] _ _]
- (let [=params (L/map (class->type' mode type-params in-array?) params)]
+ (let [=params (list/map (class->type' mode type-params in-array?) params)]
(` (host (~ (code;symbol ["" name])) [(~@ =params)])))))
(def: (class->type' mode type-params in-array? class)
@@ -292,7 +291,7 @@
(case class
(#GenericTypeVar name)
(case (list;find (function [[pname pbounds]]
- (and (Text/= name pname)
+ (and (text/= name pname)
(not (list;empty? pbounds))))
type-params)
#;None
@@ -307,7 +306,7 @@
(#GenericArray param)
(let [=param (class->type' mode type-params true param)]
- (` (host (~ (code;symbol ["" array-type-name])) [(~ =param)])))
+ (` (;Array (~ =param))))
(^or (#GenericWildcard #;None) (#GenericWildcard (#;Some [#LowerBound _])))
(' (;Ex [*] *))
@@ -326,15 +325,15 @@
(def: (class-decl-type$ (^slots [#class-name #class-params]))
(-> ClassDecl Code)
- (let [=params (L/map (: (-> TypeParam Code)
- (function [[pname pbounds]]
- (case pbounds
- #;Nil
- (code;symbol ["" pname])
-
- (#;Cons bound1 _)
- (class->type #ManualPrM class-params bound1))))
- class-params)]
+ (let [=params (list/map (: (-> TypeParam Code)
+ (function [[pname pbounds]]
+ (case pbounds
+ #;Nil
+ (code;symbol ["" pname])
+
+ (#;Cons bound1 _)
+ (class->type #ManualPrM class-params bound1))))
+ class-params)]
(` (host (~ (code;symbol ["" class-name])) [(~@ =params)]))))
(def: empty-imports
@@ -344,7 +343,7 @@
(def: (get-import name imports)
(-> Text ClassImports (Maybe Text))
(:: maybe;Functor<Maybe> map product;right
- (list;find (|>. product;left (Text/= name))
+ (list;find (|>. product;left (text/= name))
imports)))
(def: (add-import short+full imports)
@@ -358,16 +357,16 @@
(do Monad<Lux>
[current-module macro;current-module-name
defs (macro;defs current-module)]
- (wrap (L/fold (: (-> [Text Def] ClassImports ClassImports)
- (function [[short-name [_ meta _]] imports]
- (case (macro;get-text-ann (ident-for #;;jvm-class) meta)
- (#;Some full-class-name)
- (add-import [short-name full-class-name] imports)
-
- _
- imports)))
- empty-imports
- defs)))))
+ (wrap (list/fold (: (-> [Text Def] ClassImports ClassImports)
+ (function [[short-name [_ meta _]] imports]
+ (case (macro;get-text-ann (ident-for #;;jvm-class) meta)
+ (#;Some full-class-name)
+ (add-import [short-name full-class-name] imports)
+
+ _
+ imports)))
+ empty-imports
+ defs)))))
(#;Left _) (list)
(#;Right imports) imports))
@@ -476,7 +475,7 @@
(case class
(#GenericTypeVar name)
(case (list;find (function [[pname pbounds]]
- (and (Text/= name pname)
+ (and (text/= name pname)
(not (list;empty? pbounds))))
params)
#;None
@@ -542,15 +541,15 @@
(case (f input)
(^template [<tag>]
[meta (<tag> parts)]
- [meta (<tag> (L/map (pre-walk-replace f) parts))])
+ [meta (<tag> (list/map (pre-walk-replace f) parts))])
([#;Form]
[#;Tuple])
[meta (#;Record pairs)]
- [meta (#;Record (L/map (: (-> [Code Code] [Code Code])
- (function [[key val]]
- [(pre-walk-replace f key) (pre-walk-replace f val)]))
- pairs))]
+ [meta (#;Record (list/map (: (-> [Code Code] [Code Code])
+ (function [[key val]]
+ [(pre-walk-replace f key) (pre-walk-replace f val)]))
+ pairs))]
ast'
ast'))
@@ -580,7 +579,7 @@
(do p;Monad<Parser>
[[_ args] (: (Syntax [Unit (List Code)])
(s;form ($_ p;seq (s;this (' .new!)) (s;tuple (p;exactly (list;size arg-decls) s;any)))))
- #let [arg-decls' (: (List Text) (L/map (. (simple-class$ params) product;right) arg-decls))]]
+ #let [arg-decls' (: (List Text) (list/map (. (simple-class$ params) product;right) arg-decls))]]
(wrap (` (;_lux_proc ["jvm" (~ (code;text (format "new" ":" class-name ":" (text;join-with "," arg-decls'))))]
[(~@ args)])))))
@@ -590,7 +589,7 @@
[#let [dotted-name (format "." method-name "!")]
[_ args] (: (Syntax [Unit (List Code)])
(s;form ($_ p;seq (s;this (code;symbol ["" dotted-name])) (s;tuple (p;exactly (list;size arg-decls) s;any)))))
- #let [arg-decls' (: (List Text) (L/map (. (simple-class$ params) product;right) arg-decls))]]
+ #let [arg-decls' (: (List Text) (list/map (. (simple-class$ params) product;right) arg-decls))]]
(wrap (`' (;_lux_proc ["jvm" (~ (code;text (format "invokestatic" ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))]
[(~@ args)])))))
@@ -601,7 +600,7 @@
[#let [dotted-name (format "." method-name "!")]
[_ args] (: (Syntax [Unit (List Code)])
(s;form ($_ p;seq (s;this (code;symbol ["" dotted-name])) (s;tuple (p;exactly (list;size arg-decls) s;any)))))
- #let [arg-decls' (: (List Text) (L/map (. (simple-class$ params) product;right) arg-decls))]]
+ #let [arg-decls' (: (List Text) (list/map (. (simple-class$ params) product;right) arg-decls))]]
(wrap (`' (;_lux_proc ["jvm" (~ (code;text (format <jvm-op> ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))]
[(~' _jvm_this) (~@ args)])))))]
@@ -669,7 +668,7 @@
(wrap (#GenericWildcard (#;Some [bound-kind bound])))))
(do p;Monad<Parser>
[name (full-class-name^ imports)]
- (if (list;member? text;Eq<Text> (L/map product;left type-vars) name)
+ (if (list;member? text;Eq<Text> (list/map product;left type-vars) name)
(wrap (#GenericTypeVar name))
(wrap (#GenericClass name (list)))))
(s;form (do p;Monad<Parser>
@@ -694,7 +693,7 @@
[name (full-class-name^ imports)
params (p;some (generic-type^ imports type-vars))
_ (p;assert (format name " cannot be a type-parameter!")
- (not (list;member? text;Eq<Text> (L/map product;left type-vars) name)))]
+ (not (list;member? text;Eq<Text> (list/map product;left type-vars) name)))]
(wrap (#GenericClass name params))))
))
@@ -831,7 +830,7 @@
[pm privacy-modifier^
strict-fp? (s;this? (' #strict))
method-vars (p;default (list) (type-params^ imports))
- #let [total-vars (L/compose class-vars method-vars)]
+ #let [total-vars (list/compose class-vars method-vars)]
[_ arg-decls] (s;form (p;seq (s;this (' new))
(arg-decls^ imports total-vars)))
constructor-args (constructor-args^ imports total-vars)
@@ -850,7 +849,7 @@
strict-fp? (s;this? (' #strict))
final? (s;this? (' #final))
method-vars (p;default (list) (type-params^ imports))
- #let [total-vars (L/compose class-vars method-vars)]
+ #let [total-vars (list/compose class-vars method-vars)]
[name arg-decls] (s;form (p;seq s;local-symbol
(arg-decls^ imports total-vars)))
return-type (generic-type^ imports total-vars)
@@ -868,7 +867,7 @@
[strict-fp? (s;this? (' #strict))
owner-class (class-decl^ imports)
method-vars (p;default (list) (type-params^ imports))
- #let [total-vars (L/compose (product;right owner-class) method-vars)]
+ #let [total-vars (list/compose (product;right owner-class) method-vars)]
[name arg-decls] (s;form (p;seq s;local-symbol
(arg-decls^ imports total-vars)))
return-type (generic-type^ imports total-vars)
@@ -987,7 +986,7 @@
[tvars (p;default (list) (type-params^ imports))
_ (s;this (' new))
?alias import-member-alias^
- #let [total-vars (L/compose owner-vars tvars)]
+ #let [total-vars (list/compose owner-vars tvars)]
?prim-mode (p;opt primitive-mode^)
args (import-member-args^ imports total-vars)
[io? try? maybe?] import-member-return-flags^]
@@ -1008,7 +1007,7 @@
tvars (p;default (list) (type-params^ imports))
name s;local-symbol
?alias import-member-alias^
- #let [total-vars (L/compose owner-vars tvars)]
+ #let [total-vars (list/compose owner-vars tvars)]
?prim-mode (p;opt primitive-mode^)
args (import-member-args^ imports total-vars)
[io? try? maybe?] import-member-return-flags^
@@ -1073,7 +1072,7 @@
(def: (annotation$ [name params])
(-> Annotation JVM-Code)
- (format "(" name " " "{" (text;join-with "\t" (L/map annotation-param$ params)) "}" ")"))
+ (format "(" name " " "{" (text;join-with "\t" (list/map annotation-param$ params)) "}" ")"))
(def: (bound-kind$ kind)
(-> BoundKind JVM-Code)
@@ -1088,7 +1087,7 @@
name
(#GenericClass name params)
- (format "(" name " " (spaced (L/map generic-type$ params)) ")")
+ (format "(" name " " (spaced (list/map generic-type$ params)) ")")
(#GenericArray param)
(format "(" array-type-name " " (generic-type$ param) ")")
@@ -1101,25 +1100,25 @@
(def: (type-param$ [name bounds])
(-> TypeParam JVM-Code)
- (format "(" name " " (spaced (L/map generic-type$ bounds)) ")"))
+ (format "(" name " " (spaced (list/map generic-type$ bounds)) ")"))
(def: (class-decl$ (^open))
(-> ClassDecl JVM-Code)
- (format "(" class-name " " (spaced (L/map type-param$ class-params)) ")"))
+ (format "(" class-name " " (spaced (list/map type-param$ class-params)) ")"))
(def: (super-class-decl$ (^slots [#super-class-name #super-class-params]))
(-> SuperClassDecl JVM-Code)
- (format "(" super-class-name " " (spaced (L/map generic-type$ super-class-params)) ")"))
+ (format "(" super-class-name " " (spaced (list/map generic-type$ super-class-params)) ")"))
(def: (method-decl$ [[name pm anns] method-decl])
(-> [MemberDecl MethodDecl] JVM-Code)
(let [(^slots [#method-tvars #method-inputs #method-output #method-exs]) method-decl]
(with-parens
(spaced (list name
- (with-brackets (spaced (L/map annotation$ anns)))
- (with-brackets (spaced (L/map type-param$ method-tvars)))
- (with-brackets (spaced (L/map generic-type$ method-exs)))
- (with-brackets (spaced (L/map generic-type$ method-inputs)))
+ (with-brackets (spaced (list/map annotation$ anns)))
+ (with-brackets (spaced (list/map type-param$ method-tvars)))
+ (with-brackets (spaced (list/map generic-type$ method-exs)))
+ (with-brackets (spaced (list/map generic-type$ method-inputs)))
(generic-type$ method-output))
))))
@@ -1136,7 +1135,7 @@
(#ConstantField class value)
(with-parens
(spaced (list "constant" name
- (with-brackets (spaced (L/map annotation$ anns)))
+ (with-brackets (spaced (list/map annotation$ anns)))
(generic-type$ class)
(code;to-text value))
))
@@ -1146,7 +1145,7 @@
(spaced (list "variable" name
(privacy-modifier$ pm)
(state-modifier$ sm)
- (with-brackets (spaced (L/map annotation$ anns)))
+ (with-brackets (spaced (list/map annotation$ anns)))
(generic-type$ class))
))
))
@@ -1168,12 +1167,12 @@
(with-parens
(spaced (list "init"
(privacy-modifier$ pm)
- (Bool/encode strict-fp?)
- (with-brackets (spaced (L/map annotation$ anns)))
- (with-brackets (spaced (L/map type-param$ type-vars)))
- (with-brackets (spaced (L/map generic-type$ exs)))
- (with-brackets (spaced (L/map arg-decl$ arg-decls)))
- (with-brackets (spaced (L/map constructor-arg$ constructor-args)))
+ (bool/encode strict-fp?)
+ (with-brackets (spaced (list/map annotation$ anns)))
+ (with-brackets (spaced (list/map type-param$ type-vars)))
+ (with-brackets (spaced (list/map generic-type$ exs)))
+ (with-brackets (spaced (list/map arg-decl$ arg-decls)))
+ (with-brackets (spaced (list/map constructor-arg$ constructor-args)))
(code;to-text (pre-walk-replace replacer body))
)))
@@ -1182,12 +1181,12 @@
(spaced (list "virtual"
name
(privacy-modifier$ pm)
- (Bool/encode final?)
- (Bool/encode strict-fp?)
- (with-brackets (spaced (L/map annotation$ anns)))
- (with-brackets (spaced (L/map type-param$ type-vars)))
- (with-brackets (spaced (L/map generic-type$ exs)))
- (with-brackets (spaced (L/map arg-decl$ arg-decls)))
+ (bool/encode final?)
+ (bool/encode strict-fp?)
+ (with-brackets (spaced (list/map annotation$ anns)))
+ (with-brackets (spaced (list/map type-param$ type-vars)))
+ (with-brackets (spaced (list/map generic-type$ exs)))
+ (with-brackets (spaced (list/map arg-decl$ arg-decls)))
(generic-type$ return-type)
(code;to-text (pre-walk-replace replacer body)))))
@@ -1195,19 +1194,19 @@
(let [super-replacer (parser->replacer (s;form (do p;Monad<Parser>
[_ (s;this (' .super!))
args (s;tuple (p;exactly (list;size arg-decls) s;any))
- #let [arg-decls' (: (List Text) (L/map (. (simple-class$ (list)) product;right)
- arg-decls))]]
+ #let [arg-decls' (: (List Text) (list/map (. (simple-class$ (list)) product;right)
+ arg-decls))]]
(wrap (`' (;_lux_proc ["jvm" (~ (code;text (format "invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text;join-with "," arg-decls'))))]
[(~' _jvm_this) (~@ args)]))))))]
(with-parens
(spaced (list "override"
(class-decl$ class-decl)
name
- (Bool/encode strict-fp?)
- (with-brackets (spaced (L/map annotation$ anns)))
- (with-brackets (spaced (L/map type-param$ type-vars)))
- (with-brackets (spaced (L/map generic-type$ exs)))
- (with-brackets (spaced (L/map arg-decl$ arg-decls)))
+ (bool/encode strict-fp?)
+ (with-brackets (spaced (list/map annotation$ anns)))
+ (with-brackets (spaced (list/map type-param$ type-vars)))
+ (with-brackets (spaced (list/map generic-type$ exs)))
+ (with-brackets (spaced (list/map arg-decl$ arg-decls)))
(generic-type$ return-type)
(|> body
(pre-walk-replace replacer)
@@ -1220,11 +1219,11 @@
(spaced (list "static"
name
(privacy-modifier$ pm)
- (Bool/encode strict-fp?)
- (with-brackets (spaced (L/map annotation$ anns)))
- (with-brackets (spaced (L/map type-param$ type-vars)))
- (with-brackets (spaced (L/map generic-type$ exs)))
- (with-brackets (spaced (L/map arg-decl$ arg-decls)))
+ (bool/encode strict-fp?)
+ (with-brackets (spaced (list/map annotation$ anns)))
+ (with-brackets (spaced (list/map type-param$ type-vars)))
+ (with-brackets (spaced (list/map generic-type$ exs)))
+ (with-brackets (spaced (list/map arg-decl$ arg-decls)))
(generic-type$ return-type)
(code;to-text (pre-walk-replace replacer body)))))
@@ -1233,10 +1232,10 @@
(spaced (list "abstract"
name
(privacy-modifier$ pm)
- (with-brackets (spaced (L/map annotation$ anns)))
- (with-brackets (spaced (L/map type-param$ type-vars)))
- (with-brackets (spaced (L/map generic-type$ exs)))
- (with-brackets (spaced (L/map arg-decl$ arg-decls)))
+ (with-brackets (spaced (list/map annotation$ anns)))
+ (with-brackets (spaced (list/map type-param$ type-vars)))
+ (with-brackets (spaced (list/map generic-type$ exs)))
+ (with-brackets (spaced (list/map arg-decl$ arg-decls)))
(generic-type$ return-type))))
(#NativeMethod type-vars arg-decls return-type exs)
@@ -1244,10 +1243,10 @@
(spaced (list "native"
name
(privacy-modifier$ pm)
- (with-brackets (spaced (L/map annotation$ anns)))
- (with-brackets (spaced (L/map type-param$ type-vars)))
- (with-brackets (spaced (L/map generic-type$ exs)))
- (with-brackets (spaced (L/map arg-decl$ arg-decls)))
+ (with-brackets (spaced (list/map annotation$ anns)))
+ (with-brackets (spaced (list/map type-param$ type-vars)))
+ (with-brackets (spaced (list/map generic-type$ exs)))
+ (with-brackets (spaced (list/map arg-decl$ arg-decls)))
(generic-type$ return-type))))
))
@@ -1308,19 +1307,19 @@
(do Monad<Lux>
[current-module macro;current-module-name
#let [fully-qualified-class-name (format (text;replace-all "/" "." current-module) "." full-class-name)
- field-parsers (L/map (field->parser fully-qualified-class-name) fields)
- method-parsers (L/map (method->parser (product;right class-decl) fully-qualified-class-name) methods)
- replacer (parser->replacer (L/fold p;either
- (p;fail "")
- (L/compose field-parsers method-parsers)))
+ field-parsers (list/map (field->parser fully-qualified-class-name) fields)
+ method-parsers (list/map (method->parser (product;right class-decl) fully-qualified-class-name) methods)
+ replacer (parser->replacer (list/fold p;either
+ (p;fail "")
+ (list/compose field-parsers method-parsers)))
def-code (format "class:"
(spaced (list (class-decl$ class-decl)
(super-class-decl$ super)
- (with-brackets (spaced (L/map super-class-decl$ interfaces)))
+ (with-brackets (spaced (list/map super-class-decl$ interfaces)))
(inheritance-modifier$ im)
- (with-brackets (spaced (L/map annotation$ annotations)))
- (with-brackets (spaced (L/map field-decl$ fields)))
- (with-brackets (spaced (L/map (method-def$ replacer super) methods))))))]]
+ (with-brackets (spaced (list/map annotation$ annotations)))
+ (with-brackets (spaced (list/map field-decl$ fields)))
+ (with-brackets (spaced (list/map (method-def$ replacer super) methods))))))]]
(wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] []))))))
(syntax: #export (interface: [#let [imports (class-imports *compiler*)]]
@@ -1338,9 +1337,9 @@
([] foo [boolean String] void #throws [Exception])))}
(let [def-code (format "interface:"
(spaced (list (class-decl$ class-decl)
- (with-brackets (spaced (L/map super-class-decl$ supers)))
- (with-brackets (spaced (L/map annotation$ annotations)))
- (spaced (L/map method-decl$ members)))))]
+ (with-brackets (spaced (list/map super-class-decl$ supers)))
+ (with-brackets (spaced (list/map annotation$ annotations)))
+ (spaced (list/map method-decl$ members)))))]
(wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] []))))
))
@@ -1364,9 +1363,9 @@
)}
(let [def-code (format "anon-class:"
(spaced (list (super-class-decl$ super)
- (with-brackets (spaced (L/map super-class-decl$ interfaces)))
- (with-brackets (spaced (L/map constructor-arg$ constructor-args)))
- (with-brackets (spaced (L/map (method-def$ id super) methods))))))]
+ (with-brackets (spaced (list/map super-class-decl$ interfaces)))
+ (with-brackets (spaced (list/map constructor-arg$ constructor-args)))
+ (with-brackets (spaced (list/map (method-def$ id super) methods))))))]
(wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] []))))))
(syntax: #export (null)
@@ -1457,7 +1456,7 @@
(ClassName.method2 [arg3 arg4 arg5])))}
(with-gensyms [g!obj]
(wrap (list (` (let [(~ g!obj) (~ obj)]
- (exec (~@ (L/map (complete-call$ g!obj) methods))
+ (exec (~@ (list/map (complete-call$ g!obj) methods))
(~ g!obj))))))))
(def: (class-import$ long-name? [full-name params])
@@ -1474,7 +1473,7 @@
(host (~ (code;symbol ["" full-name])))))
(#;Cons _)
- (let [params' (L/map (function [[p _]] (code;symbol ["" p])) params)]
+ (let [params' (list/map (function [[p _]] (code;symbol ["" p])) params)]
(` (def: (~ (code;symbol ["" def-name]))
{#;type? true
#;;jvm-class (~ (code;text full-name))}
@@ -1487,7 +1486,7 @@
(-> (List TypeParam) ImportMemberDecl (List TypeParam))
(case member
(#ConstructorDecl [commons _])
- (L/compose class-tvars (get@ #import-member-tvars commons))
+ (list/compose class-tvars (get@ #import-member-tvars commons))
(#MethodDecl [commons _])
(case (get@ #import-member-kind commons)
@@ -1495,7 +1494,7 @@
(get@ #import-member-tvars commons)
_
- (L/compose class-tvars (get@ #import-member-tvars commons)))
+ (list/compose class-tvars (get@ #import-member-tvars commons)))
_
class-tvars))
@@ -1506,26 +1505,26 @@
(^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
(let [(^slots [#import-member-tvars #import-member-args]) commons]
(do Monad<Lux>
- [arg-inputs (M;map @
- (: (-> [Bool GenericType] (Lux [Code Code]))
- (function [[maybe? _]]
- (with-gensyms [arg-name]
- (wrap [arg-name (if maybe?
- (` (!!! (~ arg-name)))
- arg-name)]))))
- import-member-args)
+ [arg-inputs (monad;map @
+ (: (-> [Bool GenericType] (Lux [Code Code]))
+ (function [[maybe? _]]
+ (with-gensyms [arg-name]
+ (wrap [arg-name (if maybe?
+ (` (!!! (~ arg-name)))
+ arg-name)]))))
+ import-member-args)
#let [arg-classes (: (List Text)
- (L/map (. (simple-class$ (L/compose type-params import-member-tvars)) product;right)
- import-member-args))
- arg-types (L/map (: (-> [Bool GenericType] Code)
- (function [[maybe? arg]]
- (let [arg-type (class->type (get@ #import-member-mode commons) type-params arg)]
- (if maybe?
- (` (Maybe (~ arg-type)))
- arg-type))))
- import-member-args)
- arg-function-inputs (L/map product;left arg-inputs)
- arg-method-inputs (L/map product;right arg-inputs)]]
+ (list/map (. (simple-class$ (list/compose type-params import-member-tvars)) product;right)
+ import-member-args))
+ arg-types (list/map (: (-> [Bool GenericType] Code)
+ (function [[maybe? arg]]
+ (let [arg-type (class->type (get@ #import-member-mode commons) type-params arg)]
+ (if maybe?
+ (` (Maybe (~ arg-type)))
+ arg-type))))
+ import-member-args)
+ arg-function-inputs (list/map product;left arg-inputs)
+ arg-method-inputs (list/map product;right arg-inputs)]]
(wrap [arg-function-inputs arg-method-inputs arg-classes arg-types])))
_
@@ -1636,8 +1635,8 @@
#AutoPrM
(` (let [(~@ (|> inputs
- (L/map auto-conv)
- L/join))]
+ (list/map auto-conv)
+ list/join))]
(~ body)))))
(def: (with-mode-field-get mode class output)
@@ -1673,7 +1672,7 @@
(let [[full-name class-tvars] class
all-params (|> (member-type-vars class-tvars member)
(list;filter free-type-param?)
- (L/map type-param->type-arg))]
+ (list/map type-param->type-arg))]
(case member
(#EnumDecl enum-members)
(do Monad<Lux>
@@ -1685,7 +1684,7 @@
_
(let [=class-tvars (|> class-tvars
(list;filter free-type-param?)
- (L/map type-param->type-arg))]
+ (list/map type-param->type-arg))]
(` (All [(~@ =class-tvars)] (host (~ (code;symbol ["" full-name])) [(~@ =class-tvars)]))))))
getter-interop (: (-> Text Code)
(function [name]
@@ -1693,7 +1692,7 @@
(` (def: (~ getter-name)
(~ enum-type)
(;_lux_proc ["jvm" (~ (code;text (format "getstatic" ":" full-name ":" name)))] []))))))]]
- (wrap (L/map getter-interop enum-members)))
+ (wrap (list/map getter-interop enum-members)))
(#ConstructorDecl [commons _])
(do Monad<Lux>
@@ -1766,7 +1765,7 @@
tvar-asts (: (List Code)
(|> class-tvars
(list;filter free-type-param?)
- (L/map type-param->type-arg)))
+ (list/map type-param->type-arg)))
getter-name (code;symbol ["" (format method-prefix member-separator import-field-name)])
setter-name (code;symbol ["" (format method-prefix member-separator import-field-name "!")])]
getter-interop (with-gensyms [g!obj]
@@ -1901,8 +1900,8 @@
)}
(do Monad<Lux>
[kind (class-kind class-decl)
- =members (M;map @ (member-import$ (product;right class-decl) long-name? kind class-decl) members)]
- (wrap (list& (class-import$ long-name? class-decl) (L/join =members)))))
+ =members (monad;map @ (member-import$ (product;right class-decl) long-name? kind class-decl) members)]
+ (wrap (list& (class-import$ long-name? class-decl) (list/join =members)))))
(syntax: #export (array [#let [imports (class-imports *compiler*)]]
[type (generic-type^ imports (list))]
@@ -2026,13 +2025,13 @@
bar (do-something-else my-res2)]
(do-one-last-thing foo bar))))}
(with-gensyms [g!output g!_]
- (let [inits (L/join (L/map (function [[res-name res-ctor]]
- (list (code;symbol ["" res-name]) res-ctor))
- bindings))
- closes (L/map (function [res]
- (` (try (;_lux_proc ["jvm" "invokevirtual:java.io.Closeable:close:"]
- [(~ (code;symbol ["" (product;left res)]))]))))
- bindings)]
+ (let [inits (list/join (list/map (function [[res-name res-ctor]]
+ (list (code;symbol ["" res-name]) res-ctor))
+ bindings))
+ closes (list/map (function [res]
+ (` (try (;_lux_proc ["jvm" "invokevirtual:java.io.Closeable:close:"]
+ [(~ (code;symbol ["" (product;left res)]))]))))
+ bindings)]
(wrap (list (` (do Monad<IO>
[(~@ inits)
(~ g!output) (~ body)
@@ -2074,7 +2073,7 @@
(wrap fqcn)
#;None
- (macro;fail (Text/compose "Unknown class: " class)))))
+ (macro;fail (text/compose "Unknown class: " class)))))
(syntax: #export (type [#let [imports (class-imports *compiler*)]]
[type (generic-type^ imports (list))])
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
index b1e1a3d1b..e23353593 100644
--- a/stdlib/source/lux/macro/poly.lux
+++ b/stdlib/source/lux/macro/poly.lux
@@ -5,13 +5,13 @@
["p" parser])
[function]
(data [text "text/" Monoid<Text>]
- (coll [list "L/" Fold<List> Monad<List> Monoid<List>]
+ (coll [list "list/" Fold<List> Monad<List> Monoid<List>]
[dict #+ Dict])
[number "nat/" Codec<Text,Nat>]
[product]
[bool]
[maybe]
- [ident "Ident/" Eq<Ident> Codec<Text,Ident>]
+ [ident "ident/" Eq<Ident> Codec<Text,Ident>]
["R" result])
[macro #+ with-gensyms]
(macro [code]
@@ -43,7 +43,7 @@
_
(#R;Error (|> remaining
- (L/map type;to-text)
+ (list/map type;to-text)
(text;join-with ", ")
(text/compose "Unconsumed types: "))))))
@@ -163,7 +163,7 @@
(let [members (<flattener> (type;un-name headT))]
(if (n.> +1 (list;size members))
(local members poly)
- (p;fail ($_ text/compose "Not a " (Ident/encode (ident-for <tag>)) " type: " (type;to-text headT)))))))]
+ (p;fail ($_ text/compose "Not a " (ident/encode (ident-for <tag>)) " type: " (type;to-text headT)))))))]
[variant type;flatten-variant #;Sum]
[tuple type;flatten-tuple #;Product]
@@ -201,7 +201,7 @@
partial-varI (n.inc partialI)
partial-varL (label partial-varI)
partialC (` ((~ funcL) (~@ (|> (list;n.range +0 (n.dec num-args))
- (L/map (|>. (n.* +2) n.inc (n.+ funcI) label))
+ (list/map (|>. (n.* +2) n.inc (n.+ funcI) label))
list;reverse))))]
(recur (n.inc current-arg)
(|> env'
@@ -332,7 +332,7 @@
(do p;Monad<Parser>
[current any
#let [_ (log! ($_ text/compose
- "{" (Ident/encode (ident-for ;;log)) "} "
+ "{" (ident/encode (ident-for ;;log)) "} "
(type;to-text current)))]]
(p;fail "LOGGING")))
@@ -364,7 +364,7 @@
(def: (derivation-name poly args)
(-> Text (List Text) (Maybe Text))
(if (common-poly-name? poly)
- (#;Some (L/fold (text;replace-once "?") poly args))
+ (#;Some (list/fold (text;replace-once "?") poly args))
#;None))
(syntax: #export (derived: [export csr;export]
@@ -378,7 +378,7 @@
(wrap name)
(^multi #;None
- [(derivation-name (product;right poly-func) (L/map product;right poly-args))
+ [(derivation-name (product;right poly-func) (list/map product;right poly-args))
(#;Some derived-name)])
(wrap derived-name)
@@ -389,7 +389,7 @@
custom-impl
#;None
- (` ((~ (code;symbol poly-func)) (~@ (L/map code;symbol poly-args)))))]]
+ (` ((~ (code;symbol poly-func)) (~@ (list/map code;symbol poly-args)))))]]
(wrap (;list (` (def: (~@ (csw;export export))
(~ (code;symbol ["" name]))
{#;struct? true}
@@ -401,7 +401,7 @@
(case type
(#;Host name params)
(` (#;Host (~ (code;text name))
- (list (~@ (L/map (to-ast env) params)))))
+ (list (~@ (list/map (to-ast env) params)))))
(^template [<tag>]
<tag>
@@ -433,7 +433,7 @@
(^template [<tag> <macro> <flattener>]
(<tag> left right)
- (` (<macro> (~@ (L/map (to-ast env) (<flattener> type))))))
+ (` (<macro> (~@ (list/map (to-ast env) (<flattener> type))))))
([#;Sum | type;flatten-variant]
[#;Product & type;flatten-tuple])
@@ -442,7 +442,7 @@
(^template [<tag>]
(<tag> scope body)
- (` (<tag> (list (~@ (L/map (to-ast env) scope)))
+ (` (<tag> (list (~@ (list/map (to-ast env) scope)))
(~ (to-ast env body)))))
([#;UnivQ] [#;ExQ])
))
diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux
index d8da515f4..b0b9fbce7 100644
--- a/stdlib/source/lux/macro/poly/eq.lux
+++ b/stdlib/source/lux/macro/poly/eq.lux
@@ -5,7 +5,7 @@
["p" parser])
(data [text "text/" Monoid<Text>]
text/format
- (coll [list "L/" Monad<List>]
+ (coll [list "list/" Monad<List>]
[vector]
[array]
[queue]
@@ -66,7 +66,7 @@
[;Maybe maybe;Eq<Maybe>]
[;List list;Eq<List>]
[vector;Vector vector;Eq<Vector>]
- [array;Array array;Eq<Array>]
+ [;Array array;Eq<Array>]
[queue;Queue queue;Eq<Queue>]
[set;Set set;Eq<Set>]
[seq;Seq seq;Eq<Seq>]
@@ -106,24 +106,24 @@
(wrap (` (: (~ (@Eq inputT))
(function [(~ g!left) (~ g!right)]
(case [(~ g!left) (~ g!right)]
- (~@ (L/join (L/map (function [[tag g!eq]]
- (list (` [((~ (code;nat tag)) (~ g!left))
- ((~ (code;nat tag)) (~ g!right))])
- (` ((~ g!eq) (~ g!left) (~ g!right)))))
- (list;enumerate members))))
+ (~@ (list/join (list/map (function [[tag g!eq]]
+ (list (` [((~ (code;nat tag)) (~ g!left))
+ ((~ (code;nat tag)) (~ g!right))])
+ (` ((~ g!eq) (~ g!left) (~ g!right)))))
+ (list;enumerate members))))
(~ g!_)
false))))))
## Tuples
(do @
[g!eqs (poly;tuple (p;many Eq<?>))
#let [indices (|> (list;size g!eqs) n.dec (list;n.range +0))
- g!lefts (L/map (|>. nat/encode (text/compose "left") code;local-symbol) indices)
- g!rights (L/map (|>. nat/encode (text/compose "right") code;local-symbol) indices)]]
+ g!lefts (list/map (|>. nat/encode (text/compose "left") code;local-symbol) indices)
+ g!rights (list/map (|>. nat/encode (text/compose "right") code;local-symbol) indices)]]
(wrap (` (: (~ (@Eq inputT))
(function [[(~@ g!lefts)] [(~@ g!rights)]]
(and (~@ (|> (list;zip3 g!eqs g!lefts g!rights)
- (L/map (function [[g!eq g!left g!right]]
- (` ((~ g!eq) (~ g!left) (~ g!right)))))))))))))
+ (list/map (function [[g!eq g!left g!right]]
+ (` ((~ g!eq) (~ g!left) (~ g!right)))))))))))))
## Type recursion
(do @
[[g!self bodyC] (poly;recursive Eq<?>)]
@@ -141,7 +141,7 @@
(do @
[[funcC varsC bodyC] (poly;polymorphic Eq<?>)]
(wrap (` (: (All [(~@ varsC)]
- (-> (~@ (L/map (|>. (~) eq;Eq (`)) varsC))
+ (-> (~@ (list/map (|>. (~) eq;Eq (`)) varsC))
(eq;Eq ((~ (poly;to-ast *env* inputT)) (~@ varsC)))))
(function (~ funcC) [(~@ varsC)]
(~ bodyC))))))
diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux
index 1e61d49f9..1c3510b85 100644
--- a/stdlib/source/lux/macro/poly/json.lux
+++ b/stdlib/source/lux/macro/poly/json.lux
@@ -13,8 +13,8 @@
["R" result]
[sum]
[product]
- (coll [list "L/" Fold<List> Monad<List>]
- [vector #+ Vector vector "Vector/" Monad<Vector>]
+ (coll [list "list/" Fold<List> Monad<List>]
+ [vector #+ Vector vector "vector/" Monad<Vector>]
["d" dict])
(format [".." json #+ JSON]))
(time ["i" instant]
@@ -30,7 +30,7 @@
(def: #hidden _map_
(All [a b] (-> (-> a b) (List a) (List b)))
- L/map)
+ list/map)
(def: tag
(-> Nat Frac)
@@ -150,21 +150,21 @@
(wrap (` (: (~ (@JSON//encode inputT))
(function [(~ g!input)]
(case (~ g!input)
- (~@ (L/join (L/map (function [[tag g!encode]]
- (list (` ((~ (code;nat tag)) (~ g!input)))
- (` (..;json [(~ (code;frac (;;tag tag)))
- ((~ g!encode) (~ g!input))]))))
- (list;enumerate members))))))))))
+ (~@ (list/join (list/map (function [[tag g!encode]]
+ (list (` ((~ (code;nat tag)) (~ g!input)))
+ (` (..;json [(~ (code;frac (;;tag tag)))
+ ((~ g!encode) (~ g!input))]))))
+ (list;enumerate members))))))))))
(do @
[g!encoders (poly;tuple (p;many Codec<JSON,?>//encode))
#let [g!members (|> (list;size g!encoders) n.dec
(list;n.range +0)
- (L/map (|>. nat/encode code;local-symbol)))]]
+ (list/map (|>. nat/encode code;local-symbol)))]]
(wrap (` (: (~ (@JSON//encode inputT))
(function [[(~@ g!members)]]
- (..;json [(~@ (L/map (function [[g!member g!encode]]
- (` ((~ g!encode) (~ g!member))))
- (list;zip2 g!members g!encoders)))]))))))
+ (..;json [(~@ (list/map (function [[g!member g!encode]]
+ (` ((~ g!encode) (~ g!member))))
+ (list;zip2 g!members g!encoders)))]))))))
## Type recursion
(do @
[[selfC non-recC] (poly;recursive Codec<JSON,?>//encode)]
@@ -180,8 +180,8 @@
(do @
[[funcC varsC bodyC] (poly;polymorphic Codec<JSON,?>//encode)]
(wrap (` (: (All [(~@ varsC)]
- (-> (~@ (L/map (function [varC] (` (-> (~ varC) ..;JSON)))
- varsC))
+ (-> (~@ (list/map (function [varC] (` (-> (~ varC) ..;JSON)))
+ varsC))
(-> ((~ (poly;to-ast *env* inputT)) (~@ varsC))
..;JSON)))
(function (~ funcC) [(~@ varsC)]
@@ -252,11 +252,11 @@
[members (poly;variant (p;many Codec<JSON,?>//decode))]
(wrap (` (: (~ (@JSON//decode inputT))
($_ p;alt
- (~@ (L/map (function [[tag memberC]]
- (` (|> (~ memberC)
- (p;after (..;number! (~ (code;frac (;;tag tag)))))
- ..;array)))
- (list;enumerate members))))))))
+ (~@ (list/map (function [[tag memberC]]
+ (` (|> (~ memberC)
+ (p;after (..;number! (~ (code;frac (;;tag tag)))))
+ ..;array)))
+ (list;enumerate members))))))))
(do @
[g!decoders (poly;tuple (p;many Codec<JSON,?>//decode))]
(wrap (` (: (~ (@JSON//decode inputT))
@@ -276,7 +276,7 @@
(do @
[[funcC varsC bodyC] (poly;polymorphic Codec<JSON,?>//decode)]
(wrap (` (: (All [(~@ varsC)]
- (-> (~@ (L/map (|>. (~) ..;Reader (`)) varsC))
+ (-> (~@ (list/map (|>. (~) ..;Reader (`)) varsC))
(..;Reader ((~ (poly;to-ast *env* inputT)) (~@ varsC)))))
(function (~ funcC) [(~@ varsC)]
(~ bodyC))))))
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index c922cee21..00852b46d 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -1,8 +1,8 @@
(;module: {#;doc "Pseudo-random number generation (PRNG) algorithms."}
[lux #- list]
- (lux (control ["F" functor]
- ["A" applicative]
- ["M" monad #+ do Monad]
+ (lux (control [functor #+ Functor]
+ [applicative #+ Applicative]
+ [monad #+ do Monad]
hash)
(data [bit]
[text "text/" Monoid<Text>]
@@ -12,12 +12,12 @@
(number ["r" ratio]
["c" complex])
(coll [list "list/" Fold<List>]
- ["a" array]
- ["D" dict]
- ["Q" queue]
- ["S" set]
- ["ST" stack]
- ["V" vector]))
+ [array]
+ [dict #+ Dict]
+ [queue #+ Queue]
+ [set #+ Set]
+ [stack #+ Stack]
+ [vector #+ Vector]))
))
(type: #export #rec PRNG
@@ -28,13 +28,13 @@
{#;doc "A producer of random values based on a PRNG."}
(-> PRNG [PRNG a]))
-(struct: #export _ (F;Functor Random)
+(struct: #export _ (Functor Random)
(def: (map f fa)
(function [state]
(let [[state' a] (fa state)]
[state' (f a)]))))
-(struct: #export _ (A;Applicative Random)
+(struct: #export _ (Applicative Random)
(def: functor Functor<Random>)
(def: (wrap a)
@@ -189,8 +189,8 @@
(wrap (<plus> x xs)))
(:: Monad<Random> wrap <zero>)))]
- [list List (;list) #;Cons]
- [vector V;Vector V;empty V;add]
+ [list List (;list) #;Cons]
+ [vector Vector vector;empty vector;add]
)
(do-template [<name> <type> <ctor>]
@@ -200,27 +200,27 @@
[values (list size value-gen)]
(wrap (|> values <ctor>))))]
- [array a;Array a;from-list]
- [queue Q;Queue Q;from-list]
- [stack ST;Stack (list/fold ST;push ST;empty)]
+ [array Array array;from-list]
+ [queue Queue queue;from-list]
+ [stack Stack (list/fold stack;push stack;empty)]
)
(def: #export (set Hash<a> size value-gen)
- (All [a] (-> (Hash a) Nat (Random a) (Random (S;Set a))))
+ (All [a] (-> (Hash a) Nat (Random a) (Random (Set a))))
(if (n.> +0 size)
(do Monad<Random>
[xs (set Hash<a> (n.dec size) value-gen)]
(loop [_ []]
(do @
[x value-gen
- #let [xs+ (S;add x xs)]]
- (if (n.= size (S;size xs+))
+ #let [xs+ (set;add x xs)]]
+ (if (n.= size (set;size xs+))
(wrap xs+)
(recur [])))))
- (:: Monad<Random> wrap (S;new Hash<a>))))
+ (:: Monad<Random> wrap (set;new Hash<a>))))
(def: #export (dict Hash<a> size key-gen value-gen)
- (All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (D;Dict k v))))
+ (All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (Dict k v))))
(if (n.> +0 size)
(do Monad<Random>
[kv (dict Hash<a> (n.dec size) key-gen value-gen)]
@@ -228,11 +228,11 @@
(do @
[k key-gen
v value-gen
- #let [kv+ (D;put k v kv)]]
- (if (n.= size (D;size kv+))
+ #let [kv+ (dict;put k v kv)]]
+ (if (n.= size (dict;size kv+))
(wrap kv+)
(recur [])))))
- (:: Monad<Random> wrap (D;new Hash<a>))))
+ (:: Monad<Random> wrap (dict;new Hash<a>))))
(def: #export (run prng calc)
(All [a] (-> PRNG (Random a) [PRNG a]))
@@ -272,22 +272,22 @@
))
(def: (swap from to vec)
- (All [a] (-> Nat Nat (V;Vector a) (V;Vector a)))
+ (All [a] (-> Nat Nat (Vector a) (Vector a)))
(|> vec
- (V;put to (maybe;assume (V;nth from vec)))
- (V;put from (maybe;assume (V;nth to vec)))))
+ (vector;put to (maybe;assume (vector;nth from vec)))
+ (vector;put from (maybe;assume (vector;nth to vec)))))
(def: #export (shuffle seed vector)
{#;doc "Shuffle a vector randomly based on a seed value."}
- (All [a] (-> Nat (V;Vector a) (V;Vector a)))
- (let [_size (V;size vector)
- _shuffle (M;fold Monad<Random>
- (function [idx vec]
- (do Monad<Random>
- [rand nat]
- (wrap (swap idx (n.% _size rand) vec))))
- vector
- (list;n.range +0 (n.dec _size)))]
+ (All [a] (-> Nat (Vector a) (Vector a)))
+ (let [_size (vector;size vector)
+ _shuffle (monad;fold Monad<Random>
+ (function [idx vec]
+ (do Monad<Random>
+ [rand nat]
+ (wrap (swap idx (n.% _size rand) vec))))
+ vector
+ (list;n.range +0 (n.dec _size)))]
(|> _shuffle
(run (pcg-32 [+123 seed]))
product;right)))
diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux
index 92715a9b7..89eaba448 100644
--- a/stdlib/source/lux/world/net/udp.jvm.lux
+++ b/stdlib/source/lux/world/net/udp.jvm.lux
@@ -51,7 +51,7 @@
(: (io;IO (R;Result InetAddress))
(case (array;size addresses)
+0 (io;io (ex;throw Cannot-Resolve-Address address))
- +1 (wrap (maybe;assume (array;get +0 addresses)))
+ +1 (wrap (maybe;assume (array;read +0 addresses)))
_ (io;io (ex;throw Multiple-Candidate-Addresses address))))))
(opaque: #export UDP {}
diff --git a/stdlib/test/test/lux/data/coll/array.lux b/stdlib/test/test/lux/data/coll/array.lux
index 81f8144d2..d5fde5a64 100644
--- a/stdlib/test/test/lux/data/coll/array.lux
+++ b/stdlib/test/test/lux/data/coll/array.lux
@@ -3,7 +3,7 @@
(lux (control [monad #+ do Monad]
pipe)
[io]
- (data (coll ["&" array]
+ (data (coll ["@" array]
[list])
[number]
[maybe])
@@ -18,72 +18,72 @@
(context: "Arrays and their copies"
[size bounded-size
original (R;array size R;nat)
- #let [clone (&;clone original)
- copy (: (&;Array Nat)
- (&;new size))
- manual-copy (: (&;Array Nat)
- (&;new size))]]
+ #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)))
+ (n.= size (@;size original)))
(test "Cloning an array should yield and identical array, but not the same one."
- (and (:: (&;Eq<Array> number;Eq<Nat>) = original clone)
+ (and (:: (@;Eq<Array> number;Eq<Nat>) = 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 (:: (&;Eq<Array> number;Eq<Nat>) = original copy)
+ (exec (@;copy size +0 original +0 copy)
+ (and (:: (@;Eq<Array> number;Eq<Nat>) = original copy)
(not (is original copy)))))
(test "Array folding should go over all values."
- (exec (:: &;Fold<Array> fold
+ (exec (:: @;Fold<Array> fold
(function [x idx]
- (exec (&;put idx x manual-copy)
+ (exec (@;write idx x manual-copy)
(n.inc idx)))
+0
original)
- (:: (&;Eq<Array> number;Eq<Nat>) = original manual-copy)))
+ (:: (@;Eq<Array> number;Eq<Nat>) = original manual-copy)))
(test "Transformations between (full) arrays and lists shouldn't cause lose or change any values."
(|> original
- &;to-list &;from-list
- (:: (&;Eq<Array> number;Eq<Nat>) = original)))
+ @;to-list @;from-list
+ (:: (@;Eq<Array> number;Eq<Nat>) = original)))
))
(context: "Array mutation"
[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 (&;get idx array))]]
+ (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 (&;get idx (&;remove idx array))
+ (case (@;read idx (@;delete idx array))
(#;Some _) false
#;None true))
(test "You should be able to access values put into the array."
- (case (&;get idx (&;put idx value 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))))
+ (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))))))
+ (exec (@;filter n.even? array)
+ (and (n.< size (@;occupied array))
+ (n.> +0 (@;vacant array))
+ (n.= size (n.+ (@;occupied array)
+ (@;vacant array))))))
))
(context: "Finding values."
[size bounded-size
array (|> (R;array size R;nat)
- (R;filter (|>. &;to-list (list;any? n.even?))))]
+ (R;filter (|>. @;to-list (list;any? n.even?))))]
($_ seq
(test "Can find values inside arrays."
- (|> (&;find n.even? array)
+ (|> (@;find n.even? array)
(case> (#;Some _) true
#;None false)))
(test "Can find values inside arrays (with access to indices)."
- (|> (&;find+ (function [idx n]
+ (|> (@;find+ (function [idx n]
(and (n.even? n)
(n.< size idx)))
array)
@@ -93,8 +93,8 @@
(context: "Functor"
[size bounded-size
array (R;array size R;nat)]
- (let [(^open) &;Functor<Array>
- (^open) (&;Eq<Array> number;Eq<Nat>)]
+ (let [(^open) @;Functor<Array>
+ (^open) (@;Eq<Array> number;Eq<Nat>)]
($_ seq
(test "Functor shouldn't alter original array."
(let [copy (map id array)]
@@ -111,20 +111,20 @@
sizeR bounded-size
left (R;array sizeL R;nat)
right (R;array sizeR R;nat)
- #let [(^open) &;Monoid<Array>
- (^open) (&;Eq<Array> number;Eq<Nat>)
+ #let [(^open) @;Monoid<Array>
+ (^open) (@;Eq<Array> number;Eq<Nat>)
fusion (compose left right)]]
($_ seq
(test "Appending two arrays should produce a new one twice as large."
- (n.= (n.+ sizeL sizeR) (&;size fusion)))
+ (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)
+ (|> (: (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)
+ (|> (: (Array Nat)
+ (@;new sizeR))
+ (@;copy sizeR sizeL fusion +0)
(= right)))
))
--
cgit v1.2.3