aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--stdlib/source/lux/control/transform.lux465
1 files changed, 0 insertions, 465 deletions
diff --git a/stdlib/source/lux/control/transform.lux b/stdlib/source/lux/control/transform.lux
deleted file mode 100644
index 7dbbaba60..000000000
--- a/stdlib/source/lux/control/transform.lux
+++ /dev/null
@@ -1,465 +0,0 @@
-(.module:
- lux
- (lux (control [eq #+ Eq]
- [hash #+ Hash]
- [functor #+ Functor]
- [applicative #+ Applicative]
- [monad #+ Monad]
- [comonad #+ CoMonad])
- (data [product]
- [maybe]
- (coll [set #+ Set]
- [dict #+ Dict]))
- [macro]
- (math ["r" random #+ PRNG])))
-
-## [Types]
-(type: #export (Producer p)
- (-> Unit (Maybe [p (Producer p)])))
-
-(type: #export (Consumer in out)
- [out (-> in (Maybe (Consumer in out)))])
-
-(type: #export (Transform in out)
- (-> in (Maybe [(Maybe out) (Transform in out)])))
-
-## [Primitives]
-(def: #export (compose prev next)
- (All [a b c]
- (-> (Transform a b) (Transform b c) (Transform a c)))
- (function [input]
- (case (prev input)
- (#.Some [(#.Some temp) prev'])
- (case (next temp)
- (#.Some [?output next'])
- (#.Some [?output (compose prev' next')])
-
- #.None
- #.None)
-
- (#.Some [#.None prev'])
- (#.Some [#.None (compose prev' next)])
-
- #.None
- #.None)))
-
-(def: #export (each left right)
- (All [a l r]
- (-> (Transform a l) (Transform a r) (Transform a [l r])))
- (function [input]
- (case [(left input)
- (right input)]
- [(#.Some [?output|left left'])
- (#.Some [?output|right right'])]
- (case [?output|left ?output|right]
- [(#.Some output|left) (#.Some output|right)]
- (#.Some [(#.Some [output|left output|right])
- (each left' right')])
-
- _
- (#.Some [#.None (each left' right')]))
-
- _
- #.None)))
-
-(def: #export (either left right)
- (All [a b]
- (-> (Transform a b) (Transform a b) (Transform a b)))
- (function [input]
- (case (left input)
- (#.Some [(#.Some output) left'])
- (#.Some [(#.Some output) (either left' right)])
-
- (^template [<case> <left-state> <done>]
- <case>
- (case (right input)
- (#.Some [(#.Some output) right'])
- (#.Some [(#.Some output) (either <left-state> right')])
-
- (#.Some [#.None right'])
- (#.Some [#.None (either <left-state> right')])
-
- #.None
- <done>))
- ([(#.Some [#.None left']) left' (#.Some [#.None (either left' right)])]
- [#.None left #.None])
- )))
-
-(def: #export (run transform producer consumer)
- (All [p cv cs]
- (-> (Transform p cv)
- (Producer p)
- (Consumer cv cs)
- cs))
- (loop [transform transform
- producer producer
- (^@ current-consumer [current-output consume]) consumer]
- ## TODO: Delete 'output' let-binding once new-luxc is the
- ## standard compiler.
- (let [output (case (producer [])
- (#.Some [production producer'])
- (case (transform production)
- (#.Some [(#.Some temp) transform'])
- (case (consume temp)
- (#.Some consumer')
- (recur transform' producer' consumer')
-
- #.None
- current-output)
-
- (#.Some [#.None transform'])
- (recur transform' producer' current-consumer)
-
- #.None
- current-output)
-
- #.None
- current-output)]
- output)))
-
-## [Producers]
-(def: #export (list-producer source)
- (All [a] (-> (List a) (Producer a)))
- (loop [remaining source]
- (function [_]
- (case remaining
- (#.Cons head tail)
- (#.Some [head (recur tail)])
-
- #.Nil
- #.None))))
-
-## [Consumers]
-(def: #export (list-consumer sink)
- (All [a] (-> (List a) (Consumer a (List a))))
- [sink
- (loop [tail sink]
- (function [head]
- (let [partial (#.Cons head tail)]
- (#.Some [partial (recur partial)]))))])
-
-## [Transforms]
-(def: #export (map f)
- (All [a b] (-> (-> a b) (Transform a b)))
- (function self [input]
- (#.Some [(#.Some (f input)) self])))
-
-(def: #export (map-indexed f)
- (All [a b] (-> (-> Nat a b) (Transform a b)))
- (loop [index +0]
- (function [input]
- (#.Some [(#.Some (f index input)) (recur (n/inc index))]))))
-
-(def: #export (filter pred)
- (All [a] (-> (-> a Bool) (Transform a a)))
- (function self [input]
- (#.Some [(if (pred input)
- (#.Some input)
- #.None)
- self])))
-
-(def: #export (keep f)
- (All [a b] (-> (-> a (Maybe b)) (Transform a b)))
- (function self [input]
- (#.Some [(f input) self])))
-
-(def: #export (keep-indexed f)
- (All [a b] (-> (-> Nat a (Maybe b)) (Transform a b)))
- (loop [index +0]
- (function [input]
- (#.Some [(f index input) (recur (n/inc index))]))))
-
-(def: #export (take amount)
- (All [a] (-> Nat (Transform a a)))
- (loop [remaining amount]
- (function [input]
- (if (n/= +0 remaining)
- #.None
- (#.Some [(#.Some input) (recur (n/dec remaining))])))))
-
-(def: #export (drop amount)
- (All [a] (-> Nat (Transform a a)))
- (loop [remaining amount]
- (function [input]
- (if (n/= +0 remaining)
- (#.Some [(#.Some input) (recur remaining)])
- (#.Some [#.None (recur (n/dec remaining))])))))
-
-(def: #export (take-while pred)
- (All [a] (-> (-> a Bool) (Transform a a)))
- (function self [input]
- (if (pred input)
- (#.Some [(#.Some input) self])
- #.None)))
-
-(def: #export (drop-while pred)
- (All [a] (-> (-> a Bool) (Transform a a)))
- (loop [dropping? true]
- (function [input]
- (if (and dropping?
- (pred input))
- (#.Some [#.None (recur true)])
- (#.Some [(#.Some input) (recur false)])))))
-
-(def: #export (take-nth nth)
- (All [a] (-> Nat (Transform a a)))
- (loop [seen +0]
- (function [input]
- (let [mod (n/% nth (n/inc seen))]
- (if (n/= +0 mod)
- (#.Some [(#.Some input) (recur mod)])
- (#.Some [#.None (recur mod)]))))))
-
-(def: #export (drop-nth nth)
- (All [a] (-> Nat (Transform a a)))
- (loop [seen +0]
- (function [input]
- (let [mod (n/% nth (n/inc seen))]
- (if (n/= +0 mod)
- (#.Some [#.None (recur mod)])
- (#.Some [(#.Some input) (recur mod)]))))))
-
-(def: #export (distinct Hash<a>)
- (All [a] (-> (Hash a) (Transform a a)))
- (loop [seen (set.new Hash<a>)]
- (function [input]
- (if (set.member? seen input)
- (#.Some [#.None (recur seen)])
- (#.Some [(#.Some input) (recur (set.add input seen))])))))
-
-## 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)))
- (loop [last (helper|de-duplicate Eq<a>)]
- (function [input]
- (case last
- (^multi (#.Some last') (:: Eq<a> = last' input))
- (#.Some [#.None (recur last)])
-
- _
- (#.Some [(#.Some input) (recur (#.Some input))])))))
-
-(def: #export (random probability prng)
- (All [a] (-> Deg PRNG (Transform a a)))
- (loop [prng prng]
- (function [input]
- (let [[prng' chance] (r.run prng r.deg)]
- (if (d/< probability chance)
- (#.Some [(#.Some input) (recur prng')])
- (#.Some [#.None (recur prng')]))))))
-
-(def: #export (replace dict)
- (All [a] (-> (Dict a a) (Transform a a)))
- (function self [input]
- (#.Some [(|> dict
- (dict.get input)
- (maybe.default input)
- #.Some)
- self])))
-
-(struct: #export _ (Functor Producer)
- (def: (map f)
- (function recur [fa]
- (function [tick]
- (case (fa tick)
- #.None
- #.None
-
- (#.Some [value fa'])
- (#.Some [(f value) (recur fa')]))))))
-
-(struct: #export _ (Applicative Producer)
- (def: functor Functor<Producer>)
-
- (def: (wrap value)
- (function [tick]
- (#.Some [value (function [_] #.None)])))
-
- (def: (apply ff fa)
- (function [tick]
- (case [(ff tick) (fa tick)]
- [(#.Some [f ff']) (#.Some [a fa'])]
- (#.Some [(f a) (apply ff' fa')])
-
- _
- #.None))))
-
-## TODO: Remove whenever feasible.
-(def: helper|producer/join
- (All [a] (-> (Producer (Producer a)) (Maybe (Producer a))))
- (function [_] #.None))
-(struct: #export _ (Monad Producer)
- (def: applicative Applicative<Producer>)
-
- (def: (join ffa)
- (loop [?current (helper|producer/join ffa)
- factory ffa]
- (function [tick]
- (case ?current
- (#.Some current)
- (case (current tick)
- #.None
- ((recur #.None factory) tick)
-
- (#.Some [production current'])
- (#.Some [production (recur (#.Some current') factory)]))
-
- #.None
- (case (factory tick)
- (#.Some [next factory'])
- ((recur (#.Some next) factory') tick)
-
- _
- #.None))))))
-
-(struct: #export Functor<Transform>
- (All [in] (Functor (Transform in)))
-
- (def: (map f)
- (function recur [fa]
- (function [input]
- (case (fa input)
- (#.Some [?output fa'])
- (#.Some [(:: maybe.Functor<Maybe> map f ?output)
- (recur fa')])
-
- #.None
- #.None)))))
-
-(struct: #export Applicative<Transform>
- (All [in] (Applicative (Transform in)))
-
- (def: functor Functor<Transform>)
-
- (def: (wrap value)
- (function [input]
- (#.Some [(#.Some value)
- (function [_] #.None)])))
-
- (def: (apply ff fa)
- ## TODO: Replace the code below with this commented snippet, once
- ## new-luxc becomes the standard Lux compiler.
- ## (compose (each ff fa)
- ## (map (function [[f a]] (f a))))
- (loop [ff&fa (each ff fa)]
- (function [input]
- (case (ff&fa input)
- (#.Some [?f&a ff&fa'])
- (#.Some [(:: maybe.Functor<Maybe> map (function [[f a]] (f a)) ?f&a)
- (recur ff&fa')])
-
- #.None
- #.None)))
- ))
-
-## TODO: Remove whenever feasible.
-(def: helper|transform/join
- (All [in out]
- (-> (Transform in (Transform in out))
- (Maybe (Transform in out))))
- (function [_] #.None))
-(struct: #export Monad<Transform>
- (All [in] (Monad (Transform in)))
-
- (def: applicative Applicative<Transform>)
-
- (def: (join ffa)
- (loop [?current (helper|transform/join ffa)
- factory ffa]
- (function [input]
- (case ?current
- (#.Some current)
- (case (current input)
- #.None
- ((recur #.None factory) input)
-
- (#.Some [?output current'])
- (#.Some [?output
- (recur (#.Some current') factory)]))
-
- #.None
- (case (factory input)
- (#.Some [?next factory'])
- ((recur ?next factory') input)
-
- #.None
- #.None))))))
-
-## (type: #export (Consumer in out)
-## [out (-> in (Either out
-## (Consumer in out)))])
-
-(struct: #export Functor<Consumer>
- (All [in] (Functor (Consumer in)))
-
- (def: (map f)
- (function recur [[a fa]]
- [(f a)
- (function [input]
- (case (fa input)
- #.None
- #.None
-
- (#.Some next)
- (#.Some (recur next))))])))
-
-(struct: #export Applicative<Consumer>
- (All [in] (Applicative (Consumer in)))
-
- (def: functor Functor<Consumer>)
-
- (def: (wrap value)
- [value (function [input] #.None)])
-
- (def: (apply [f ff] [a fa])
- (let [partial (f a)]
- [partial
- (function [input]
- (case [(ff input) (fa input)]
- [(#.Some ff+') (#.Some fa+')]
- (#.Some (apply ff+' fa+'))
-
- _
- #.None))])))
-
-(struct: #export Monad<Consumer>
- (All [in] (Monad (Consumer in)))
-
- (def: applicative Applicative<Consumer>)
-
- (def: (join [current factory])
- (let [[output|current consumer|current] current]
- [output|current
- (function [input]
- (case (consumer|current input)
- #.None
- (case (factory input)
- (#.Some next+factory')
- (#.Some (join next+factory'))
-
- #.None
- #.None)
-
- (#.Some current')
- (#.Some (join [current' factory]))))])))
-
-(struct: #export CoMonad<Consumer>
- (All [in] (CoMonad (Consumer in)))
-
- (def: functor Functor<Consumer>)
-
- (def: (unwrap [output step])
- output)
-
- (def: (split consumer)
- [consumer (function [input]
- (let [[output step] consumer]
- (case (step input)
- #.None
- #.None
-
- (#.Some next)
- (#.Some (split next)))))]))