[Haskell-cafe] using "default" declaration for overloaded numeric operations
TP
paratribulations at free.fr
Sat Sep 21 12:29:04 CEST 2013
Hi,
I try to develop an embedded domain specific language in Haskell.
I don't want to type "::Rational" all the time, so I try to use a default
declaration for my types.
This works correctly in this simple example:
------------------------------------------
default (Integer, Double) -- "default default"
mag :: Float -> Float -> Float
mag x y = sqrt( x^2 + y^2 )
main = do
print $ mag 1 1
------------------------------------------
Indeed we obtain sqrt(2) as a result. If we replace the default declaration
by:
default ()
, we obtain errors at compilation as expected: the type of `2` is ambiguous.
Now let us consider a more complicated example:
------------------------------------------
{-# LANGUAGE FlexibleInstances #-}
import Prelude hiding ((^^))
import Data.Ratio
default (Integer, Rational, Double)
class (Num a) => Foo a where
(^^) :: Num b => b -> a -> b
instance Foo Rational where
(^^) x r = x ^ n
where n = 2*numerator r -- dummy calculation
instance Foo Integer where
(^^) x n = x ^ n
mag :: Float -> Float -> Float
mag x y = sqrt( x ^^ 2 + y ^^ 2 )
main = do
print $ mag 1 1
------------------------------------------
I would expect it to work correctly, but we obtain errors concerning the
ambiguous type of `2`.
Why?
How to make my default declaration work?
And if I want to give the priority to `Rational` instead of `Integer`?
Indeed, this should be possible because we don't get any error below.
$ ghci
> import Data.Ratio
> 2::Rational
2 % 1
Thanks in advance,
TP
More information about the Haskell-Cafe
mailing list