diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/control/transform.lux | 336 |
1 files changed, 161 insertions, 175 deletions
diff --git a/stdlib/source/lux/control/transform.lux b/stdlib/source/lux/control/transform.lux index 6376a9554..aa78736df 100644 --- a/stdlib/source/lux/control/transform.lux +++ b/stdlib/source/lux/control/transform.lux @@ -3,8 +3,7 @@ (lux (control [eq #+ Eq] [hash #+ Hash]) (data [maybe] - (coll [list] - [set #+ Set] + (coll [set #+ Set] [dict #+ Dict])) (math ["r" random #+ PRNG]))) @@ -19,115 +18,103 @@ (type: #export (Consumer cv cs) [cs (-> cv cs (Result cs))]) -(type: #export (Step v s) - (#Continue s (Maybe v)) +## TODO: Replace with Maybe once new-luxc becomes the standard compiler. +(type: #export (Step v t) + (#Continue t (Maybe v)) #Stop) -(type: #export (Transform pv cv ts) - [ts (-> pv ts (Step cv ts))]) +(type: #export (Transform pv cv) + (-> pv (Step cv (Transform pv cv)))) ## [Primitives] (def: #export (compose prev next) - (All [a b c ps ns] - (-> (Transform a b ps) (Transform b c ns) - (Transform a c [ps ns]))) - (let [[init|prev step|prev] prev - [init|next step|next] next] - [[init|prev init|next] - (function [input [state|prev state|next]] - (case (step|prev input state|prev) - (#Continue state|prev' (#.Some temp)) - (case (step|next temp state|next) - (#Continue state|next' ?output) - (#Continue [state|prev' state|next'] ?output) - - #Stop - #Stop) - - (#Continue state|prev' #.None) - (#Continue [state|prev' state|next] #.None) - - #Stop - #Stop))])) + (All [a b c] + (-> (Transform a b) (Transform b c) (Transform a c))) + (function [input] + (case (prev input) + (#Continue prev' (#.Some temp)) + (case (next temp) + (#Continue next' ?output) + (#Continue (compose prev' next') ?output) + + #Stop + #Stop) + + (#Continue prev' #.None) + (#Continue (compose prev' next) #.None) + + #Stop + #Stop))) (def: #export (each left right) - (All [a l r ls rs] - (-> (Transform a l ls) (Transform a r rs) - (Transform a (& l r) [ls rs]))) - (let [[init|left step|left] left - [init|right step|right] right] - [[init|left init|right] - (function [input [state|left state|right]] - (case [(step|left input state|left) - (step|right input state|right)] - [(#Continue state|left' (#.Some output|left)) - (#Continue state|right' (#.Some output|right))] - (#Continue [state|left' state|right'] - (#.Some [output|left output|right])) - - (^or [#Stop _] [_ #Stop]) - #Stop - - [(#Continue state|left' #.None) _] - (#Continue [state|left' state|right] #.None) - - [_ (#Continue state|right' #.None)] - (#Continue [state|left state|right'] #.None)))])) + (All [a l r] + (-> (Transform a l) (Transform a r) (Transform a [l r]))) + (function [input] + (case [(left input) + (right input)] + [(#Continue left' ?output|left) + (#Continue right' ?output|right)] + (case [?output|left ?output|right] + [(#.Some output|left) (#.Some output|right)] + (#Continue (each left' right') + (#.Some [output|left output|right])) + + _ + (#Continue (each left' right') + #.None)) + + _ + #Stop))) (def: #export (either left right) - (All [a b ls rs] - (-> (Transform a b ls) (Transform a b rs) - (Transform a b [ls rs]))) - (let [[init|left step|left] left - [init|right step|right] right] - [[init|left init|right] - (function [input [state|left state|right]] - (case (step|left input state|left) - (#Continue state|left' (#.Some output)) - (#Continue [state|left' state|right] (#.Some output)) - - (^template [<case> <left-state> <done>] - <case> - (case (step|right input state|right) - (#Continue state|right' (#.Some output)) - (#Continue [<left-state> state|right'] (#.Some output)) - - (#Continue state|right' #.None) - (#Continue [<left-state> state|right'] #.None) - - #Stop - <done>)) - ([(#Continue state|left' #.None) state|left' (#Continue [state|left' state|right] #.None)] - [#Stop state|left #Stop]) - ))])) + (All [a b] + (-> (Transform a b) (Transform a b) (Transform a b))) + (function [input] + (case (left input) + (#Continue left' (#.Some output)) + (#Continue (either left' right) (#.Some output)) + + (^template [<case> <left-state> <done>] + <case> + (case (right input) + (#Continue right' (#.Some output)) + (#Continue (either <left-state> right') (#.Some output)) + + (#Continue right' #.None) + (#Continue (either <left-state> right') #.None) + + #Stop + <done>)) + ([(#Continue left' #.None) left' (#Continue (either left' right) #.None)] + [#Stop left #Stop]) + ))) (def: #export (run transform producer consumer) - (All [ts pv ps cv cs] - (-> (Transform pv cv ts) + (All [pv ps cv cs] + (-> (Transform pv cv) (Producer pv ps) (Consumer cv cs) cs)) - (let [[init|transform step] transform - [init|producer produce] producer + (let [[init|producer produce] producer [init|consumer consume] consumer] - (loop [state|transform init|transform + (loop [transform transform state|producer init|producer state|consumer init|consumer] ## TODO: Delete 'output' let-binding once new-luxc is the ## standard compiler. (let [output (case (produce state|producer) (#.Some [production state|producer']) - (case (step production state|transform) - (#Continue state|transform' (#.Some temp)) + (case (transform production) + (#Continue transform' (#.Some temp)) (case (consume temp state|consumer) (#Partial state|consumer') - (recur state|transform' state|producer' state|consumer') + (recur transform' state|producer' state|consumer') (#Total output) output) - (#Continue state|transform' #.None) - (recur state|transform' state|producer' state|consumer) + (#Continue transform' #.None) + (recur transform' state|producer' state|consumer) #Stop state|consumer) @@ -157,122 +144,121 @@ ## [Transforms] (def: #export (map f) - (All [a b] (-> (-> a b) (Transform a b Unit))) - [[] - (function [input state] - (#Continue state (#.Some (f input))))]) + (All [a b] (-> (-> a b) (Transform a b))) + (function self [input] + (#Continue self (#.Some (f input))))) (def: #export (map-indexed f) - (All [a b] (-> (-> Nat a b) (Transform a b Nat))) - [+0 - (function [input index] - (#Continue (n/inc index) (#.Some (f index input))))]) + (All [a b] (-> (-> Nat a b) (Transform a b))) + (loop [index +0] + (function [input] + (#Continue (recur (n/inc index)) (#.Some (f index input)))))) (def: #export (filter pred) - (All [a] (-> (-> a Bool) (Transform a a Unit))) - [[] - (function [input state] - (#Continue state (if (pred input) - (#.Some input) - #.None)))]) + (All [a] (-> (-> a Bool) (Transform a a))) + (function self [input] + (#Continue self (if (pred input) + (#.Some input) + #.None)))) (def: #export (keep f) - (All [a b] (-> (-> a (Maybe b)) (Transform a b Unit))) - [[] - (function [input state] - (#Continue state (f input)))]) + (All [a b] (-> (-> a (Maybe b)) (Transform a b))) + (function self [input] + (#Continue self (f input)))) (def: #export (keep-indexed f) - (All [a b] (-> (-> Nat a (Maybe b)) (Transform a b Nat))) - [+0 - (function [input index] - (#Continue (n/inc index) (f index input)))]) + (All [a b] (-> (-> Nat a (Maybe b)) (Transform a b))) + (loop [index +0] + (function [input] + (#Continue (recur (n/inc index)) (f index input))))) (def: #export (take amount) - (All [a] (-> Nat (Transform a a Nat))) - [amount - (function [input remaining] - (if (n/= +0 remaining) - #Stop - (#Continue (n/dec remaining) (#.Some input))))]) + (All [a] (-> Nat (Transform a a))) + (loop [remaining amount] + (function [input] + (if (n/= +0 remaining) + #Stop + (#Continue (recur (n/dec remaining)) (#.Some input)))))) (def: #export (drop amount) - (All [a] (-> Nat (Transform a a Nat))) - [amount - (function [input remaining] - (if (n/= +0 remaining) - (#Continue remaining (#.Some input)) - (#Continue (n/dec remaining) #.None)))]) + (All [a] (-> Nat (Transform a a))) + (loop [remaining amount] + (function [input] + (if (n/= +0 remaining) + (#Continue (recur remaining) (#.Some input)) + (#Continue (recur (n/dec remaining)) #.None))))) (def: #export (take-while pred) - (All [a] (-> (-> a Bool) (Transform a a Unit))) - [[] - (function [input state] - (if (pred input) - (#Continue state (#.Some input)) - #Stop))]) + (All [a] (-> (-> a Bool) (Transform a a))) + (function self [input] + (if (pred input) + (#Continue self (#.Some input)) + #Stop))) (def: #export (drop-while pred) - (All [a] (-> (-> a Bool) (Transform a a Bool))) - [true - (function [input dropping?] - (if (and dropping? - (pred input)) - (#Continue true #.None) - (#Continue false (#.Some input))))]) + (All [a] (-> (-> a Bool) (Transform a a))) + (loop [dropping? true] + (function [input] + (if (and dropping? + (pred input)) + (#Continue (recur true) #.None) + (#Continue (recur false) (#.Some input)))))) (def: #export (take-nth nth) - (All [a] (-> Nat (Transform a a Nat))) - [+0 - (function [input seen] - (let [mod (n/% nth (n/inc seen))] - (if (n/= +0 mod) - (#Continue mod (#.Some input)) - (#Continue mod #.None))))]) + (All [a] (-> Nat (Transform a a))) + (loop [seen +0] + (function [input] + (let [mod (n/% nth (n/inc seen))] + (if (n/= +0 mod) + (#Continue (recur mod) (#.Some input)) + (#Continue (recur mod) #.None)))))) (def: #export (drop-nth nth) - (All [a] (-> Nat (Transform a a Nat))) - [+0 - (function [input seen] - (let [mod (n/% nth (n/inc seen))] - (if (n/= +0 mod) - (#Continue mod #.None) - (#Continue mod (#.Some input)))))]) + (All [a] (-> Nat (Transform a a))) + (loop [seen +0] + (function [input] + (let [mod (n/% nth (n/inc seen))] + (if (n/= +0 mod) + (#Continue (recur mod) #.None) + (#Continue (recur mod) (#.Some input))))))) (def: #export (distinct Hash<a>) - (All [a] (-> (Hash a) (Transform a a (Set a)))) - [(set.new Hash<a>) - (function [input seen] - (if (set.member? seen input) - (#Continue seen #.None) - (#Continue (set.add input seen) (#.Some input))))]) - + (All [a] (-> (Hash a) (Transform a a))) + (loop [seen (set.new Hash<a>)] + (function [input] + (if (set.member? seen input) + (#Continue (recur seen) #.None) + (#Continue (recur (set.add input seen)) (#.Some input)))))) + +## TODO: Remove whenever feasible. +(def: helper|de-duplicate + (All [a] (-> (Eq a) (Maybe a))) + (function [_] #.None)) (def: #export (de-duplicate Eq<a>) - (All [a] (-> (Eq a) (Transform a a (Maybe a)))) - [#.None - (function [input last] - (case last - (^multi (#.Some last') (:: Eq<a> = last' input)) - (#Continue last #.None) + (All [a] (-> (Eq a) (Transform a a))) + (loop [last (helper|de-duplicate Eq<a>)] + (function [input] + (case last + (^multi (#.Some last') (:: Eq<a> = last' input)) + (#Continue (recur last) #.None) - _ - (#Continue (#.Some input) (#.Some input))))]) + _ + (#Continue (recur (#.Some input)) (#.Some input)))))) (def: #export (random probability prng) - (All [a] (-> Deg PRNG (Transform a a PRNG))) - [prng - (function [input prng] - (let [[prng' chance] (r.run prng r.deg)] - (if (d/< probability chance) - (#Continue prng' (#.Some input)) - (#Continue prng' #.None))))]) + (All [a] (-> Deg PRNG (Transform a a))) + (loop [prng prng] + (function [input] + (let [[prng' chance] (r.run prng r.deg)] + (if (d/< probability chance) + (#Continue (recur prng') (#.Some input)) + (#Continue (recur prng') #.None)))))) (def: #export (replace dict) - (All [a] (-> (Dict a a) (Transform a a Unit))) - [[] - (function [input state] - (|> dict - (dict.get input) - (maybe.default input) - #.Some - (#Continue state)))]) + (All [a] (-> (Dict a a) (Transform a a))) + (function self [input] + (|> dict + (dict.get input) + (maybe.default input) + #.Some + (#Continue self)))) |