[Haskell-cafe] WG:
Matt
parsonsmatt at gmail.com
Thu Aug 16 05:03:13 UTC 2018
It is a type level operator. You can parameterize things by it:
type Foo f = f Int String
foo :: Foo (->)
foo = show
-- Write instances for it:
class Profunctor p where
dimap :: (a -> b) -> (c -> d) -> p b c -> p a d
instance Profunctor (->) where
dimap ab cd bc = cd . bc . ab
-- Define aliases for it:
type Func a b = a -> b
map :: Func a b -> [a] -> [b]
-- or even,
map :: Func a b -> Func [a] [b]
-- Use it prefix
dropWhile :: ((->) a Bool) -> [a] -> [a]
-- Partially apply it:
instance MonadReader r ((->) r) where
ask = id
Matt Parsons
On Wed, Aug 15, 2018 at 10:53 PM, Paul <aquagnu at gmail.com> wrote:
> Hmm, very interesting question, really: what is the "->" in functions
> signatures: type-level operator or syntax only?
>
>
>
> 16.08.2018 01:20, Massimo Zaniboni wrote:
>
>> Il 15/08/2018 23:06, Stefan Chacko ha scritto:
>>
>> 3. Why do we use clinches in such definitions. I concluded you need
>>> clinches if a function is not associative
>>> such as (a-b)+c . (Int->Int)->Int->Int
>>>
>>> But also if a higher order function needs more than one argument.
>>> (a->b)->c .
>>>
>>> Can you please explain it ?
>>>
>>
>> funXYZ :: Int -> Int -> Int -> Int
>> funXYZ x y z = (x - y) + z
>>
>> if you rewrite in pure lamdda-calculus, without any syntax-sugars it
>> became
>>
>> fun_XYZ :: (Int -> (Int -> (Int -> Int)))
>> fun_XYZ = \x -> \y -> \z -> (x - y) + z
>>
>> so fun_XYZ is a function `\x -> ...` that accepts x, and return a
>> function, that accepts a parameter y, and return a function, etc...
>>
>> You can also rewrite as:
>>
>> funX_YZ :: Int -> (Int -> (Int -> Int))
>> funX_YZ x = \y -> \z -> (x - y) + z
>>
>> or
>>
>> funXY_Z :: Int -> Int -> (Int -> Int)
>> funXY_Z x y = \z -> (x - y) + z
>>
>> and finally again in the original
>>
>> funXYZ_ :: Int -> Int -> Int -> Int
>> funXYZ_ x y z = (x - y) + z
>>
>> I used different names only for clarity, but they are the same exact
>> function in Haskell.
>>
>> In lambda-calculus the form
>>
>> \x y z -> (x - y) + z
>>
>> is syntax sugar for
>>
>> \x -> \y -> \z -> (x - y) + z
>>
>> On the contrary (as Francesco said)
>>
>> (Int -> Int) -> Int -> Int
>>
>> is a completely different type respect
>>
>> Int -> Int -> Int -> Int
>>
>> In particular a function like
>>
>> gHX :: (Int -> Int) -> Int -> Int
>> gHX h x = h x
>>
>> has 2 parameters, and not 3. The first parameter has type (Int -> Int),
>> the second type Int, and then it returns an Int. Equivalent forms are:
>>
>> g_HX :: (Int -> (Int -> Int))
>> g_HX = \h -> \x -> h x
>>
>> gH_X :: (Int -> Int) -> (Int -> Int)
>> gH_X h = \x -> h x
>>
>> gHX :: (Int -> Int) -> Int -> Int
>> gHX_ h x = h x
>>
>>
>> IMHO it is similar to logic: intuitively it seems easy and natural, but
>> if you reflect too much, it is not easy anymore... but after you
>> internalize some rules, it is easy and natural again.
>>
>> Regards,
>> Massimo
>> _______________________________________________
>> Haskell-Cafe mailing list
>> To (un)subscribe, modify options or view archives go to:
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>> Only members subscribed via the mailman list are allowed to post.
>>
>
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20180815/f357ba3b/attachment.html>
More information about the Haskell-Cafe
mailing list