Let's begin by using Vectors instead of Lists.
Full implementation (also, an instance of Num to ease testing)
{-# LANGUAGE MonadComprehensions #-}
import Prelude hiding (map, (++), filter, null, head, tail, sum)
import Data.Monoid
import Data.Vector hiding (accum)
import Data.Function
import qualified Data.Vector.Fusion.Stream as Stream
import qualified Data.Vector.Generic as Gen
mySum :: (Gen.Vector v a, Monoid a) => v a -> a
{-# INLINE mySum #-}
mySum = Stream.foldl' mappend mempty . Gen.stream
newtype GA k a = GA (Vector (k,a)) deriving (Show, Eq)
class Monoid s => SimpleAlgebra s where
(<*>) :: s -> s -> s
isZero x = x == mempty
clean :: (Eq k, Monoid k) => GA k a -> GA k a
clean (GA list) = GA $ filter (not . isZero . fst) list
clean' (GA list) = GA $ filter ((/= 0) . fst) list
regroupWith f v | null v = empty
| otherwise = let
x = head v
xs = tail v
(likeX, unlikeX) = unstablePartition (((==) `on` snd) x) xs
in (f $ fst x `cons` map fst likeX, snd x) `cons` regroupWith f unlikeX
accum list = regroupWith mySum list
accum' list = regroupWith sum list
regroup list = regroupWith id list
instance (Monoid a, Eq a, SimpleAlgebra k, Eq k) => Monoid (GA k a) where
mempty = GA empty
(GA list1) `mappend` (GA list2) = clean $ GA $ accum (list1 ++ list2)
instance (Monoid a, Eq a, SimpleAlgebra k, Eq k) => SimpleAlgebra (GA k a) where
(GA list1) <*> (GA list2) = clean $ GA $ accum [(k1 <*> k2, a1 <> a2) | (k1,a1) <- list1, (k2,a2) <- list2]
instance (Monoid a, Eq a, Num k, Eq k) => Num (GA k a) where
fromInteger n = let nK = fromInteger n
in if (nK == 0)
then GA empty
else GA $ singleton (nK, mempty)
(GA list1) + (GA list2) = clean' $ GA $ accum' (list1 ++ list2)
(GA list1) * (GA list2) = clean' $ GA $ accum' [(k1 * k2, a1 <> a2) | (k1,a1) <- list1, (k2,a2) <- list2]
negate (GA list) = GA $ map (\(k,a) -> (negate k, a)) list
main = do print $ GA (singleton (-2,Sum 3)) + GA (singleton (1, Sum 2))
print $ GA (singleton (-2,Sum 3)) * GA (singleton (1, Sum 2))
print $ GA (singleton (-2,Sum 3)) + GA (singleton (1, Sum 3))
print $ GA (singleton (-2,Sum 3)) + GA (singleton (0, Sum 2))
We are basically done. Leave me some feedback if you want me to implement something else.