aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/transform.lux336
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))))