Let's begin by using Vectors instead of Lists.

# Full implementation (also, an instance of Num to ease testing)

``` active haskell
{-# 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.