From 5824d2c5b09889c3b0314694c4069c234bd992cf Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 22 Jul 2017 13:59:19 -0400 Subject: - Small refactorings and bug fixes. --- stdlib/source/lux/concurrency/frp.lux | 2 +- stdlib/source/lux/control/codec.lux | 16 ++-- stdlib/source/lux/control/exception.lux | 22 ++--- stdlib/source/lux/data/coll/dict.lux | 118 +++++++++++++------------- stdlib/source/lux/macro/poly/functor.lux | 2 +- stdlib/source/lux/macro/poly/text-encoder.lux | 2 +- 6 files changed, 83 insertions(+), 79 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux index 54e7c957b..538bbdcbd 100644 --- a/stdlib/source/lux/concurrency/frp.lux +++ b/stdlib/source/lux/concurrency/frp.lux @@ -66,7 +66,7 @@ (if done? (wrap true) (close )))) - ([#;None target] + ([#;None target] [(#;Some (#;Some [_ target'])) target']) _ diff --git a/stdlib/source/lux/control/codec.lux b/stdlib/source/lux/control/codec.lux index 535201954..e11f08016 100644 --- a/stdlib/source/lux/control/codec.lux +++ b/stdlib/source/lux/control/codec.lux @@ -1,24 +1,28 @@ (;module: lux - (lux control/monad - data/result)) + (lux (control monad) + (data ["R" result]))) ## [Signatures] (sig: #export (Codec m a) {#;doc "A way to move back-and-forth between a type and an alternative representation for it."} (: (-> a m) encode) - (: (-> m (Result a)) + (: (-> m (R;Result a)) decode)) ## [Values] (struct: #export (compose Codec Codec) {#;doc "Codec composition."} - (All [a b c] (-> (Codec c b) (Codec b a) (Codec c a))) - (def: encode (|>. (:: Codec encode) (:: Codec encode))) + (All [a b c] + (-> (Codec c b) (Codec b a) + (Codec c a))) + (def: encode + (|>. (:: Codec encode) + (:: Codec encode))) (def: (decode cy) - (do Monad + (do R;Monad [by (:: Codec decode cy)] (:: Codec decode by))) ) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index 401a3057c..560928bf2 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -1,8 +1,8 @@ (;module: {#;doc "Exception-handling functionality built on top of the Result type."} lux (lux (control monad) - (data ["R" result #- fail] - [text "T/" Monoid]) + (data ["R" result] + [text "text/" Monoid]) [macro] (macro [code] ["s" syntax #+ syntax: Syntax] @@ -16,9 +16,9 @@ (-> Text Text)) ## [Values] -(def: #hidden _T/append_ +(def: #hidden _text/append_ (-> Text Text Text) - T/append) + text/append) (def: #export (match? exception error) (-> Exception Text Bool) @@ -29,8 +29,8 @@ If no exception was detected, or a different one from the one being checked, then pass along the original value."} (All [a] - (-> Exception (-> Text a) (Result a) - (Result a))) + (-> Exception (-> Text a) (R;Result a) + (R;Result a))) (case try (#R;Success output) (#R;Success output) @@ -47,7 +47,7 @@ (def: #export (otherwise to-do try) {#;doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."} (All [a] - (-> (-> Text a) (Result a) a)) + (-> (-> Text a) (R;Result a) a)) (case try (#R;Success output) output @@ -57,12 +57,12 @@ (def: #export (return value) {#;doc "A way to lift normal values into the result-handling context."} - (All [a] (-> a (Result a))) + (All [a] (-> a (R;Result a))) (#R;Success value)) (def: #export (throw exception message) {#;doc "Decorate an error message with an Exception and lift it into the result-handling context."} - (All [a] (-> Exception Text (Result a))) + (All [a] (-> Exception Text (R;Result a))) (#R;Error (exception message))) (syntax: #export (exception: [_ex-lev csr;export] [name s;local-symbol]) @@ -71,8 +71,8 @@ (exception: #export Some-Exception))} (do @ [current-module macro;current-module-name - #let [descriptor ($_ T/append "{" current-module ";" name "}" "\n") + #let [descriptor ($_ text/append "{" current-module ";" name "}" "\n") g!message (code;symbol ["" "message"])]] (wrap (list (` (def: (~@ (csw;export _ex-lev)) ((~ (code;symbol ["" name])) (~ g!message)) Exception - (_T/append_ (~ (code;text descriptor)) (~ g!message)))))))) + (_text/append_ (~ (code;text descriptor)) (~ g!message)))))))) diff --git a/stdlib/source/lux/data/coll/dict.lux b/stdlib/source/lux/data/coll/dict.lux index e54aaf5cc..ac6a47891 100644 --- a/stdlib/source/lux/data/coll/dict.lux +++ b/stdlib/source/lux/data/coll/dict.lux @@ -3,7 +3,7 @@ (lux (control hash [eq #+ Eq]) (data maybe - (coll [list "List/" Fold Functor Monoid] + (coll [list "L/" Fold Functor Monoid] [array #+ Array "Array/" Functor Fold]) [bit] [product] @@ -223,20 +223,20 @@ ## nodes to save space. (def: (demote-hierarchy except-idx [h-size h-array]) (All [k v] (-> Index (Hierarchy k v) [BitMap (Base k v)])) - (product;right (List/fold (function [idx [insertion-idx node]] - (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 (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))))) ## When #Base nodes grow too large, they're promoted to #Hierarchy to ## add some depth to the tree and help keep it's balance. @@ -248,26 +248,26 @@ (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;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))) + (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))) ## All empty nodes look the same (a #Base node with clean bitmap is ## used). @@ -526,7 +526,7 @@ (All [K V] (-> (Node K V) (List [K V]))) (case node (#Hierarchy _size hierarchy) - (Array/fold (function [sub-node tail] (List/append (entries' sub-node) tail)) + (Array/fold (function [sub-node tail] (L/append (entries' sub-node) tail)) #;Nil hierarchy) @@ -534,7 +534,7 @@ (Array/fold (function [branch tail] (case branch (#;Left sub-node) - (List/append (entries' sub-node) tail) + (L/append (entries' sub-node) tail) (#;Right [key' val']) (#;Cons [key' val'] tail))) @@ -609,15 +609,15 @@ (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)) + (L/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 (List/map )))] + (|> dict entries (L/map )))] [keys K product;left] [values V product;right] @@ -628,24 +628,24 @@ 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))) - (List/fold (function [[key val] dict] (put key val dict)) - dict1 - (entries dict2))) + (L/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))) - (List/fold (function [[key val2] dict] - (case (get key dict) - #;None - (put key val2 dict) + (L/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))) @@ -662,12 +662,12 @@ {#;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] - (List/fold (function [key new-dict] - (case (get key dict) - #;None new-dict - (#;Some val) (put key val new-dict))) - (new Hash) - keys))) + (L/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/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux index 39a557bfe..2272d38da 100644 --- a/stdlib/source/lux/macro/poly/functor.lux +++ b/stdlib/source/lux/macro/poly/functor.lux @@ -68,7 +68,7 @@ ))) ## Recursion (do @ - [_ (poly;recur new-env :type:)] + [_ (poly;recursion new-env :type:)] (wrap (` ((~ g!map) (~ g!func) (~ value))))) )))] ($_ macro;either diff --git a/stdlib/source/lux/macro/poly/text-encoder.lux b/stdlib/source/lux/macro/poly/text-encoder.lux index d1bef1952..27b26d1af 100644 --- a/stdlib/source/lux/macro/poly/text-encoder.lux +++ b/stdlib/source/lux/macro/poly/text-encoder.lux @@ -125,7 +125,7 @@ (~ base) ))))) ## Type recursion - (poly;recur env :x:) + (poly;recursion env :x:) ## Type applications (do @ [[:func: :args:] (poly;apply :x:) -- cgit v1.2.3