[Haskell-cafe] Re: questions about Arrows
Maciej Piechotka
uzytkownik2 at gmail.com
Wed Sep 1 03:33:12 EDT 2010
On Tue, 2010-08-31 at 20:39 -0700, Ben wrote:
> Hello --
>
> Three related questions, going from most specific to most general :
>
> 1 ) Consider the stream processing arrow which computes a running sum,
> with two implementations : first using generic ArrowCircuits (rSum);
> second using Automaton (rSum2) :
>
> module Foo where
>
> import Control.Arrow
> import Control.Arrow.Operations
> import Control.Arrow.Transformer
> import Control.Arrow.Transformer.All
>
> rSum :: ArrowCircuit a => a Int Int
> rSum = proc x -> do
> rec out <- delay 0 -< out + x
> returnA -< out
>
> rSum2 = Automaton (f 0)
> where f s n = let s' = s + n
> in (s', Automaton (f s'))
>
> runAuto _ [] = []
> runAuto (Automaton f) (x:xs) =
> let (y, a) = f x
> in y : runAuto a xs
>
> take 10 $ runAuto rSum [1..]
> [0,1,3,6,10,15,21,28,36,45]
>
> take 10 $ runAuto rSum2 [1..]
> [1,3,6,10,15,21,28,36,45,55]
>
> Note that the circuit version starts with the initial value zero.
>
> Is there a way to write rSum2 in the general ArrowCircuit form, or
> using ArrowLoop?
>
rSum2 :: ArrowCircuit a => a Int Int
rSum2 = proc x -> do
rec out <- delay 0 -< out + x
returnA -< out + x
> 2) Are the ArrowLoop instances for (->), Kleisli Identity, and
> Kleisli ((->) r) all morally equivalent? (e.g., up to tagging and untagging?)
>
Yes
> 3) One can define fix in terms of trace and trace in terms of fix.
>
> trace f x = fst $ fix (\(m, z) -> f (x, z))
> fix f = trace (\(x, y) -> (f y, f y)) undefined
>
> Does this mean we can translate arbitrary recursive functions into
> ArrowLoop equivalents?
>
Yes. In fact fix is used on functional languages that do not support
recursion to have recursion (or so I heard)
> Best regards, Ben
Regards
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 836 bytes
Desc: This is a digitally signed message part
Url : http://www.haskell.org/pipermail/haskell-cafe/attachments/20100901/4c238fc7/attachment.bin
More information about the Haskell-Cafe
mailing list