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 +- 12 files changed, 439 insertions(+), 444 deletions(-) (limited to 'stdlib/source') 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]) + (data (coll [list "list/" Fold]) [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 Eq) (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 Functor Monoid] - [array #+ Array "Array/" Functor Fold]) + (coll [list "list/" Fold Functor Monoid] + [array "array/" Functor Fold]) [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 key colls) - (All [K V] (-> (Hash K) K (Collisions K V) (Maybe Index))) +(def: (collision-index Hash key colls) + (All [k v] (-> (Hash k) k (Collisions k v) (Maybe Index))) (:: Monad map product;left (array;find+ (function [idx [key' val']] - (:: Hash = key key')) + (:: Hash = 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 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 hash key') key' val' Hash empty) - h-array) - - #;None - (undefined))] - default)) - [+0 - (: (Array (Node ($ +0) ($ +1))) - (array;new hierarchy-nodes-size))] - hierarchy-indices))) +(def: (promote-base put' Hash 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 hash key') key' val' Hash 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 node) - (All [K V] (-> Level Hash-Code K V (Hash K) (Node K V) (Node K V))) +(def: (put' level hash key val Hash 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 sub-node) + (update! idx (put' (level-up level) hash key val Hash 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 sub-node)] + (let [sub-node' (put' (level-up level) hash key val Hash 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 = key key') + (if (:: Hash = 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 hash key')] + (#;Left (let [hash' (:: Hash 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) - (put' next-level hash key val Hash)))))) + (put' next-level hash' key' val' Hash) + (put' next-level hash key val Hash)))))) 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 level bitmap base) - (array;put (level-index level hash) - (put' (level-up level) hash key val Hash empty)))) + (|> (promote-base put' Hash level bitmap base) + (array;write (level-index level hash) + (put' (level-up level) hash key val Hash 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 key _colls) + (case (collision-index Hash 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))) + (array;write +0 (#;Left node)))) + (put' level hash key val Hash))) )) -(def: (remove' level hash key Hash node) - (All [K V] (-> Level Hash-Code K (Hash K) (Node K V) (Node K V))) +(def: (remove' level hash key Hash 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 sub-node)] + (let [sub-node' (remove' (level-up level) hash key Hash 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 sub-node)] + (let [sub-node' (remove' (level-up level) hash key Hash 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 = key key') - ## If so, remove the KV pair and unset the BitPosition. + (if (:: Hash = 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 key _colls) + (case (collision-index Hash 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 node) - (All [K V] (-> Level Hash-Code K (Hash K) (Node K V) (Maybe V))) +(def: (get' level hash key Hash 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 sub-node)) + (#;Some sub-node) (get' (level-up level) hash key Hash 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 sub-node) + (get' (level-up level) hash key Hash sub-node) (#;Some (#;Right [key' val'])) - (if (:: Hash = key key') + (if (:: Hash = 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 map product;right - (array;find (|>. product;left (:: Hash = key)) + (array;find (|>. product;left (:: Hash = 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) - (All [K V] (-> (Hash K) (Dict K V))) - {#hash Hash +(def: #export (new Hash) + (All [k v] (-> (Hash k) (Dict k v))) + {#hash Hash #root empty}) (def: #export (put key val dict) - (All [K V] (-> K V (Dict K V) (Dict K V))) - (let [[Hash node] dict] - [Hash (put' root-level (:: Hash hash key) key val Hash node)])) + (All [k v] (-> k v (Dict k v) (Dict k v))) + (let [[Hash node] dict] + [Hash (put' root-level (:: Hash hash key) key val Hash node)])) (def: #export (remove key dict) - (All [K V] (-> K (Dict K V) (Dict K V))) - (let [[Hash node] dict] - [Hash (remove' root-level (:: Hash hash key) key Hash node)])) + (All [k v] (-> k (Dict k v) (Dict k v))) + (let [[Hash node] dict] + [Hash (remove' root-level (:: Hash hash key) key Hash node)])) (def: #export (get key dict) - (All [K V] (-> K (Dict K V) (Maybe V))) - (let [[Hash node] dict] - (get' root-level (:: Hash hash key) key Hash node))) + (All [k v] (-> k (Dict k v) (Maybe v))) + (let [[Hash node] dict] + (get' root-level (:: Hash hash key) key Hash 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 kvs) - (All [K V] (-> (Hash K) (List [K V]) (Dict K V))) - (L/fold (function [[k v] dict] - (put k v dict)) - (new Hash) - kvs)) +(def: #export (from-list Hash kvs) + (All [k v] (-> (Hash k) (List [k v]) (Dict k v))) + (list/fold (function [[k v] dict] + (put k v dict)) + (new Hash) + kvs)) (do-template [ ] [(def: #export ( dict) - (All [K V] (-> (Dict K V) (List ))) - (|> dict entries (L/map )))] + (All [k v] (-> (Dict k v) (List ))) + (|> dict entries (list/map )))] - [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 _] dict] - (L/fold (function [key new-dict] - (case (get key dict) - #;None new-dict - (#;Some val) (put key val new-dict))) - (new Hash) - keys))) + (All [k v] (-> (List k) (Dict k v) (Dict k v))) + (let [[Hash _] dict] + (list/fold (function [key new-dict] + (case (get key dict) + #;None new-dict + (#;Some val) (put key val new-dict))) + (new Hash) + keys))) ## [Structures] (struct: #export (Eq Eq) (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 Functor Monoid] - [array #+ Array "Array/" Functor Fold]) + (coll [list "list/" Fold Functor Monoid] + [array "array/" Functor Fold]) [bit] - [number "Int/" Number] [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 - [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 [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 map f))) - #tail (|> xs (get@ #tail) (Array/map f)) + #root (|> xs (get@ #root) (array/map (:: Functor map f))) + #tail (|> xs (get@ #tail) (array/map f)) })) -(struct: #export _ (A;Applicative Vector) +(struct: #export _ (Applicative Vector) (def: functor Functor) (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] - (data (coll [list "L/" Monad Fold Monoid] - [array #+ Array]) + (data (coll [list "list/" Monad Fold Monoid]) number [maybe] [product] - [text "Text/" Eq Monoid] + [text "text/" Eq Monoid] text/format - [bool "Bool/" Codec]) + [bool "bool/" Codec]) [macro #+ with-gensyms Functor Monad] (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 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 [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 [] [meta ( parts)] - [meta ( (L/map (pre-walk-replace f) parts))]) + [meta ( (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 [[_ 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 ":" 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 [name (full-class-name^ imports)] - (if (list;member? text;Eq (L/map product;left type-vars) name) + (if (list;member? text;Eq (list/map product;left type-vars) name) (wrap (#GenericTypeVar name)) (wrap (#GenericClass name (list))))) (s;form (do p;Monad @@ -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 (L/map product;left type-vars) name)))] + (not (list;member? text;Eq (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 [_ (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 [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 - [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 @@ -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 @@ -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 [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 [(~@ 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] - (coll [list "L/" Fold Monad Monoid] + (coll [list "list/" Fold Monad Monoid] [dict #+ Dict]) [number "nat/" Codec] [product] [bool] [maybe] - [ident "Ident/" Eq Codec] + [ident "ident/" Eq Codec] ["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 ( (type;un-name headT))] (if (n.> +1 (list;size members)) (local members poly) - (p;fail ($_ text/compose "Not a " (Ident/encode (ident-for )) " type: " (type;to-text headT)))))))] + (p;fail ($_ text/compose "Not a " (ident/encode (ident-for )) " 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 [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 [] @@ -433,7 +433,7 @@ (^template [ ] ( left right) - (` ( (~@ (L/map (to-ast env) ( type)))))) + (` ( (~@ (list/map (to-ast env) ( type)))))) ([#;Sum | type;flatten-variant] [#;Product & type;flatten-tuple]) @@ -442,7 +442,7 @@ (^template [] ( scope body) - (` ( (list (~@ (L/map (to-ast env) scope))) + (` ( (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/format - (coll [list "L/" Monad] + (coll [list "list/" Monad] [vector] [array] [queue] @@ -66,7 +66,7 @@ [;Maybe maybe;Eq] [;List list;Eq] [vector;Vector vector;Eq] - [array;Array array;Eq] + [;Array array;Eq] [queue;Queue queue;Eq] [set;Set set;Eq] [seq;Seq seq;Eq] @@ -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 Monad] - [vector #+ Vector vector "Vector/" Monad] + (coll [list "list/" Fold Monad] + [vector #+ Vector vector "vector/" Monad] ["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//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//encode)] @@ -180,8 +180,8 @@ (do @ [[funcC varsC bodyC] (poly;polymorphic Codec//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//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//decode))] (wrap (` (: (~ (@JSON//decode inputT)) @@ -276,7 +276,7 @@ (do @ [[funcC varsC bodyC] (poly;polymorphic Codec//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] @@ -12,12 +12,12 @@ (number ["r" ratio] ["c" complex]) (coll [list "list/" Fold] - ["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) (def: (wrap a) @@ -189,8 +189,8 @@ (wrap ( x xs))) (:: Monad wrap )))] - [list List (;list) #;Cons] - [vector V;Vector V;empty V;add] + [list List (;list) #;Cons] + [vector Vector vector;empty vector;add] ) (do-template [ ] @@ -200,27 +200,27 @@ [values (list size value-gen)] (wrap (|> values ))))] - [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 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 [xs (set Hash (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 wrap (S;new Hash)))) + (:: Monad wrap (set;new Hash)))) (def: #export (dict Hash 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 [kv (dict Hash (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 wrap (D;new Hash)))) + (:: Monad wrap (dict;new Hash)))) (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 - (function [idx vec] - (do Monad - [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 + (function [idx vec] + (do Monad + [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 {} -- cgit v1.2.3