[Haskell-cafe] Type classes: Missing language feature?

DavidA polyomino at f2s.com
Tue Aug 7 08:58:17 EDT 2007


Hi, there's something I'm trying to do with type classes that seems to fit very 
naturally with my mental model of type classes, but doesn't seem to be 
supported by the language. I'm wondering whether I'm missing something, or 
whether there's some language extension that could help me or alternative way 
of achieving what I'm trying to achieve.

I'm trying to define multivariate polynomials, which are sums of monomials - 
for example x^2y + z^4. In algorithms on multivariate polynomials, one 
typically wants to support different monomial orders. For example, the lex 
order is dictionary order - xxy < xy < y < yyy - whereas the graded lex (glex) 
order also takes into account the degree of the monomials - y < xy < xxy < yyy.

Here's some code (based on http://sigfpe.blogspot.com/2007/07/ill-have-
buchburger-with-fries.html):

import Data.Map as M
import Data.List as L

newtype Monomial = Monomial (Map String Int) deriving (Eq)
x = Monomial $ singleton "x" 1
y = Monomial $ singleton "y" 1
instance Show Monomial where
    show (Monomial a) = concatMap (\(v,i)-> v ++ "^" ++ show i) $ toList a -- 
simplified for brevity
instance Num Monomial where
    Monomial a * Monomial b = Monomial $ unionWith (+) a b

newtype Lex = Lex Monomial deriving (Eq)
newtype Glex = Glex Monomial deriving (Eq)

instance Ord Lex where
    Lex (Monomial m) <= Lex (Monomial m') = toList m <= toList m'

instance Ord Glex where
    Glex (Monomial m) <= Glex (Monomial m') = (sum $ elems m, toList m) <= (sum 
$ elems m', toList m')

Now, what I'd like to do is have Lex and Glex, and any further monomial 
orderings I define later, automatically derive Show and Num instances from 
Monomial (because it seems like boilerplate to have to define Show and Num 
instances by hand). Something like the following (not valid Haskell):

class OrdMonomial m where
    fromRaw :: Monomial -> m
    toRaw :: m -> Monomial

instance OrdMonomial Lex where
    fromRaw m = Lex m
    toRaw (Lex m) = m

instance OrdMonomial Glex where
    fromRaw m = Glex m
    toRaw (Glex m) = m

derive OrdMonomial m => Show m where
    show m = show (toRaw m)

derive OrdMonomial m => Num m where
    m * m' = fromRaw (toRaw m * toRaw m')

Is there a way to do what I'm trying to do? (Preferably without resorting to 
template Haskell, etc) - It seems like a natural thing to want to do.



More information about the Haskell-Cafe mailing list