diff options
Diffstat (limited to 'testsuite/tests/printer/Ppr002a.hs')
-rw-r--r-- | testsuite/tests/printer/Ppr002a.hs | 45 |
1 files changed, 45 insertions, 0 deletions
diff --git a/testsuite/tests/printer/Ppr002a.hs b/testsuite/tests/printer/Ppr002a.hs new file mode 100644 index 0000000000..d8007d1632 --- /dev/null +++ b/testsuite/tests/printer/Ppr002a.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE Arrows #-} + +import Control.Arrow +import qualified Control.Category as Cat + +addA :: Arrow a => a b Int -> a b Int -> a b Int +addA f g = proc x -> do + y <- f -< x + z <- g -< x + returnA -< y + z + +newtype Circuit a b = Circuit { unCircuit :: a -> (Circuit a b, b) } + +instance Cat.Category Circuit where + id = Circuit $ \a -> (Cat.id, a) + (.) = dot + where + (Circuit cir2) `dot` (Circuit cir1) = Circuit $ \a -> + let (cir1', b) = cir1 a + (cir2', c) = cir2 b + in (cir2' `dot` cir1', c) + +instance Arrow Circuit where + arr f = Circuit $ \a -> (arr f, f a) + first (Circuit cir) = Circuit $ \(b, d) -> + let (cir', c) = cir b + in (first cir', (c, d)) + +-- | Accumulator that outputs a value determined by the supplied function. +accum :: acc -> (a -> acc -> (b, acc)) -> Circuit a b +accum acc f = Circuit $ \input -> + let (output, acc') = input `f` acc + in (accum acc' f, output) + +-- | Accumulator that outputs the accumulator value. +accum' :: b -> (a -> b -> b) -> Circuit a b +accum' acc f = accum acc (\a b -> let b' = a `f` b in (b', b')) + +total :: Num a => Circuit a a +total = accum' 0 (+) + +mean3 :: Fractional a => Circuit a a +mean3 = proc value -> do + (t, n) <- (| (&&&) (total -< value) (total -< 1) |) + returnA -< t / n |