[Code Cleanups
John Meacham <john@repetae.net>**20050424122413] hunk ./FrontEnd/Class.hs 755
-    {-
hunk ./FrontEnd/Class.hs 756
-addClassToHierarchy :: Monad m =>  KindEnv -> HsDecl -> ClassHierarchy -> m ClassHierarchy
-addClassToHierarchy  kt (HsClassDecl _ t decls) (ClassHierarchy h) |   (HsQualType cntxt (HsTyApp (HsTyCon className) (HsTyVar argName)))  <- toHsQualType t = let 
-   qualifiedMethodAssumps = concatMap (aHsTypeSigToAssumps kt . qualifyMethod newClassContext) (filter isHsTypeSig decls)
-   newClassContext = [(className, argName)] 
-   in return $ ClassHierarchy $ Map.insertWith combineClassRecords  className ClassRecord { className = className, classSupers = map fst cntxt, classInsts = [], classDerives = [], classAssumps = qualifiedMethodAssumps } h  
-    
+-- takes a list of things and puts a seperator string after each elem
+-- except the last, first arg is a function to convert the things into
+-- strings
+showListAndSep :: (a -> String) -> String -> [a] -> String
+showListAndSep f sep [] = []
+showListAndSep f sep [s] = f s
+showListAndSep f sep (s:ss) = f s ++ sep ++ showListAndSep f sep ss
hunk ./FrontEnd/Class.hs 764
-addClassToHierarchy  _ _ ch = return ch
+accLen :: Int -> [[a]] -> [(Int, [a])]
+accLen width [] = []
+accLen width (x:xs)
+   = let newWidth
+           = length x + width
+     in (newWidth, x) : accLen newWidth xs
hunk ./FrontEnd/Class.hs 771
-addInstancesToHierarchy :: Monad m => KindEnv -> ClassHierarchy -> [HsDecl] -> m ClassHierarchy
-addInstancesToHierarchy kt ch decls = do
-    insts <- mapM (hsInstDeclToInst kt) decls
-    return $ foldl addOneInstanceToHierarchy ch (concat insts)
-modifyClassRecord ::  (ClassRecord -> ClassRecord) -> Class -> ClassHierarchy -> ClassHierarchy
-modifyClassRecord f c (ClassHierarchy h) = case Map.lookup c h of
-           --Nothing -> error $ "modifyClassRecord: " ++ show c
-           Nothing -> ClassHierarchy $ Map.insert c (f (newClassRecord c)) h
-           Just r -> ClassHierarchy $ Map.insert c (f r) h 
+groupStringsToWidth :: Int -> [String] -> [String]
+groupStringsToWidth width ss
+   = groupStringsToWidth' width (accLen 0 ss)
+   where
+   groupStringsToWidth' :: Int -> [(Int,String)] -> [String]
+   groupStringsToWidth' width [] = []
+   groupStringsToWidth' width xs
+      = headString : groupStringsToWidth' width (accLen 0 $ map snd rest)
+      where
+      (headSegments, rest)
+         = case span ((<=width).fst) xs of
+              ([], ss)     -> ([head ss], tail ss)
+              anythingElse -> anythingElse
+      headString = concatMap snd headSegments
hunk ./FrontEnd/Class.hs 786
-addOneInstanceToHierarchy :: ClasHierarchy -> (Bool,Inst) -> ClassHierarchy
-addOneInstanceToHierarchy ch (x,inst@(cntxt :=> IsIn className _)) = modifyClassRecord f className ch where
-    f c 
-        | x = c { classInsts = inst:classInsts c, classDerives = inst:classDerives c }
-        | otherwise = c { classInsts = inst:classInsts c  }
-
-
--}
+showListAndSepInWidth :: (a -> String) -> Int -> String -> [a] -> String
+showListAndSepInWidth _ _ _ [] = []
+showListAndSepInWidth f width sep things
+   = unlines $ groupStringsToWidth width newThings
+   where
+   newThings = (map ((\t -> t ++ sep).f) (init things)) ++ [f (last things)]
hunk ./FrontEnd/Rename.hs 1034
-isIdentRenamed i = not $ null $ takeWhile isDigit $ fromHsIdentifier i
+isIdentRenamed i = not $ null $ takeWhile isDigit $ hsIdentString i
hunk ./FrontEnd/Rename.hs 1653
+
+data Binding
+   = TopFun             -- function binding at the top level
+   | ClassMethod        -- name of a method in a class
+   | Instance           -- an instance decl lifted to a top-level binding
+   | WhereFun           -- function binding in a where clause
+   | LetFun             -- function binding in a let expression (used to include topbinds too)
+   | LamPat             -- pattern binding in a lambda expression
+   | CasePat            -- pattern binding in a case expression
+   | GenPat             -- pattern binding in a generator statement
+   | FunPat             -- pattern binding in a function declaration
+   | Constr             -- name is a data constructor
hunk ./FrontEnd/TIMain.hs 30
-import Monad                    (zipWithM)
hunk ./FrontEnd/TIMain.hs 35
-                                 splitReduce,
-                                 reduce)
+                                 splitReduce)
hunk ./FrontEnd/TIMain.hs 40
-import Utils                    (isSigDecl,
-                                 isBindDecl,
-                                 fromHsName,
+import Utils                    (fromHsName,
hunk ./FrontEnd/TIMain.hs 43
-                                 Binding (..),
hunk ./FrontEnd/TIMain.hs 61
+isBindDecl :: HsDecl -> Bool
+isBindDecl HsPatBind {} = True
+isBindDecl HsFunBind {} = True 
+isBindDecl _ = False
hunk ./FrontEnd/TIModule.hs 45
+getDeclNames ::  HsDecl -> [HsName]
+getDeclNames (HsTypeSig _ ns _ ) =  ns
+getDeclNames d = maybeGetDeclName d
hunk ./FrontEnd/TypeSyns.hs 628
-isIdentRenamed i = not $ null $ takeWhile isDigit $ fromHsIdentifier i
+isIdentRenamed i = not $ null $ takeWhile isDigit $ hsIdentString i
hunk ./FrontEnd/TypeSyns.hs 1200
+
+data Binding
+   = TopFun             -- function binding at the top level
+   | ClassMethod        -- name of a method in a class
+   | Instance           -- an instance decl lifted to a top-level binding
+   | WhereFun           -- function binding in a where clause
+   | LetFun             -- function binding in a let expression (used to include topbinds too)
+   | LamPat             -- pattern binding in a lambda expression
+   | CasePat            -- pattern binding in a case expression
+   | GenPat             -- pattern binding in a generator statement
+   | FunPat             -- pattern binding in a function declaration
+   | Constr             -- name is a data constructor
hunk ./FrontEnd/Utils.hs 7
-        Description:            Generic utilities that don't have a good home 
+        Description:            Generic utilities that don't have a good home
hunk ./FrontEnd/Utils.hs 18
-import HsSyn   
-import Char             
+import HsSyn
+import Char
hunk ./FrontEnd/Utils.hs 25
-import Name
+import Name()
hunk ./FrontEnd/Utils.hs 32
-instance FromTupname HsName where 
+instance FromTupname HsName where
hunk ./FrontEnd/Utils.hs 41
---getAModuleName :: HsModule -> Module
---getAModuleName (HsModule modName _ _ _) = modName
-
-getDeclNames ::  HsDecl -> [HsName]
-getDeclNames (HsTypeSig _ ns _ ) =  ns
-getDeclNames d = maybeGetDeclName d
hunk ./FrontEnd/Utils.hs 52
-           -> return $ leftMostTyCon t 
+           -> return $ leftMostTyCon t
hunk ./FrontEnd/Utils.hs 55
-maybeGetDeclName d = fail  $ "getDeclName: could not find name for a decl: " ++ show d 
+maybeGetDeclName d = fail  $ "getDeclName: could not find name for a decl: " ++ show d
hunk ./FrontEnd/Utils.hs 57
-getDeclName d =  runIdentity $ maybeGetDeclName d 
+getDeclName d =  runIdentity $ maybeGetDeclName d
hunk ./FrontEnd/Utils.hs 59
---getDeclName :: HsDecl -> HsName
---getDeclName (HsPatBind sloc (HsPVar name) rhs wheres) = name
---getDeclName (HsFunBind ((HsMatch _ name _ _ _):_)) = name
---getDeclName (HsDataDecl _ _ name  _ _ _) = name
---getDeclName (HsNewTypeDecl _ _ name  _ _ _) = name
---getDeclName (HsClassDecl _ qualType _)
---   = case qualType of
---        HsQualType _cntxt t
---           -> leftMostTyCon t
---        HsUnQualType t
---           -> leftMostTyCon t
---getDeclName (HsForeignDecl _ _ _ n _) = n
---getDeclName d = error $ "getDeclName: could not find name for a decl: " ++ show d 
hunk ./FrontEnd/Utils.hs 61
--- gets the left most type constructor from a type
hunk ./FrontEnd/Utils.hs 64
-leftMostTyCon (HsTyApp t1 _) = leftMostTyCon t1 
+leftMostTyCon (HsTyApp t1 _) = leftMostTyCon t1
hunk ./FrontEnd/Utils.hs 67
+leftMostTyCon x = error $ "leftMostTyCon: " ++ show x
+
+
+-- | Convert name to what it was before renaming.
hunk ./FrontEnd/Utils.hs 72
-hsNameToOrig :: HsName -> HsName 
+hsNameToOrig :: HsName -> HsName
hunk ./FrontEnd/Utils.hs 74
-    dn xs = case dropWhile isDigit xs of 
+    dn xs = case dropWhile isDigit xs of
hunk ./FrontEnd/Utils.hs 81
-fromHsName (UnQual i) = hsIdentString i 
+fromHsName (UnQual i) = hsIdentString i
hunk ./FrontEnd/Utils.hs 84
-fromHsIdentifier :: HsIdentifier -> String
-fromHsIdentifier = hsIdentString
hunk ./FrontEnd/Utils.hs 85
-isBindDecl :: HsDecl -> Bool
-isBindDecl HsPatBind {} = True
-isBindDecl HsFunBind {} = True 
-isBindDecl _ = False
hunk ./FrontEnd/Utils.hs 97
-
--- takes a list of things and puts a seperator string after each elem
--- except the last, first arg is a function to convert the things into
--- strings
-showListAndSep :: (a -> String) -> String -> [a] -> String
-showListAndSep f sep [] = []
-showListAndSep f sep [s] = f s
-showListAndSep f sep (s:ss) = f s ++ sep ++ showListAndSep f sep ss
-
-accLen :: Int -> [[a]] -> [(Int, [a])]
-accLen width [] = []
-accLen width (x:xs)
-   = let newWidth
-           = length x + width
-     in (newWidth, x) : accLen newWidth xs
-
-groupStringsToWidth :: Int -> [String] -> [String]
-groupStringsToWidth width ss
-   = groupStringsToWidth' width (accLen 0 ss)
-   where
-   groupStringsToWidth' :: Int -> [(Int,String)] -> [String]
-   groupStringsToWidth' width [] = []
-   groupStringsToWidth' width xs
-      = headString : groupStringsToWidth' width (accLen 0 $ map snd rest)
-      where
-      (headSegments, rest)
-         = case span ((<=width).fst) xs of
-              ([], ss)     -> ([head ss], tail ss)
-              anythingElse -> anythingElse
-      headString = concatMap snd headSegments
-
-showListAndSepInWidth :: (a -> String) -> Int -> String -> [a] -> String
-showListAndSepInWidth _ _ _ [] = []
-showListAndSepInWidth f width sep things
-   = unlines $ groupStringsToWidth width newThings
-   where
-   newThings = (map ((\t -> t ++ sep).f) (init things)) ++ [f (last things)]
hunk ./FrontEnd/Utils.hs 112
-   = (getDeclName d, d) : groupEquations ds 
+   = (getDeclName d, d) : groupEquations ds
hunk ./FrontEnd/Utils.hs 114
-spacesToUnderscores :: String -> String
-spacesToUnderscores 
-   = map $ \c -> if (isSpace c) then '_' else c
hunk ./FrontEnd/Utils.hs 119
-lJustify n s = take n $ s ++ repeat ' ' 
+lJustify n s = take n $ s ++ repeat ' '
hunk ./FrontEnd/Utils.hs 140
--- -- The possible bindings for names 
+-- -- The possible bindings for names
hunk ./FrontEnd/Utils.hs 142
-data Binding
-   = TopFun             -- function binding at the top level
-   | ClassMethod        -- name of a method in a class
-   | Instance           -- an instance decl lifted to a top-level binding
-   | WhereFun           -- function binding in a where clause
-   | LetFun             -- function binding in a let expression (used to include topbinds too)
-   | LamPat             -- pattern binding in a lambda expression
-   | CasePat            -- pattern binding in a case expression
-   | GenPat             -- pattern binding in a generator statement
-   | FunPat             -- pattern binding in a function declaration
-   | Constr             -- name is a data constructor 
-   deriving (Show, Eq, Enum)
hunk ./FrontEnd/Utils.hs 157
-   pprint (HsIdent   s) = text s 
---   pprint (HsSymbol  s) = text s 
---   pprint (HsSpecial s) = text s 
+   pprint (HsIdent   s) = text s
hunk ./FrontEnd/Utils.hs 161
+
+