[Haskell-cafe] is there something special about the Num instance?

Anatoly Yakovenko aeyakovenko at gmail.com
Wed Dec 3 19:08:47 EST 2008


Thanks for your help.

On Wed, Dec 3, 2008 at 3:47 PM, Ryan Ingram <ryani.spam at gmail.com> wrote:
> Yes; I had a similar question, and it turns out Num is special, or
> rather, pattern matching on integer literals is special.  See the
> thread
>
> http://www.nabble.com/Pattern-matching-on-numbers--td20571034.html
>
> The summary is that pattern matching on a literal integer is different
> than a regular pattern match; in particular:
>
>> foo 1 = print "one"
>> foo _ = print "not one"
>
> turns into
>
>> foo x = if x == fromInteger 1 then "one" else "not one"
>
> whereas
>
>> bar Test = print "Test"
>> bar _ = print "Not Test"
>
> turns into
>
>> bar x = case x of { Test -> print "Test" ; _ -> print "Not Test" }
>
> In the former case, the use of (y == fromInteger 1) means that "foo"
> works on any argument within the class Num (which requires Eq),
> whereas in the latter case, the use of the constructor Test directly
> turns into a requirement for a particular type for "bar".
>
> There's no way to get special pattern matching behavior for other
> types; this overloading is specific to integer literals.
>
>  -- ryan
>
> On Wed, Dec 3, 2008 at 3:05 PM, Anatoly Yakovenko <aeyakovenko at gmail.com> wrote:
>> module Test where
>> --why does this work:
>> data Test = Test
>>
>> class Foo t where
>>   foo :: Num v => t -> v -> IO ()
>>
>> instance Foo Test where
>>   foo _ 1 = print $ "one"
>>   foo _ _ = print $ "not one"
>>
>> --but this doesn't?
>>
>> class Bar t where
>>   bar :: Foo v => t -> v -> IO ()
>>
>> instance Bar Test where
>>   bar _ Test = print $ "test"
>>   bar _ _ = print $ "not test"
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>


More information about the Haskell-Cafe mailing list