[Doesn't quite work
Samuel Bronson <naesten@gmail.com>**20080315202515] hunk ./FrontEnd/Class.hs 6
+    isClassRecord,
+    isClassAliasRecord,
hunk ./FrontEnd/Class.hs 89
-                                      classScatterMap :: Map.Map Class [Name]
+                                      classMethodMap :: Map.Map Name Class  
hunk ./FrontEnd/Class.hs 121
-    classScatterMap = classScatterMap cra
+    classMethodMap = classMethodMap cra
hunk ./FrontEnd/Class.hs 330
-instanceToTopDecls kt (ClassHierarchy classHierarchy) (HsInstDecl _ qualType methods)
-    = unzip $ map (methodToTopDecls kt [] crecord qualType) $ methodGroups where
+instanceToTopDecls kt ch@(ClassHierarchy classHierarchy) (HsInstDecl _ qualType methods)
+    = unzip $ map (methodToTopDecls ch kt [] crecord qualType) $ methodGroups where
hunk ./FrontEnd/Class.hs 339
-instanceToTopDecls kt (ClassHierarchy classHierarchy) (HsClassDecl _ qualType methods)
+instanceToTopDecls kt ch@(ClassHierarchy classHierarchy) (HsClassDecl _ qualType methods)
hunk ./FrontEnd/Class.hs 346
-instanceToTopDecls kt (ClassHierarchy classHierarchy) cad@(HsClassAliasDecl {})
-    = error ("instanceToTopDecls: "++show cad)
+
+instanceToTopDecls kt ch@(ClassHierarchy classHierarchy) cad@(HsClassAliasDecl {})
+   = unzip $ map (aliasDefaultMethodToTopDecls kt methodSigs aliasName) $ methodGroups where
+   aliasName = toName ClassName (hsDeclName cad)
+   methodGroups = groupEquations (filter (\x -> isHsPatBind x || isHsFunBind x) (hsDeclDecls cad))
+   methodSigs = case Map.lookup aliasName classHierarchy  of
+           Nothing -> error $ "aliasDefaultInstanceToTopDecls: could not find class "
+                              ++ show aliasName ++ "in class hierarchy"
+           Just sigs -> concatMap (classAssumps . findClassRecord ch) (classClasses sigs)
+
hunk ./FrontEnd/Class.hs 363
-aliasDefaultInstanceName n ca = toName Val $ Qual (Module "Instance@") $ HsIdent ('i':show n ++ ".default." ++ ca)
+aliasDefaultInstanceName :: Name -> Class -> Name
+aliasDefaultInstanceName n ca = toName Val $ Qual (Module "Instance@") $ HsIdent ('i':show n ++ ".default."++show ca)
hunk ./FrontEnd/Class.hs 367
-    KindEnv            -- ^ the kindenv
+    ClassHierarchy
+    -> KindEnv         -- ^ the kindenv
hunk ./FrontEnd/Class.hs 375
-methodToTopDecls kt preds crecord qt (methodName, methodDecls)
+methodToTopDecls ch kt preds crecord@(ClassAliasRecord {}) qt meth@(methodName, methodDecls) 
+   = methodToTopDecls ch kt preds (findClassRecord ch cls) qt meth
+     where Just cls = Map.lookup methodName (classMethodMap crecord)
+
+methodToTopDecls _  kt preds crecord qt (methodName, methodDecls)
hunk ./FrontEnd/Class.hs 402
+aliasDefaultMethodToTopDecls :: KindEnv -> [Assump] -> Class -> (Name, HsDecl) -> (HsDecl,Assump)
+aliasDefaultMethodToTopDecls kt methodSigs aliasName (methodName, methodDecls)
+   = (renamedMethodDecls,(newMethodName,sigFromClass)) where
+     newMethodName = aliasDefaultInstanceName methodName aliasName
+     sigFromClass = case [ s | (n, s) <- methodSigs, n == methodName] of
+         [x] -> x
+         _ -> error $ "sigFromClass: " ++ show methodSigs ++ " " ++ show  methodName
+      --  = newMethodSig cntxt newMethodName sigFromClass argType
+     renamedMethodDecls = renameOneDecl newMethodName methodDecls
+
hunk ./FrontEnd/Class.hs 464
-scatterAliasInstances :: Monad m => ClassHierarchy -> m ClassHierarchy
+scatterAliasInstances :: MonadIO m => ClassHierarchy -> m ClassHierarchy
hunk ./FrontEnd/Class.hs 466
-  let cas = [cr | cr@(ClassAliasRecord {}) <- classRecords ch]
-  fail ("scatterAliasInstances: " ++ show cas)
-      
+    let cas = [cr | cr@(ClassAliasRecord {}) <- classRecords ch]
+    ch `seq` liftIO $ putStrLn ("scatterAliasInstances: " ++ show cas)
+    let instances = concatMap scatterInstancesOf cas
+    let ret = foldr (modifyClassRecord $ \cr -> cr 
+                     { classInsts = [],
+                       classMethodMap = Map.fromList [(meth, cls) | cls <- classClasses cr,
+                                                                    (meth,_) <- classAssumps (findClassRecord ch cls)]
+                     })
+                    (ch `mappend` classHierarchyFromRecords instances)
+                    (map className cas)
+    -- liftIO $ mapM_ print (classRecords ret)
+    return ret
+    
+scatterInstancesOf :: ClassRecord -> [ClassRecord]
+scatterInstancesOf cr = map extract (classClasses cr)
+    where
+      extract c =
+          (newClassRecord c) { classInsts = 
+                                   [Inst sl d ((cxt ++ [IsIn c2 xs | c2 <- classClasses cr, c2 /= c]) :=> IsIn c xs) []
+                                        | Inst sl d (cxt :=> IsIn _ xs) [] <- classInsts cr] }
+
hunk ./FrontEnd/Class.hs 515
-                                 classScatterMap = mempty
+                                 classMethodMap = Map.empty
hunk ./FrontEnd/Tc/Module.hs 165
-    let myClassAssumps = concat  [ classAssumps as | as <- (classRecords cHierarchyWithInstances)]
+    let myClassAssumps = concat  [ classAssumps as | as <- classRecords cHierarchyWithInstances, isClassRecord as ]