[the great HsName refactoring. get rid of HsName algebraic data type in favor of Name.
John Meacham <john@repetae.net>**20100715201840
 Ignore-this: 7151cf5149b9beaa756e7632c1835216
] hunk ./Makefile.am 54
-GHCLANG= -XUndecidableInstances -XOverlappingInstances -fglasgow-exts
+GHCLANG= -XViewPatterns -XUndecidableInstances -XOverlappingInstances -fglasgow-exts -XRecordWildCards -XRecursiveDo -XTupleSections
hunk ./src/DerivingDrift/Drift.hs 44
-
-
hunk ./src/DerivingDrift/Drift.hs 46
-        let d =  toData  name args condecls derives
+        let d = toData  name args condecls derives
hunk ./src/DerivingDrift/Drift.hs 66
-
-derive True d wh | Just fns <- lookup wh enumDontDerive = inst fns where
+derive True d (toName ClassName -> wh) | Just fns <- lookup wh enumDontDerive = inst fns where
hunk ./src/DerivingDrift/Drift.hs 73
-derive _ d wh | Just fn <- Map.lookup wh (Map.mapKeys (nameName . toUnqualified) standardRules) = render $ fn d
+derive _ d wh | Just fn <- Map.lookup (toName ClassName wh) (Map.mapKeys (nameName . toUnqualified) standardRules) = render $ fn d
hunk ./src/DerivingDrift/Drift.hs 75
-
hunk ./src/E/Binary.hs 7
+import FrontEnd.HsSyn()
hunk ./src/FrontEnd/Class.hs 370
-instanceName n t = toName Val $ Qual (Module "Instance@") $ HsIdent ('i':show n ++ "." ++ show t)
-defaultInstanceName n = toName Val $ Qual (Module "Instance@") $ HsIdent ('i':show n ++ ".default")
+instanceName n t = toName Val ("Instance@",'i':show n ++ "." ++ show t)
+defaultInstanceName n = toName Val ("Instance@",'i':show n ++ ".default")
hunk ./src/FrontEnd/Class.hs 373
-aliasDefaultInstanceName n ca = toName Val $ Qual (Module "Instance@") $ HsIdent ('i':show n ++ ".default."++show ca)
+aliasDefaultInstanceName n ca = toName Val ("Instance@",'i':show n ++ ".default."++show ca)
hunk ./src/FrontEnd/Desugar.hs 81
-    let newRhsName = nameName $ toName Val ("patrhs@" ++ show unique)
+    let newRhsName = toName Val ("patrhs@" ++ show unique)
hunk ./src/FrontEnd/Desugar.hs 106
-desugarDecl HsPragmaSpecialize { hsDeclName = n } | n == nameName u_instance = return []
+desugarDecl HsPragmaSpecialize { hsDeclName = n } | n == u_instance = return []
hunk ./src/FrontEnd/Desugar.hs 147
-       a2 =  HsAlt sloc HsPWildCard (HsUnGuardedRhs (HsApp (HsVar (UnQual $ HsIdent "error")) (HsLit $ HsString $ show sloc ++ " failed pattern match"))) []
+       a2 =  HsAlt sloc HsPWildCard (HsUnGuardedRhs (HsApp (HsVar (toName Val "error")) (HsLit $ HsString $ show sloc ++ " failed pattern match"))) []
hunk ./src/FrontEnd/Desugar.hs 155
-    f name1 (HsPVar name2)
+    f name1 (HsPVar (toName Val -> name2))
hunk ./src/FrontEnd/Exports.hs 59
-                putStrLn $ " -- Imports -- " ++  show (modInfoName m)
+                putStrLn $ " -- Imports: " ++  show (modInfoName m)
hunk ./src/FrontEnd/Exports.hs 62
-                putStrLn $ " -- Exports -- " ++  show (modInfoName m)
-                putStr $ unlines (map show $ sort (modInfoExport m))
+                putStrLn $ " -- Exports: " ++  show (modInfoName m)
+                mapM_ putStrLn (sort [ show (nameType n) ++ " " ++ show n |  n <- modInfoExport m])
hunk ./src/FrontEnd/FrontEnd.hs 10
+import Name.Name
hunk ./src/FrontEnd/HsParser.y 157
-      | body                                          { HsModule { hsModuleName = main_mod, hsModuleExports = Just [HsEVar (UnQual (HsIdent "main"))], hsModuleImports = (fst $1), hsModuleDecls = (snd $1)
+      | body                                          { HsModule { hsModuleName = main_mod, hsModuleExports = Just [HsEVar (toName Val "main")], hsModuleImports = (fst $1), hsModuleDecls = (snd $1)
hunk ./src/FrontEnd/HsParser.y 321
-                      {% doForeign $2 (UnQual (HsIdent "import"):reverse $4) $5 $7  }
+                      {% doForeign $2 (toName Val "import":reverse $4) $5 $7  }
hunk ./src/FrontEnd/HsParser.y 939
-      | QVARID                { Qual (Module (fst $1)) (HsIdent (snd $1)) }
+      | QVARID                { toName UnknownType $1 }
hunk ./src/FrontEnd/HsParser.y 942
-      : VARID                 { UnQual (HsIdent $1) }
+      : VARID                 { toUnqualName $1 }
hunk ./src/FrontEnd/HsParser.y 944
-      | 'alias'               { UnQual (HsIdent "alias") }
-      | 'kind'                { UnQual (HsIdent "kind") }
+      | 'alias'               { toName UnknownType "alias" }
+      | 'kind'                { toName UnknownType "kind" }
hunk ./src/FrontEnd/HsParser.y 948
-      | 'forall'              { UnQual (HsIdent "forall") }
-      | 'exists'              { UnQual (HsIdent "exists") }
+      | 'forall'              { toName UnknownType "forall" }
+      | 'exists'              { toName UnknownType "exists" }
hunk ./src/FrontEnd/HsParser.y 954
-      | QCONID                { Qual (Module (fst $1)) (HsIdent (snd $1)) }
+      | QCONID                { toName UnknownType $1  }
hunk ./src/FrontEnd/HsParser.y 957
-      : CONID                 { UnQual (HsIdent $1) }
+      : CONID                 { toUnqualName $1 }
hunk ./src/FrontEnd/HsParser.y 961
-      | QCONSYM               { Qual (Module (fst $1)) (hsSymbol (snd $1)) }
+      | QCONSYM               { toName UnknownType $1 }
hunk ./src/FrontEnd/HsParser.y 964
-      : CONSYM                { UnQual (hsSymbol $1) }
+      : CONSYM                { toUnqualName $1 }
hunk ./src/FrontEnd/HsParser.y 975
-      : VARSYM                { UnQual (hsSymbol $1) }
+      : VARSYM                { toUnqualName $1 }
hunk ./src/FrontEnd/HsParser.y 978
-      | '?'                   { UnQual (hsSymbol "?") }
-      | '??'                  { UnQual (hsSymbol "??") }
-      | '*!'                  { UnQual (hsSymbol "*!") }
+      | '?'                   { toName UnknownType "?" }
+      | '??'                  { toName UnknownType "??" }
+      | '*!'                  { toName UnknownType "*!" }
hunk ./src/FrontEnd/HsParser.y 986
-      : VARSYM                { UnQual (hsSymbol $1) }
+      : VARSYM                { toUnqualName $1 }
hunk ./src/FrontEnd/HsParser.y 993
-      : QVARSYM               { Qual (Module (fst $1)) (hsSymbol (snd $1)) }
+      : QVARSYM               { toName UnknownType $1 }
hunk ./src/FrontEnd/HsParser.y 1050
-hsSymbol x = HsIdent x
+--hsSymbol x = HsIdent x
hunk ./src/FrontEnd/HsParser.y 1054
-as_name	              = UnQual $ HsIdent "as"
-derive_name	      = UnQual $ HsIdent "derive"
-qualified_name        = UnQual $ HsIdent "qualified"
-hiding_name	      = UnQual $ HsIdent "hiding"
-minus_name	      = UnQual $ HsIdent "-"
-pling_name	      = UnQual $ HsIdent "!"
-star_name	      = UnQual $ HsIdent "*"
-hash_name	      = UnQual $ HsIdent "#"
-dot_name	      = UnQual $ HsIdent "."
+as_name	              = toName UnknownType  "as"
+derive_name	      = toName UnknownType  "derive"
+qualified_name        = toName UnknownType  "qualified"
+hiding_name	      = toName UnknownType  "hiding"
+minus_name	      = toName UnknownType  "-"
+pling_name	      = toName UnknownType  "!"
+star_name	      = toName UnknownType  "*"
+hash_name	      = toName UnknownType  "#"
+dot_name	      = toName UnknownType  "."
hunk ./src/FrontEnd/HsParser.y 1066
-unit_con_name	      = UnQual (HsIdent "()")
-tuple_con_name i      = Qual (Module "Jhc.Basics") (HsIdent ("("++replicate i ','++")"))
+unit_con_name	      = toName DataConstructor "()"
+tuple_con_name i      = toName DataConstructor ("Jhc.Basics","("++replicate i ','++")")
hunk ./src/FrontEnd/HsParser.y 1074
-fun_tycon_name        = Qual (Module "Jhc.Basics") (HsIdent "->")
-list_tycon_name       = UnQual (HsIdent "[]")
+fun_tycon_name        = tc_Arrow
+list_tycon_name       = toName UnknownType "[]"
hunk ./src/FrontEnd/HsParser.y 1079
+
+toUnqualName n = toName UnknownType (Nothing :: Maybe String,n)
hunk ./src/FrontEnd/HsPretty.hs 591
-ppHsQName (UnQual name)			= ppHsIdentifier name
-ppHsQName z@(Qual m@(Module mod) name)
-	 | otherwise = text mod <> char '.' <> ppHsIdentifier name
+ppHsQName n = text $ show n
+--ppHsQName (UnQual name)			= ppHsIdentifier name
+--ppHsQName z@(Qual m@(Module mod) name)
+--	 | otherwise = text mod <> char '.' <> ppHsIdentifier name
hunk ./src/FrontEnd/HsPretty.hs 606
-ppHsIdentifier :: HsIdentifier -> Doc
-ppHsIdentifier name = text (show name)
+--ppHsIdentifier :: HsIdentifier -> Doc
+--ppHsIdentifier name = text (show name)
hunk ./src/FrontEnd/HsPretty.hs 620
-isSymbolName x | (c:_) <- hsIdentString (hsNameIdent (unRename x)), isAlpha c || c `elem` "'_" = False
+isSymbolName x | (_,_,c:_) <- nameParts (unRename x), isAlpha c || c `elem` "'_" = False
hunk ./src/FrontEnd/HsSyn.hs 11
+import Name.Name
+import Name.Names
hunk ./src/FrontEnd/HsSyn.hs 29
+hsNameIdent_u f n = mapName (id,f) n
+hsIdentString_u f x = f x
hunk ./src/FrontEnd/HsSyn.hs 32
-newtype Module = Module String
-  deriving(Eq,Data,Typeable,Ord,ToAtom,FromAtom)
-
-instance Show Module where
-    showsPrec _ (Module n) = showString n
-
-fromModule (Module s) = s
hunk ./src/FrontEnd/HsSyn.hs 35
-data HsName
-	= Qual { hsNameModule :: Module, hsNameIdent ::  HsIdentifier}
-	| UnQual { hsNameIdent :: HsIdentifier}
-  deriving(Data,Typeable,Eq,Ord)
-  {-! derive: is, update, Binary !-}
hunk ./src/FrontEnd/HsSyn.hs 36
+type HsName = Name
+--data HsName
+--	= Qual { hsNameModule :: Module, hsNameIdent ::  HsIdentifier}
+--	| UnQual { hsNameIdent :: HsIdentifier}
+--  deriving(Data,Typeable,Eq,Ord)
+--  {- derive: is, update, Binary !-}
hunk ./src/FrontEnd/HsSyn.hs 43
-instance ToAtom HsName where
-    toAtom = toAtom . show
hunk ./src/FrontEnd/HsSyn.hs 44
-instance Show HsName where
-   showsPrec _ (Qual (Module m) s) =
-	showString m . showString "." . shows s
-   showsPrec _ (UnQual s) = shows s
+--instance ToAtom HsName where
+--    toAtom = toAtom . show
hunk ./src/FrontEnd/HsSyn.hs 47
-newtype HsIdentifier = HsIdent { hsIdentString :: String }
-  deriving(Data,Typeable,Eq,Ord)
+--instance Show HsName where
+--   showsPrec _ (Qual (Module m) s) =
+--	showString m . showString "." . shows s
+--   showsPrec _ (UnQual s) = shows s
+
+--newtype HsIdentifier = HsIdent { hsIdentString :: String }
+--  deriving(Data,Typeable,Eq,Ord)
hunk ./src/FrontEnd/HsSyn.hs 61
-instance Binary HsIdentifier where
-    get = do
-        ps <- get
-        return (HsIdent $ fromAtom ps)
-    put (HsIdent n) = put (toAtom n)
-
-hsIdentString_u f x = x { hsIdentString = f $ hsIdentString x }
+--instance Binary HsIdentifier where
+--    get = do
+--        ps <- get
+--        return (HsIdent $ fromAtom ps)
+--    put (HsIdent n) = put (toAtom n)
+--
+--hsIdentString_u f x = x { hsIdentString = f $ hsIdentString x }
hunk ./src/FrontEnd/HsSyn.hs 72
-instance Show HsIdentifier where
-   showsPrec _ (HsIdent s) = showString s
+--instance Show HsIdentifier where
+--   showsPrec _ (HsIdent s) = showString s
hunk ./src/FrontEnd/HsSyn.hs 255
-data HsMatch
-	 = HsMatch SrcLoc HsName [HsPat] HsRhs {-where-} [HsDecl]
+data HsMatch = HsMatch {
+    hsMatchSrcLoc :: SrcLoc,
+    hsMatchName :: HsName,
+    hsMatchPats :: [HsPat],
+    hsMatchRhs :: HsRhs,
+    {-where-} hsMatchDecls :: [HsDecl]
+    }
hunk ./src/FrontEnd/HsSyn.hs 441
-hsKindStar = HsKind (Qual (Module "Jhc@") (HsIdent "*"))
-hsKindHash = HsKind (Qual (Module "Jhc@") (HsIdent "#"))
-hsKindBang = HsKind (Qual (Module "Jhc@") (HsIdent "!"))
-hsKindQuest = HsKind (Qual (Module "Jhc@") (HsIdent "?"))
-hsKindQuestQuest = HsKind (Qual (Module "Jhc@") (HsIdent "??"))
-hsKindStarBang   = HsKind (Qual (Module "Jhc@") (HsIdent "*!"))
+--hsKindStar = HsKind (Qual (Module "Jhc@") (HsIdent "*"))
+--hsKindHash = HsKind (Qual (Module "Jhc@") (HsIdent "#"))
+--hsKindBang = HsKind (Qual (Module "Jhc@") (HsIdent "!"))
+--hsKindQuest = HsKind (Qual (Module "Jhc@") (HsIdent "?"))
+--hsKindQuestQuest = HsKind (Qual (Module "Jhc@") (HsIdent "??"))
+--hsKindStarBang   = HsKind (Qual (Module "Jhc@") (HsIdent "*!"))
+--
+hsKindStar = HsKind s_Star
+hsKindHash = HsKind s_Hash
+hsKindBang = HsKind s_Bang
+hsKindQuest = HsKind s_Quest
+hsKindQuestQuest = HsKind s_QuestQuest
+hsKindStarBang = HsKind s_StarBang
hunk ./src/FrontEnd/KindInfer.hs 502
-   | isConstructorLike (hsIdentString . hsNameIdent $ varName) = IsIn  (toName ClassName className) (TCon (Tycon (toName TypeConstructor varName) (head $ kindOfClass (toName ClassName className) kt)))
+   | isConstructorLike varName = IsIn  (toName ClassName className) (TCon (Tycon (toName TypeConstructor varName) (head $ kindOfClass (toName ClassName className) kt)))
hunk ./src/FrontEnd/ParseUtils.hs 37
+import Data.Maybe
hunk ./src/FrontEnd/ParseUtils.hs 44
+import Name.Name
hunk ./src/FrontEnd/ParseUtils.hs 76
-checkContext (HsTyCon (UnQual (HsIdent "()"))) = return []
+checkContext (HsTyCon (nameParts -> (_,Nothing,"()"))) = return []
hunk ./src/FrontEnd/ParseUtils.hs 326
-checkUnQual (Qual _ _) = fail "Illegal qualified name"
-checkUnQual n@(UnQual _) = return n
+checkUnQual n = if isJust (getModule n) then fail "Illegal qualified name" else return n
+--checkUnQual (Qual _ _) = fail "Illegal qualified name"
+--checkUnQual n@(UnQual _) = return n
hunk ./src/FrontEnd/ParseUtils.hs 388
-        (mstring,vname@(UnQual (HsIdent cname)),names') <- case ms of
+        (mstring,vname@(nameParts -> (_,Nothing,cname)),names') <- case ms of
hunk ./src/FrontEnd/Rename.hs 1
-module FrontEnd.Rename(unRename, collectDefsHsModule, renameModule, FieldMap(..), renameStatement ) where
+module FrontEnd.Rename(
+    renameModule,
+    unRename,
+    collectDefsHsModule,
+    FieldMap(..),
+    renameStatement
+    ) where
hunk ./src/FrontEnd/Rename.hs 13
-import Data.Monoid
hunk ./src/FrontEnd/Rename.hs 17
-
+import qualified Data.Sequence as Seq
+import qualified Data.Foldable as Seq
hunk ./src/FrontEnd/Rename.hs 22
+import FrontEnd.HsSyn
hunk ./src/FrontEnd/Rename.hs 26
-import FrontEnd.HsSyn
-import Name.Name as Name hiding(qualifyName)
+import FrontEnd.Warning
+import Name.Name as Name
hunk ./src/FrontEnd/Rename.hs 29
+import Options
hunk ./src/FrontEnd/Rename.hs 33
-import FrontEnd.Warning
hunk ./src/FrontEnd/Rename.hs 35
-import Options
hunk ./src/FrontEnd/Rename.hs 36
-data FieldMap = FieldMap (Map.Map Name Int) (Map.Map Name [(Name,Int)])
+data FieldMap = FieldMap
+    (Map.Map Name Int)             -- a map of data constructors to their arities
+    (Map.Map Name [(Name,Int)])    -- a map of field labels to ...
hunk ./src/FrontEnd/Rename.hs 44
---------------------------------------------------------------------------------
-
--- a 'Substitution Table' which is a map from old names to new names
--- All names in the current scope are stored in here, with their renamings
-
hunk ./src/FrontEnd/Rename.hs 46
--- an Identifier Table is a map from renamed names to that identifier's source
--- location and binding type
-
-
--- the monadic state
-
hunk ./src/FrontEnd/Rename.hs 48
-    globalSubTable :: Map.Map HsName HsName,  -- Current substition
-    typeSubTable   :: Map.Map HsName HsName,  -- type substition table
-    errorTable     :: Map.Map HsName String,  -- special error message. else it's just unknown.
-    fieldLabels    :: FieldMap
+    errorTable     :: Map.Map HsName String
hunk ./src/FrontEnd/Rename.hs 51
-
hunk ./src/FrontEnd/Rename.hs 52
-    envSubTable  :: Map.Map HsName HsName,  -- all these need to go away
-    envNameSpace :: [NameType],
-    envModule  :: Module,
-    envNameMap :: Map.Map Name (Either String Name),
-    envOptions :: Opt,
-    envSrcLoc  :: SrcLoc
-}
-
-instance OptionMonad RM where
-    getOptions = asks envOptions
-
-instance Applicative RM where
-    pure = return
-    (<*>) = ap
-
-newtype RM a = RM (RWS Env [Warning] ScopeState a)
-    deriving(Monad,Functor,MonadReader Env, MonadWriter [Warning], MonadState ScopeState)
-
-unRM (RM x) = x
-
-instance MonadWarn RM where
-    addWarning w = tell [w]
-
-instance UniqueProducer RM where
-    newUniq = do
-        u <- gets unique
-        modify (\s -> s {unique = unique s + 1})
-        return u
-
-
-getCurrentModule :: RM Module
-getCurrentModule = asks envModule
-
-instance MonadSrcLoc RM where
-    getSrcLoc = asks envSrcLoc
-instance MonadSetSrcLoc RM where
-    withSrcLoc sl a = local (\s -> s { envSrcLoc = sl `mappend` envSrcLoc s}) a
-
-
+    envSubTable    :: Map.Map HsName HsName,
+    envModule      :: Module,
+    envNameMap     :: Map.Map Name (Either String Name),
+    envOptions     :: Opt,
+    envFieldLabels :: FieldMap,
+    envSrcLoc      :: SrcLoc
+    }
hunk ./src/FrontEnd/Rename.hs 66
-        f r hsName@Qual {}
+        f r hsName@(getModule -> Just _)
hunk ./src/FrontEnd/Rename.hs 72
-        f r z@(UnQual n) = let nn = Qual mod n in (z,nn):(nn,nn):r
+        --f r z@(UnQual n) = let nn = Qual mod n in (z,nn):(nn,nn):r
+        f r z@(getModule -> Nothing) = let nn = qualifyName mod z in (z,nn):(nn,nn):r
hunk ./src/FrontEnd/Rename.hs 77
-    modify (\s -> s { globalSubTable = nm `Map.union` globalSubTable s })
-    modify (\s -> s { typeSubTable = tm `Map.union` typeSubTable s })
-    action
-
+    withSubTable (nm `Map.union` tm) action
hunk ./src/FrontEnd/Rename.hs 83
-    initialGlobalSubTable = Map.fromList [ (x,y) | ((typ,x),[y]) <- ns', typ == Val || typ == DataConstructor ]
-    initialTypeSubTable = Map.fromList [ (x,y) | ((typ,x),[y]) <- ns', typ == TypeConstructor || typ == ClassName ]
+    subTable = Map.fromList [ (x,y) | (x,[y]) <- ns]
hunk ./src/FrontEnd/Rename.hs 93
-        typeSubTable   = initialTypeSubTable,
-        errorTable     = errorTab,
-        unique         = 1,   -- start the counting at 1
-        globalSubTable = initialGlobalSubTable,
-        fieldLabels    = fls
+        unique         = 1,
+        errorTable     = errorTab
hunk ./src/FrontEnd/Rename.hs 97
-        envSubTable = initialGlobalSubTable,
-        envNameSpace = [Val,DataConstructor],
-        envModule = mod,
-        envNameMap  = nameMap,
-        envOptions = opt,
-        envSrcLoc = mempty
+        envSubTable    = subTable,
+        envModule      = mod,
+        envNameMap     = nameMap,
+        envOptions     = opt,
+        envFieldLabels = fls,
+        envSrcLoc      = mempty
hunk ./src/FrontEnd/Rename.hs 119
-        withSrcLoc (hsModuleSrcLoc tidy) $ do
-        addTopLevels (hsModuleDecls tidy) $ do
-        gst <- gets globalSubTable
-        withSubTable gst $ do
-        decls' <- rename (hsModuleDecls tidy)
-        mapM_ HsErrors.hsDeclTopLevel decls'
-        mapM_ checkExportSpec $ fromMaybe [] (hsModuleExports tidy)
-        return tidy { hsModuleDecls = decls' }
+    withSrcLoc (hsModuleSrcLoc tidy) $ do
+    addTopLevels (hsModuleDecls tidy) $ do
+    decls' <- rename (hsModuleDecls tidy)
+    mapM_ HsErrors.hsDeclTopLevel decls'
+    mapM_ checkExportSpec $ fromMaybe [] (hsModuleExports tidy)
+    return tidy { hsModuleDecls = decls' }
hunk ./src/FrontEnd/Rename.hs 128
-    f :: HsExportSpec -> RM ()
-    f (HsEVar n) = do rename n; return ()
+    f (HsEVar n) = do renameValName n; return ()
hunk ./src/FrontEnd/Rename.hs 130
-    f (HsEThingAll n) = do renameTypeName n ; return ()
+    f (HsEThingAll n) = do renameTypeName n; return ()
hunk ./src/FrontEnd/Rename.hs 133
-        mapM_ rename ns
+        mapM_ renameValName ns
hunk ./src/FrontEnd/Rename.hs 136
-
-
hunk ./src/FrontEnd/Rename.hs 144
-      HsTyApp cls arg ->
-         case hsTypeName cls of
-            Qual moduleName _ -> Just moduleName
-            UnQual _ -> Nothing
+      HsTyApp cls arg -> getModule (hsTypeName cls)
hunk ./src/FrontEnd/Rename.hs 148
-qualifyMethodName moduleName name =
-   case name of
-      Qual _ _ -> name
-      UnQual token ->
-         maybe name (flip Qual token) moduleName
+qualifyMethodName Nothing name = name
+qualifyMethodName (Just mod) name = qualifyName mod name
hunk ./src/FrontEnd/Rename.hs 171
-qualifyInstMethod moduleName decl =
-   case decl of
-      HsPatBind srcLoc (HsPVar {hsPatName = name}) rhs decls ->
-         HsPatBind srcLoc
+qualifyInstMethod moduleName decl = case decl of
+    HsPatBind srcLoc HsPVar {hsPatName = name} rhs decls -> HsPatBind srcLoc
hunk ./src/FrontEnd/Rename.hs 175
-      HsFunBind matches ->
-         HsFunBind $ map
-            (\(HsMatch matchSrcLoc matchName pats rhs matchDecls) ->
-               HsMatch matchSrcLoc (qualifyMethodName moduleName matchName) pats rhs matchDecls)
+    HsFunBind matches -> HsFunBind $ map
+            (\(m@HsMatch { .. }) -> m { hsMatchName = qualifyMethodName moduleName hsMatchName })
hunk ./src/FrontEnd/Rename.hs 178
-      _ -> decl
+    _ -> decl
hunk ./src/FrontEnd/Rename.hs 184
-        updateWith hsDecls $ do
+        updateWithN Val hsDecls $ do
hunk ./src/FrontEnd/Rename.hs 191
-        n <- rename n
+        n <- renameValName n
hunk ./src/FrontEnd/Rename.hs 198
-        n <- rename n
+        n <- renameValName n
hunk ./src/FrontEnd/Rename.hs 209
-        hsNames' <- rename hsNames
+        hsNames' <- mapM renameValName hsNames
hunk ./src/FrontEnd/Rename.hs 216
-        updateWith hsNames1 $ do
-        hsContext' <- rename hsContext
-        hsNames1' <- rename hsNames1
-        hsConDecls' <- rename hsConDecls
-        -- don't need to rename the hsNames2 as it is just a list of TypeClasses
-        hsNames2' <- mapM renameTypeName hsNames2
-        return dl { hsDeclContext = hsContext', hsDeclName = hsName', hsDeclArgs = hsNames1', hsDeclCons = hsConDecls', hsDeclDerives = hsNames2' }
+        updateWith (map fromTypishHsName hsNames1) $ do
+            hsContext' <- rename hsContext
+            hsNames1' <- mapM renameTypeName hsNames1 -- TODO
+            hsConDecls' <- rename hsConDecls
+            hsNames2' <- mapM (renameName . toName ClassName) hsNames2
+            return dl { hsDeclContext = hsContext', hsDeclName = hsName', hsDeclArgs = hsNames1', hsDeclCons = hsConDecls', hsDeclDerives = hsNames2' }
hunk ./src/FrontEnd/Rename.hs 232
-        updateWith hsNames1 $ do
-        hsContext' <- rename hsContext
-        hsNames1' <- rename hsNames1
-        hsConDecl' <- rename hsConDecl
-        -- don't need to rename the hsNames2 as it is just a list of TypeClasses
-        hsNames2' <- mapM renameTypeName hsNames2
-        return (HsNewTypeDecl srcLoc hsContext' hsName' hsNames1' hsConDecl' hsNames2')
+        updateWith (map fromTypishHsName hsNames1) $ do
+            hsContext' <- rename hsContext
+            hsNames1' <- mapM renameTypeName hsNames1 -- TODO
+            hsConDecl' <- rename hsConDecl
+            hsNames2' <- mapM (renameName . toName ClassName) hsNames2
+            return (HsNewTypeDecl srcLoc hsContext' hsName' hsNames1' hsConDecl' hsNames2')
hunk ./src/FrontEnd/Rename.hs 240
-        hsQualType' <- updateWith hsQualType  $ rename hsQualType
-        doesClassMakeSense hsQualType'
+        hsQualType' <- updateWithN TypeVal hsQualType $ renameClassHead hsQualType
+        --doesClassMakeSense hsQualType'
hunk ./src/FrontEnd/Rename.hs 255
-        updateWith hsQualType $ do
-        hsQualType' <- rename hsQualType
+        updateWithN TypeVal hsQualType $ do
+        hsQualType' <- renameClassHead hsQualType
hunk ./src/FrontEnd/Rename.hs 262
-        hsNames' <- rename hsNames
+        hsNames' <- mapM renameValName hsNames
hunk ./src/FrontEnd/Rename.hs 271
-        hsNames' <- rename hsNames
+        hsNames' <- mapM renameValName hsNames
hunk ./src/FrontEnd/Rename.hs 278
-        n <- if n == nameName u_instance then return n else rename n
+        n <- if n == nameName u_instance then return n else renameValName n
hunk ./src/FrontEnd/Rename.hs 281
-            ns' <- rename ns
+            ns' <- mapM renameTypeName ns
hunk ./src/FrontEnd/Rename.hs 292
-
hunk ./src/FrontEnd/Rename.hs 294
-        updateWith ts $ HsClassHead <$> rename cx <*> renameTypeName n <*> rename ts
-
-
+        updateWith ts $ HsClassHead <$> rename cx <*> renameName (toName ClassName n) <*> rename ts
hunk ./src/FrontEnd/Rename.hs 299
-        updateWith (fsts fvs) $ do
+        updateWith (map fromValishHsName $ fsts fvs) $ do
hunk ./src/FrontEnd/Rename.hs 301
-        fvs' <- sequence [ liftM2 (,) (rename x) (withSubTable subTable'' $ rename y)| (x,y) <- fvs]
+        fvs' <- sequence [ liftM2 (,) (renameValName x) (withSubTable subTable'' $ rename y)| (x,y) <- fvs]
hunk ./src/FrontEnd/Rename.hs 315
-instance Rename HsQualType where
-    rename (HsQualType hsContext hsType) = return HsQualType `ap` rename hsContext `ap` rename hsType
+renameClassHead :: HsQualType -> RM HsQualType
+renameClassHead (HsQualType hsContext hsType) = do
+    ctx <- rename hsContext
+    typ <- case hsType of
+        HsTyApp (HsTyCon n) t -> do
+            n <- renameName $ toName ClassName n
+            t <- rename t
+            return (HsTyApp (HsTyCon n) t)
+        HsTyApp (HsTyApp _ _) _   -> do
+            failRename "Multiparameter typeclasses not supported"
+            rename hsType
+        HsTyCon {}  -> do
+            failRename "Typeclass with no parameters"
+            rename hsType
+        _   -> do
+            failRename $ "Invalid type in class declaration: " ++ show hsType
+            rename hsType
+    return (HsQualType ctx typ)
hunk ./src/FrontEnd/Rename.hs 334
+instance Rename HsQualType where
+    rename (HsQualType hsContext hsType) = HsQualType <$> rename hsContext <*> rename hsType
hunk ./src/FrontEnd/Rename.hs 338
-    rename (HsAsst hsName1  hsName2s) = do
-        hsName1' <- renameTypeName hsName1
+    rename (HsAsst hsName1 hsName2s) = do
+        hsName1' <- renameName (toName ClassName hsName1)
hunk ./src/FrontEnd/Rename.hs 342
-    rename (HsAsstEq t1 t2) = return HsAsstEq `ap` rename t1 `ap` rename t2
-
+    rename (HsAsstEq t1 t2) = HsAsstEq <$> rename t1 <*> rename t2
hunk ./src/FrontEnd/Rename.hs 347
-        hsName' <- rename hsName
+        hsName' <- renameValName hsName
hunk ./src/FrontEnd/Rename.hs 354
-        hsName' <- rename hsName
+        hsName' <- renameValName hsName
hunk ./src/FrontEnd/Rename.hs 358
-        stuff' <- sequence [ do ns' <- rename ns; t' <- withSubTable subTable $ rename t; return (ns',t')  |  (ns,t) <- stuff]
+        stuff' <- sequence [ do ns' <- mapM renameName (map (toName FieldLabel) ns); t' <- withSubTable subTable $ rename t; return (ns',t')  |  (ns,t) <- stuff]
hunk ./src/FrontEnd/Rename.hs 361
-
hunk ./src/FrontEnd/Rename.hs 376
-    rt v@(HsTyVar _)   = return v
-
+    rt v@HsTyVar {} = return v
hunk ./src/FrontEnd/Rename.hs 381
-        updateWith (map hsTyVarBindName ts)  $ do
+        updateWith (map (toName TypeVal) $ map hsTyVarBindName ts)  $ do
hunk ./src/FrontEnd/Rename.hs 386
-        updateWith (map hsTyVarBindName ts) $ do
+        updateWith (map (toName TypeVal) $ map hsTyVarBindName ts) $ do
hunk ./src/FrontEnd/Rename.hs 394
-
-class UpdateTable a where
-    updateWith :: a -> RM b -> RM b
-    updateWith x action = getUpdates x >>= flip withSubTable action
-
-    getUpdates :: a -> RM SubTable
-    getUpdates x = Map.unions `fmap` mapM clobberName (getNames x)
-
-    getNames :: a -> [HsName]
-    getNames a = []
-
-
-
-instance UpdateTable a => UpdateTable [a] where
-    getUpdates xs = Map.unions `fmap` mapM getUpdates xs
-    getNames xs = concatMap getNames xs
-
-instance UpdateTable HsName where
-    getNames x = [x]
-
hunk ./src/FrontEnd/Rename.hs 398
-
hunk ./src/FrontEnd/Rename.hs 406
-
-
hunk ./src/FrontEnd/Rename.hs 407
-    rename (a,b) = return (,) `ap` rename a `ap` rename b
-
+    rename (a,b) = (,) <$> rename a <*> rename b
hunk ./src/FrontEnd/Rename.hs 411
-    rename (Just x) = fmap Just $ rename x
-
-
-
-
-
+    rename (Just x) = Just <$> rename x
hunk ./src/FrontEnd/Rename.hs 423
-        hsName' <- rename hsName
-        updateWith hsPats  $ do
+        hsName' <- renameValName hsName
+        updateWithN Val hsPats  $ do
hunk ./src/FrontEnd/Rename.hs 426
-        updateWith hsDecls $ do
+        updateWithN Val hsDecls $ do
hunk ./src/FrontEnd/Rename.hs 434
-    rename (HsPVar hsName) = HsPVar `fmap` rename hsName
-    rename (HsPInfixApp hsPat1 hsName hsPat2)  = return HsPInfixApp `ap` rename hsPat1 `ap` rename hsName `ap` rename hsPat2
-    rename (HsPApp hsName hsPats) = HsPApp <$> rename hsName <*> rename hsPats
+    rename (HsPVar hsName) = HsPVar `fmap` renameValName hsName
+    rename (HsPInfixApp hsPat1 hsName hsPat2) = HsPInfixApp <$> rename hsPat1 <*> renameValName hsName <*> rename hsPat2
+    rename (HsPApp hsName hsPats) = HsPApp <$> renameValName hsName <*> rename hsPats
hunk ./src/FrontEnd/Rename.hs 438
-        hsName' <- rename hsName
+        hsName' <- renameValName hsName
hunk ./src/FrontEnd/Rename.hs 440
-        fls <- gets fieldLabels
+        fls <- asks envFieldLabels
hunk ./src/FrontEnd/Rename.hs 442
-    rename (HsPAsPat hsName hsPat) = HsPAsPat <$> rename hsName <*> rename hsPat
+    rename (HsPAsPat hsName hsPat) = HsPAsPat <$> renameValName hsName <*> rename hsPat
hunk ./src/FrontEnd/Rename.hs 466
-        gt <- gets globalSubTable      -- field names are not shadowed by local definitions.
-        hsName' <- renameHsName hsName gt
+        --gt <- gets globalSubTable      -- field names are not shadowed by local definitions.
+        hsName' <- renameName (toName FieldLabel hsName) --renameHsName hsName gt
hunk ./src/FrontEnd/Rename.hs 473
-    rename (HsUnGuardedRhs hsExp) = fmap HsUnGuardedRhs $ rename hsExp
-    rename (HsGuardedRhss rs) = fmap HsGuardedRhss $ rename rs
+    rename (HsUnGuardedRhs hsExp) = HsUnGuardedRhs <$> rename hsExp
+    rename (HsGuardedRhss rs) = HsGuardedRhss <$> rename rs
hunk ./src/FrontEnd/Rename.hs 489
-    let hsName'' = (Qual mod (HsIdent $ show unique {- ++ fromHsName hsName' -} ++ "_var@"))
+    --let hsName'' = (Qual mod (HsIdent $ show unique {- ++ fromHsName hsName' -} ++ "_var@"))
+    let hsName'' = toName Val (mod,show unique ++ "_var@")
hunk ./src/FrontEnd/Rename.hs 495
-    rename (HsVar hsName) = return HsVar `ap` rename hsName
-    rename (HsCon hsName) = return HsCon `ap` rename hsName
+    rename (HsVar hsName) = HsVar <$> renameValName hsName
+    rename (HsCon hsName) = HsCon <$> renameValName hsName
hunk ./src/FrontEnd/Rename.hs 503
-        updateWith hsPats $ do
+        updateWithN Val hsPats $ do
hunk ./src/FrontEnd/Rename.hs 508
-        updateWith hsDecls $ do
+        updateWithN Val hsDecls $ do
hunk ./src/FrontEnd/Rename.hs 513
-    rename (HsCase hsExp hsAlts) = do return HsCase `ap` rename hsExp `ap` rename hsAlts
+    rename (HsCase hsExp hsAlts) = do HsCase <$> rename hsExp <*> rename hsAlts
hunk ./src/FrontEnd/Rename.hs 518
-        hsName' <- rename hsName
+        hsName' <- renameValName hsName
hunk ./src/FrontEnd/Rename.hs 520
-        fls <- gets fieldLabels
+        fls <- asks envFieldLabels
hunk ./src/FrontEnd/Rename.hs 525
-        fls <- gets fieldLabels
+        fls <- asks envFieldLabels
hunk ./src/FrontEnd/Rename.hs 540
-    rename (HsAsPat hsName hsExp) = return HsAsPat `ap` rename hsName `ap` rename hsExp
+    rename (HsAsPat hsName hsExp) = HsAsPat <$> renameValName hsName <*> rename hsExp
hunk ./src/FrontEnd/Rename.hs 598
-        updateWith hsPat $ do
+        updateWithN Val hsPat $ do
hunk ./src/FrontEnd/Rename.hs 600
-        updateWith hsDecls $ do
+        updateWithN Val hsDecls $ do
hunk ./src/FrontEnd/Rename.hs 637
-        gt <- gets globalSubTable              -- field names are global and not shadowed
-        hsName' <- renameHsName hsName gt      -- TODO field names should have own namespace
+--        gt <- gets globalSubTable              -- field names are global and not shadowed
+ --       hsName' <- renameHsName hsName gt      -- TODO field names should have own namespace
+        hsName' <- renameName (toName FieldLabel hsName)      -- TODO field names should have own namespace
hunk ./src/FrontEnd/Rename.hs 643
-instance Rename HsName where
-    rename n = do
-        subTable <- asks envSubTable
-        renameHsName n subTable
+--instance Rename HsName where
+--    rename n = do
+--        subTable <- asks envSubTable
+--        renameHsName n subTable
+renameValName :: HsName -> RM HsName
+renameValName hsName = renameName (fromValishHsName hsName)
hunk ./src/FrontEnd/Rename.hs 651
-renameTypeName hsName = do
-    t <- gets typeSubTable
-    subTable <- asks envSubTable
-    case Map.lookup hsName t of
-        Just _ -> renameHsName hsName t
-        Nothing -> renameHsName hsName subTable
+renameTypeName hsName = renameName (fromTypishHsName hsName)
+
+renameName :: Name -> RM Name
+renameName n = do
+    st <- asks envSubTable
+    renameHsName n st
hunk ./src/FrontEnd/Rename.hs 664
-    | Qual (Module ('@':m)) (HsIdent i) <- hsName = return $ Qual (Module m) (HsIdent i)
+    -- | Qual (Module ('@':m)) (HsIdent i) <- hsName = return $ Qual (Module m) (HsIdent i)
+    | (nt,Just ('@':m),i) <- nameParts hsName = return $ toName nt (Module m, i)
hunk ./src/FrontEnd/Rename.hs 667
-    Just name@(Qual _ _) -> return name
+    Just name@(getModule -> Just _) -> return name
hunk ./src/FrontEnd/Rename.hs 682
-
hunk ./src/FrontEnd/Rename.hs 686
-    let hsName'     = renameAndQualify hsName unique currModule
+    let hsName' = renameAndQualify hsName unique currModule
hunk ./src/FrontEnd/Rename.hs 691
-renameAndQualify name unique currentMod
-    = case renameName name unique of
-           UnQual name' -> Qual currentMod name'
-           qual_name    -> qual_name
-
--- renames a haskell name with its unique number
-renameName :: HsName -> Int -> HsName
-renameName n unique = hsNameIdent_u (hsIdentString_u ((show unique ++ "_") ++)) n
+renameAndQualify name unique currentMod = qualifyName currentMod (renameName name unique) where
+    renameName n unique = mapName (id,((show unique ++ "_") ++)) n
hunk ./src/FrontEnd/Rename.hs 695
-
hunk ./src/FrontEnd/Rename.hs 696
-unRename name
-   = case isRenamed name of
-          False -> name
-          True  -> case name of
-                      UnQual i   -> UnQual   $ unrenameIdent i
-                      Qual mod i -> Qual mod $ unrenameIdent i
-
-unrenameIdent :: HsIdentifier -> HsIdentifier
-unrenameIdent = hsIdentString_u unRenameString
-
-isRenamed :: HsName -> Bool
-isRenamed (UnQual i)    = isIdentRenamed i
-isRenamed (Qual _mod i) = isIdentRenamed i
-
--- an identifier is renamed if it starts with one or more digits
--- such an identifier would normally be illegal in Haskell
-isIdentRenamed :: HsIdentifier -> Bool
-isIdentRenamed i = not $ null $ takeWhile isDigit $ hsIdentString i
+unRename name = mapName (id,unRenameString) name
hunk ./src/FrontEnd/Rename.hs 698
+unRenameString :: String -> String
+unRenameString s@((isDigit -> False):_) = s
+unRenameString s = (dropUnderscore . dropDigits) s where
+    dropUnderscore ('_':rest) = rest
+    dropUnderscore otherList = otherList
+    dropDigits = dropWhile isDigit
hunk ./src/FrontEnd/Rename.hs 705
+updateWithN nt x action = getUpdatesN nt x >>= flip withSubTable action
+getUpdatesN nt x = Map.unions `fmap` mapM clobberName (map (toName nt) $ getNames x)
hunk ./src/FrontEnd/Rename.hs 708
+updateWith x action = getUpdates x >>= flip withSubTable action
+getUpdates x = Map.unions `fmap` mapM clobberName (getNames x)
hunk ./src/FrontEnd/Rename.hs 711
-unRenameString :: String -> String
-unRenameString s = (dropUnderscore . dropDigits) s where
-   dropUnderscore ('_':rest) = rest
-   dropUnderscore otherList = otherList
-   dropDigits = dropWhile isDigit
+class UpdateTable a where
+    getNames :: a -> [HsName]
+    getNames a = []
hunk ./src/FrontEnd/Rename.hs 715
+instance UpdateTable a => UpdateTable [a] where
+    getNames xs = concatMap getNames xs
hunk ./src/FrontEnd/Rename.hs 718
---------------------------------------------------------
-----This section of code updates the current SubTable to reflect the present scope
+instance UpdateTable HsName where
+    getNames x = [x]
hunk ./src/FrontEnd/Rename.hs 722
-    getNames hsDecl = fsts $  getHsNamesAndASrcLocsFromHsDecl hsDecl
-
+    getNames hsDecl = fsts $ getHsNamesAndASrcLocsFromHsDecl hsDecl
hunk ./src/FrontEnd/Rename.hs 725
-
hunk ./src/FrontEnd/Rename.hs 726
-    getNames hsStmt = fsts $  getHsNamesAndASrcLocsFromHsStmt hsStmt
-
-
+    getNames hsStmt = fsts $ getHsNamesAndASrcLocsFromHsStmt hsStmt
+instance UpdateTable HsQualType where
+    getNames (HsQualType _hsContext hsType) = getNames hsType
+instance UpdateTable HsType where
+    getNames t = execWriter (getNamesFromType t)  where
+        getNamesFromType (HsTyVar hsName) = tell [fromTypishHsName hsName]
+        getNamesFromType t = traverseHsType_ getNamesFromType t
hunk ./src/FrontEnd/Rename.hs 735
-getHsNamesAndASrcLocsFromHsDecl (HsPatBind srcLoc (HsPVar hsName) _ _) = [(hsName, srcLoc)]
-getHsNamesAndASrcLocsFromHsDecl (HsPatBind sloc _ _ _) = error $ "non simple pattern binding found (sloc): " ++ show sloc
-getHsNamesAndASrcLocsFromHsDecl (HsFunBind hsMatches) = getHsNamesAndASrcLocsFromHsMatches hsMatches
-getHsNamesAndASrcLocsFromHsDecl (HsForeignDecl a _ n _) = [(n,a)]
-getHsNamesAndASrcLocsFromHsDecl _otherHsDecl = []
-
-getHsNamesAndASrcLocsFromHsMatches :: [HsMatch] -> [(HsName, SrcLoc)]
-getHsNamesAndASrcLocsFromHsMatches [] = []
-getHsNamesAndASrcLocsFromHsMatches (hsMatch:_hsMatches) = getHsNamesAndASrcLocsFromHsMatch hsMatch
+getHsNamesAndASrcLocsFromHsDecl d = f d where
+    f (HsPatBind srcLoc (HsPVar hsName) _ _) = [(fromValishHsName hsName, srcLoc)]
+    f (HsPatBind sloc _ _ _) = error $ "non simple pattern binding found (sloc): " ++ show sloc
+    f (HsFunBind (HsMatch { .. }:_)) = [(fromValishHsName hsMatchName,hsMatchSrcLoc)]
+    f (HsForeignDecl { .. }) = [(fromValishHsName hsDeclName, hsDeclSrcLoc)]
+    f _ = []
hunk ./src/FrontEnd/Rename.hs 742
-getHsNamesAndASrcLocsFromHsMatch :: HsMatch -> [(HsName, SrcLoc)]
-getHsNamesAndASrcLocsFromHsMatch (HsMatch srcLoc hsName _ _ _) = [(hsName, srcLoc)]
hunk ./src/FrontEnd/Rename.hs 744
--- | Collect all names defined in a module as well as their declaration points and
--- any subnames they might have.
+-- | Collect all names defined in a module as well as their declaration points
+-- and any subnames they might have. In addition, collect the arities of any
+-- constructors.
hunk ./src/FrontEnd/Rename.hs 749
-collectDefsHsModule m = execWriter (mapM_ f (hsModuleDecls m)) where
-    --g (b,n,sl,ns) = (b,mod n, sl, map mod ns)
-    mod = qualifyName (hsModuleName m)
-    toName t n = Name.toName t (mod n)
-    -- f :: HsDecl -> Writer [(Name,SrcLoc,[Name])] ()
-    tellF xs = tell (xs,[]) >> return ()
-    tellS xs = tell ([],xs) >> return ()
-    f (HsForeignDecl a _ n _)  = tellF [(toName Val n,a,[])]
-    f (HsForeignExport a e _ _)  = tellF [(ffiExportName e,a,[])]
+collectDefsHsModule m = (\ (x,y) -> (Seq.toList x,Seq.toList y)) $ execWriter (mapM_ f (hsModuleDecls m)) where
+    toName t n = Name.toName t (qualifyName (hsModuleName m) n)
+    tellName sl n = tellF [(n,sl,[])]
+    tellF xs = tell (Seq.fromList xs,Seq.empty) >> return ()
+    tellS xs = tell (Seq.empty,Seq.fromList xs) >> return ()
+    f (HsForeignDecl a _ n _)  = tellName a (toName Val n)
+    f (HsForeignExport a e _ _)  = tellName a (ffiExportName e)
hunk ./src/FrontEnd/Rename.hs 757
-    f (HsFunBind (HsMatch a n _ _ _:_))  = tellF [(toName Val n,a,[])]
-    f (HsPatBind srcLoc p _ _) = tellF [ (toName Val n,srcLoc,[]) | n <- (getNamesFromHsPat p) ]
-    f (HsActionDecl srcLoc p _) = tellF [ (toName Val n,srcLoc,[]) | n <- (getNamesFromHsPat p) ]
-    f (HsTypeDecl sl n _ _) = tellF [(toName TypeConstructor n,sl,[])]
+    f (HsFunBind (HsMatch a n _ _ _:_))  = tellName a (toName Val n)
+    f (HsPatBind srcLoc p _ _)  = mapM_ (tellName srcLoc) [ (toName Val n) | n <- (getNamesFromHsPat p) ]
+    f (HsActionDecl srcLoc p _) = mapM_ (tellName srcLoc) [ (toName Val n) | n <- (getNamesFromHsPat p) ]
+    f (HsTypeDecl sl n _ _) = tellName sl (toName TypeConstructor n)
hunk ./src/FrontEnd/Rename.hs 766
-    f cd@(HsClassDecl sl _ ds) = tellF $ (toName Name.ClassName (nameName z),sl,snub $ fsts cs):[ (n,a,[]) | (n,a) <- cs]  where
+    f cd@(HsClassDecl sl _ ds) = tellF $ (toName ClassName z,sl,snub $ fsts cs):[ (n,a,[]) | (n,a) <- cs]  where
hunk ./src/FrontEnd/Rename.hs 770
-        cs = fst (mconcatMap (namesHsDeclTS' toName) ds)
+        cs = (mconcatMap (namesHsDeclTS' toName) ds)
hunk ./src/FrontEnd/Rename.hs 774
-          cs = fst (mconcatMap (namesHsDeclTS' toName) ds)
+          cs = (mconcatMap (namesHsDeclTS' toName) ds)
hunk ./src/FrontEnd/Rename.hs 789
-namesHsDeclTS' toName (HsTypeSig sl ns _) = ((map (rtup sl . toName Val) ns),[])
-namesHsDeclTS' toName (HsTypeDecl sl n _ _) = ([(toName TypeConstructor n,sl)],[])
-namesHsDeclTS' _ _ = ([],[])
-
+namesHsDeclTS' toName (HsTypeSig sl ns _) = (map ((,sl) . toName Val) ns)
+namesHsDeclTS' toName (HsTypeDecl sl n _ _) = [(toName TypeConstructor n,sl)]
+namesHsDeclTS' _ _ = []
hunk ./src/FrontEnd/Rename.hs 794
-namesHsDecl (HsForeignDecl a _ n _)  = ([(n,a)],[])
-namesHsDecl (HsFunBind hsMatches)  = (getHsNamesAndASrcLocsFromHsMatches hsMatches, [])
-namesHsDecl (HsPatBind srcLoc p _ _) = (map (rtup srcLoc) (getNamesFromHsPat p),[])
-namesHsDecl (HsTypeDecl sl n _ _) = ([],[(n,sl)])
-namesHsDecl HsDataDecl { hsDeclSrcLoc = sl, hsDeclName = n, hsDeclCons = cs } = ( (concatMap namesHsConDecl cs) ,[(n,sl)])
-namesHsDecl (HsNewTypeDecl sl _ n _ c _) = ( (namesHsConDecl c),[(n,sl)])
-namesHsDecl cd@(HsClassDecl sl _ ds) = (mconcatMap namesHsDeclTS ds) `mappend` ([],[(nameName z,sl)]) where
+namesHsDecl (HsForeignDecl a _ n _)  = ([(fromValishHsName n,a)],[])
+namesHsDecl decl@(HsFunBind {})  = (getHsNamesAndASrcLocsFromHsDecl decl,  [])
+namesHsDecl (HsPatBind srcLoc p _ _) = (map (,srcLoc) (getNamesFromHsPat p),[])
+namesHsDecl (HsTypeDecl sl n _ _) = ([],[(fromTypishHsName n,sl)])
+namesHsDecl HsDataDecl { hsDeclSrcLoc = sl, hsDeclName = n, hsDeclCons = cs } = ( (concatMap namesHsConDecl cs) ,[(fromTypishHsName n,sl)])
+namesHsDecl (HsNewTypeDecl sl _ n _ c _) = ( (namesHsConDecl c),[(fromTypishHsName n,sl)])
+namesHsDecl cd@(HsClassDecl sl _ ds) = (mconcatMap namesHsDeclTS ds) `mappend` ([],[(z,sl)]) where
hunk ./src/FrontEnd/Rename.hs 807
-namesHsDeclTS (HsTypeSig sl ns _) = ((map (rtup sl) ns),[])
+namesHsDeclTS (HsTypeSig sl ns _) = ((map (,sl) ns),[])
hunk ./src/FrontEnd/Rename.hs 810
-namesHsConDecl c = (hsConDeclName c,hsConDeclSrcLoc c) : case c of
+namesHsConDecl c = (fromValishHsName $ hsConDeclName c,hsConDeclSrcLoc c) : case c of
hunk ./src/FrontEnd/Rename.hs 820
-instance UpdateTable HsQualType where
-    getNames (HsQualType _hsContext hsType) = getNames hsType
+-----------
+-- RM Monad
+-----------
hunk ./src/FrontEnd/Rename.hs 824
-instance UpdateTable HsType where
-    getNames t = execWriter (getNamesFromType t)  where
-        getNamesFromType (HsTyVar hsName) = tell [hsName]
-        getNamesFromType t = traverseHsType_ getNamesFromType t
hunk ./src/FrontEnd/Rename.hs 825
+newtype RM a = RM (RWS Env [Warning] ScopeState a)
+    deriving(Monad,Functor,MonadReader Env, MonadWriter [Warning], MonadState ScopeState)
+
+unRM (RM x) = x
+
+instance Applicative RM where
+    pure = return
+    (<*>) = ap
+
+instance MonadWarn RM where
+    addWarning w = tell [w]
+
+instance UniqueProducer RM where
+    newUniq = do
+        u <- gets unique
+        modify (\s -> s {unique = unique s + 1})
+        return u
hunk ./src/FrontEnd/Rename.hs 843
-qualifyName :: Module -> HsName -> HsName
-qualifyName _ name@(Qual {}) = name
-qualifyName mod (UnQual name) = Qual mod name
+getCurrentModule :: RM Module
+getCurrentModule = asks envModule
hunk ./src/FrontEnd/Rename.hs 846
+instance MonadSrcLoc RM where
+    getSrcLoc = asks envSrcLoc
+instance MonadSetSrcLoc RM where
+    withSrcLoc sl a = local (\s -> s { envSrcLoc = sl `mappend` envSrcLoc s}) a
+instance OptionMonad RM where
+    getOptions = asks envOptions
hunk ./src/FrontEnd/Representation.hs 213
-instance FromTupname HsName where
-    fromTupname (Qual (Module "Jhc.Basics") (HsIdent xs))  = fromTupname xs
-    fromTupname _ = fail "fromTupname: not Prelude"
+--instance FromTupname HsName where
+--    fromTupname (Qual (Module "Jhc.Basics") (HsIdent xs))  = fromTupname xs
+--    fromTupname _ = fail "fromTupname: not Prelude"
hunk ./src/FrontEnd/Representation.hs 217
-instance ToTuple HsName where
-    toTuple n = (Qual (Module "Jhc.Basics") (HsIdent $ toTuple n))
+--instance ToTuple HsName where
+--    toTuple n = (Qual (Module "Jhc.Basics") (HsIdent $ toTuple n))
hunk ./src/FrontEnd/Representation.hs 222
-instance DocLike d => PPrint d HsName where
-   pprint (Qual mod ident)
+--instance DocLike d => PPrint d HsName where
+--   pprint (Qual mod ident)
hunk ./src/FrontEnd/Representation.hs 225
-      | mod == Module "Prelude" = pprint ident
-      | otherwise               = pprint mod <> text "." <> pprint ident
-   pprint (UnQual ident)
-      = pprint ident
+--      | mod == Module "Prelude" = pprint ident
+--      | otherwise               = pprint mod <> text "." <> pprint ident
+--   pprint (UnQual ident)
+--      = pprint ident
hunk ./src/FrontEnd/Representation.hs 233
-instance DocLike d => PPrint d HsIdentifier where
-   pprint (HsIdent   s) = text s
+--instance DocLike d => PPrint d HsIdentifier where
+--   pprint (HsIdent   s) = text s
hunk ./src/FrontEnd/Syn/Traverse.hs 13
-instance FreeVars HsType (Set.Set HsName) where
-    freeVars t = execWriter (f t) where
-        f (HsTyVar v) = tell (Set.singleton v)
-        f t = traverseHsType_ f t
+--instance FreeVars HsType (Set.Set HsName) where
+--    freeVars t = execWriter (f t) where
+--        f (HsTyVar v) = tell (Set.singleton v)
+--        f t = traverseHsType_ f t
hunk ./src/FrontEnd/Syn/Traverse.hs 276
-    getNamesFromPat (HsPVar hsName) = tell [hsName]
+    getNamesFromPat (HsPVar hsName) = tell [toName Val hsName]
hunk ./src/FrontEnd/Syn/Traverse.hs 278
-        tell [hsName]
+        tell [toName Val hsName]
hunk ./src/FrontEnd/Tc/Main.hs 134
-isTypePlaceholder (Qual (Module "Wild@") _) = True
-isTypePlaceholder (Qual (Module "As@") _) = True
+isTypePlaceholder (getModule -> Just (Module m)) = m `elem` ["Wild@","As@"]
hunk ./src/FrontEnd/Tc/Main.hs 288
-    (_,exps') <- tcApps (HsCon (toTuple (length exps))) exps typ
+    --(_,exps') <- tcApps (HsCon (toTuple (length exps))) exps typ
+    (_,exps') <- tcApps (HsCon (nameTuple TypeConstructor (length exps))) exps typ
hunk ./src/FrontEnd/Tc/Main.hs 510
-tiPat tuple@(HsPTuple pats) typ = tiPat (HsPApp (toTuple (length pats)) pats) typ
+tiPat tuple@(HsPTuple pats) typ = tiPat (HsPApp (nameTuple DataConstructor (length pats)) pats) typ
hunk ./src/FrontEnd/TypeSynonyms.hs 113
-        let nvs = [ (hsTyVarBindName v,v { hsTyVarBindName = hsNameIdent_u (hsIdentString_u ((show n ++ "00") ++)) (hsTyVarBindName v)})| (n,v) <- zip ns vs ]
+        let nvs = [ (hsTyVarBindName v,v { hsTyVarBindName = hsNameIdent_u ((show n ++ "00") ++) (hsTyVarBindName v)})| (n,v) <- zip ns vs ]
hunk ./src/FrontEnd/TypeSyns.hs 8
+import Name.Name
hunk ./src/Ho/Build.hs 31
+import Name.Name
hunk ./src/Ho/Library.hs 26
-import FrontEnd.HsSyn(Module)
+import Name.Name(Module)
hunk ./src/Ho/Type.hs 15
-import FrontEnd.HsSyn(Module)
hunk ./src/Ho/Type.hs 17
-import Name.Name(Name)
+import Name.Name(Name,Module)
hunk ./src/Main.hs 16
-import FrontEnd.HsSyn(Module(..))
hunk ./src/Name/Name.hs 7
+    getIdent,
hunk ./src/Name/Name.hs 16
-    Module,
+    Module(..),
+    fromModule,
hunk ./src/Name/Name.hs 28
-import Data.Typeable
+import Data.Data
hunk ./src/Name/Name.hs 36
-import FrontEnd.HsSyn
hunk ./src/Name/Name.hs 51
-    deriving(Ord,Eq,Typeable,Binary,ToAtom,FromAtom)
+    deriving(Ord,Eq,Typeable,Binary,Data,ToAtom,FromAtom)
hunk ./src/Name/Name.hs 62
-isConstructorLike xs@(x:_) =  isUpper x || x `elem` ":("  || xs == "->"
-isConstructorLike [] = error "isConstructorLike: empty"
+isConstructorLike n =  isUpper x || x `elem` ":("  || xs == "->" || xs == "[]" where
+    (_,_,xs@(x:_)) = nameParts n
+--isConstructorLike [] = error "isConstructorLike: empty"
hunk ./src/Name/Name.hs 66
+fromTypishHsName, fromValishHsName :: Name -> Name
+fromTypishHsName name
+    | isConstructorLike name = toName TypeConstructor name
+    | otherwise = toName TypeVal name
+fromValishHsName name
+    | isConstructorLike name = toName DataConstructor name
+    | otherwise = toName Val name
+{-
hunk ./src/Name/Name.hs 83
+    -}
hunk ./src/Name/Name.hs 96
-instance ToName HsName where
-    toName nt n = m where
-        i = hsIdentString $ hsNameIdent n
-        m | Qual (Module m) _ <- n = createName nt m i
-          | otherwise = createUName nt i
-    fromName n = (nameType n, nameName n)
+--instance ToName HsName where
+--    toName nt n = m where
+--        i = hsIdentString $ hsNameIdent n
+--        m | Qual (Module m) _ <- n = createName nt m i
+--          | otherwise = createUName nt i
+--    fromName n = (nameType n, nameName n)
hunk ./src/Name/Name.hs 109
+instance ToName (Module,String) where
+    toName nt (Module m,i) = createName nt m i
+    fromName n = case nameParts n of
+            (nt,Just m,i) -> (nt,(Module m,i))
+            (nt,Nothing,i) -> (nt,(Module "",i))
+
hunk ./src/Name/Name.hs 127
+instance ToName Name where
+    toName nt i = toName nt (x,y) where
+        (_,x,y) = nameParts i
+    fromName n = (nameType n,n)
+
hunk ./src/Name/Name.hs 145
+getIdent :: Name -> String
+getIdent n = case nameParts n of
+    (_,_,s)  -> s
+
hunk ./src/Name/Name.hs 152
-    (t,Just _,i) -> toName t i
+    (t,Just _,i) -> toName t (Nothing :: Maybe String,i)
hunk ./src/Name/Name.hs 174
-nameName :: Name -> HsName
-nameName (Name a) = f $ tail (fromAtom a) where
-    f (';':xs) = UnQual $ HsIdent xs
-    f xs | (a,_:b) <- span (/= ';') xs  = Qual (Module a) (HsIdent b)
-    f _ = error $ "invalid Name: " ++ (show $ (fromAtom a :: String))
+nameName :: Name -> Name
+nameName n = n
+--nameName (Name a) = f $ tail (fromAtom a) where
+--    f (';':xs) = UnQual $ HsIdent xs
+--    f xs | (a,_:b) <- span (/= ';') xs  = Qual (Module a) (HsIdent b)
+--    f _ = error $ "invalid Name: " ++ (show $ (fromAtom a :: String))
hunk ./src/Name/Name.hs 188
-    show a = show $ nameName a
+    showsPrec _ n = case nameParts n of
+        (_,Just a,b) -> showString a . showChar '.' . showString b
+        (_,Nothing,b) -> showString b
hunk ./src/Name/Name.hs 207
+newtype Module = Module String
+  deriving(Eq,Data,Typeable,Ord,ToAtom,FromAtom)
+
+instance Show Module where
+    showsPrec _ (Module n) = showString n
+
+fromModule (Module s) = s
hunk ./src/StringTable/Atom.hsc 35
+import Data.Data
hunk ./src/StringTable/Atom.hsc 40
-    deriving(Typeable,Eq,Ord)
+    deriving(Typeable,Eq,Data,Ord)