[Haskell-cafe] Type signature for function where function parameter is used twice?
Ivan Lazar Miljenovic
ivan.miljenovic at gmail.com
Sun Jul 19 09:02:34 UTC 2015
On 19 July 2015 at 18:52, Tony Morris <tonymorris at gmail.com> wrote:
> FYI
>
> f x = g x x
>
> can be written:
>
> f = join g
In this case it can't be, as Clinton has defined a new join function.
>
>
> On 19/07/15 18:51, Clinton Mead wrote:
>> I guess my question is, how to I type LHS so it is no more specialised
>> as RHS in this case?
>>
>> On Sun, Jul 19, 2015 at 6:42 PM, Ivan Lazar Miljenovic
>> <ivan.miljenovic at gmail.com <mailto:ivan.miljenovic at gmail.com>> wrote:
>>
>> My understanding is that when you have "LHS = RHS", you can replace
>> any instance of LHS with RHS but you can't always do it the other way
>> around, as the LHS might be more specialised (as in this case it is).
>>
>> On 19 July 2015 at 18:08, Clinton Mead <clintonmead at gmail.com
>> <mailto:clintonmead at gmail.com>> wrote:
>> > Thanks for the CC Ivan, forgot to "reply all".
>> >
>> > I guess I want the passed argument to stay polymorphic long enough to be
>> > instanced inside the call.
>> >
>> > Surely if "f x = g x x" then you should somehow be able to replace "g x x"
>> > with "f x"?! That's basically what I'm getting at.
>> >
>> >
>> >
>> > On Sun, Jul 19, 2015 at 5:54 PM, Ivan Lazar Miljenovic
>> > <ivan.miljenovic at gmail.com <mailto:ivan.miljenovic at gmail.com>> wrote:
>> >>
>> >> (Re-CC'ing Cafe)
>> >>
>> >> I think what's happening here is that when you do "apply f1 f1", the
>> >> two c's and d's don't actually match with each other.
>> >>
>> >> But when you do it with applyBoth, they *have* to match each other.
>> >>
>> >> As a comparison, compare:
>> >>
>> >> :t (read, read)
>> >> (read, read) :: (Read a, Read a1) => (String -> a, String -> a1)
>> >>
>> >> and
>> >>
>> >> :t Control.Monad.join read
>> >> Control.Monad.join (,) read :: Read a => (String -> a, String -> a)
>> >>
>> >> I'm not sure how you could define such a function to do what you're
>> >> requesting; my attempt is this:
>> >>
>> >> applyBoth :: (forall a b a2 b2. arr a b -> arr a2 b2) -> D arr a b ->
>> >> D arr a2 b2
>> >> applyBoth f = apply f f
>> >>
>> >> but whilst ghci accepts it, I couldn't actually seem to use it (lots
>> >> of errors about being unable to match types).
>> >>
>> >> On 19 July 2015 at 17:15, Clinton Mead <clintonmead at gmail.com <mailto:clintonmead at gmail.com>> wrote:
>> >> > Thanks for your reply Ivan
>> >> >
>> >> > Here's a full code example ( http://ideone.com/1K3Yhw ):
>> >>
>> >> >
>> >> > ---
>> >> >
>> >> > data D c a b = D (c a b) (c b a)
>> >> >
>> >> > apply :: (c a b -> c a2 b2) -> (c b a -> c b2 a2) -> D c a b ->
>> D c a2
>> >> > b2
>> >> > apply f1 f2 (D x y) = D (f1 x) (f2 y)
>> >> >
>> >> > applyBoth f = apply f f
>> >> >
>> >> > f :: Int -> String
>> >> > f = show
>> >> >
>> >> > g :: String -> Int
>> >> > g = read
>> >> >
>> >> > h :: Int -> Int
>> >> > h = (*2)
>> >> >
>> >> > join :: (a -> b) -> (c -> d) -> ((a, c) -> (b, d))
>> >> > join f g (x, y) = (f x, g y)
>> >> >
>> >> > x1 = D f g
>> >> >
>> >> > f1 = join h
>> >> >
>> >> > y1 = apply f1 f1 x1 -- This compiles
>> >> > y2 = apply g g x1 where g = f1 -- Also works
>> >> >
>> >> > z1 = applyBoth f1 x1 -- This fails
>> >> >
>> >> > main = return ()
>> >> >
>> >> > ---
>> >> >
>> >> > You see, with "y1" and "y2", a different "f1" instantiation (is
>> that the
>> >> > right word) of "f1" is chosen. Even when I let "g = f1", each
>> "g" passed
>> >> > to
>> >> > apply is different, the first operates on "Int -> String", the
>> second,
>> >> > "String -> Int".
>> >> >
>> >> > On the face of it, if:
>> >> >
>> >> > f x = g x x
>> >> >
>> >> > Then well, you should be able to replace "g x x" with "f x"
>> wherever you
>> >> > see
>> >> > it.
>> >> >
>> >> > But it seems in this case this doesn't work. Surely Haskell doesn't
>> >> > require
>> >> > me to "repeat myself", and there's a way to write "applyBoth",
>> instead
>> >> > of
>> >> > having to write "apply f f" (note the repetition of f) all the
>> time?
>> >> >
>> >> > I assume there's some type signature I can give "applyBoth f"
>> so it can
>> >> > be
>> >> > used just like "apply f f" but I can't work out what it is.
>> >> >
>> >> > On Sun, Jul 19, 2015 at 10:23 AM, Ivan Lazar Miljenovic
>> >> > <ivan.miljenovic at gmail.com <mailto:ivan.miljenovic at gmail.com>>
>> wrote:
>> >>
>> >> >>
>> >> >> On 19 July 2015 at 10:13, Clinton Mead <clintonmead at gmail.com
>> <mailto:clintonmead at gmail.com>> wrote:
>> >> >> > Lets say I've got the following data type:
>> >> >> >
>> >> >> > data D c a b = D (c a b) (c b a)
>> >> >> >
>> >> >> > And I define a function to manipulate it:
>> >> >> >
>> >> >> > apply :: (c a b -> c a2 b2) -> (c b a -> c b2 a2) -> D c a b
>> -> D c
>> >> >> > a2
>> >> >> > b2
>> >> >> > apply f1 f2 (D x y) = D (f1 x) (f2 y)
>> >> >> >
>> >> >> > This is all fine. But I want a shorter function if (f1 =
>> f2). So I
>> >> >> > write:
>> >> >> >
>> >> >> > applyBoth f = apply f f
>> >> >> >
>> >> >> > I originally thought that if "apply f f" is valid, then
>> logically
>> >> >> > "applyBoth
>> >> >> > f" should also be valid. But it seems that type inference
>> results in
>> >> >> > applyBoth only working for functions "c a a -> c a2 a2".
>> >> >>
>> >> >> applyBoth f = apply f f
>> >> >>
>> >> >> In apply, (f1 :: c a b -> c a2 b2) and (f2 :: c b a -> c b2 a2).
>> >> >>
>> >> >> So for "apply f f" to typecheck, we must have that a ~ b and
>> a2 ~ b2
>> >> >> (as the above two type signatures must match since f1 = f2).
>> >> >>
>> >> >> So we must have that (f :: c a a -> c a2 a2).
>> >> >>
>> >> >> >
>> >> >> > Is there a way to type "applyBoth" so it works for all
>> functions that
>> >> >> > would
>> >> >> > work simply by repeating them twice in "apply"?
>> >> >>
>> >> >> I'm not sure what you mean; what else would make sense? Can you
>> >> >> provide an example?
>> >> >>
>> >> >> --
>> >> >> Ivan Lazar Miljenovic
>> >> >> Ivan.Miljenovic at gmail.com <mailto:Ivan.Miljenovic at gmail.com>
>> >> >> http://IvanMiljenovic.wordpress.com
>> >> >
>> >> >
>> >>
>> >>
>> >>
>> >> --
>> >> Ivan Lazar Miljenovic
>> >> Ivan.Miljenovic at gmail.com <mailto:Ivan.Miljenovic at gmail.com>
>> >> http://IvanMiljenovic.wordpress.com
>> >
>> >
>>
>>
>>
>> --
>> Ivan Lazar Miljenovic
>> Ivan.Miljenovic at gmail.com <mailto:Ivan.Miljenovic at gmail.com>
>> http://IvanMiljenovic.wordpress.com
>>
>>
>>
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
--
Ivan Lazar Miljenovic
Ivan.Miljenovic at gmail.com
http://IvanMiljenovic.wordpress.com
More information about the Haskell-Cafe
mailing list