[move selector creation from desugar to renamer, detect multiply defined top level values and report an error properly.
John Meacham <john@repetae.net>**20100806021241
 Ignore-this: 507bce69ec8ffe0085c3a72ffc0ec571
] hunk ./src/FrontEnd/Desugar.hs 96
-desugarDecl dl@HsDataDecl { hsDeclSrcLoc = sloc, hsDeclName =  name, hsDeclArgs = args, hsDeclCons = condecls, hsDeclDerives = derives } = do
-        ss <- createSelectors sloc condecls
-        return $ dl:ss
-
-desugarDecl dl@(HsNewTypeDecl sloc cntxt name args condecl derives) = do
-        ss <- createSelectors sloc [condecl]
-        return $ dl:ss
hunk ./src/FrontEnd/Desugar.hs 102
-createSelectors _sloc ds = ans where
-    ds' :: [(HsName,[(HsName,HsBangType)])]
-    ds' = [ (c,[(n,t) | (ns,t) <- rs , n <- ns ]) | HsRecDecl { hsConDeclName = c, hsConDeclRecArg = rs } <- ds ]
-    ns = sortGroupUnderF fst $ concatMap f ds' -- [  | (c,nts) <- ds' ]
-    f ::  (HsName,[(HsName,HsBangType)]) -> [ (HsName, (HsName,Int,Int)) ]
-    f (c,nts) = [ (n,(c,i,length nts)) | (n,_) <- nts | i <- [0..]]
-    ans = return $  map g ns
-    g (n,cs) = HsFunBind (map f cs ++ [els]) where
-        f (_,(c,i,l)) = HsMatch _sloc n [pat c i l] (HsUnGuardedRhs (HsVar var)) []
-        pat c i l = HsPApp c [ if p == i then HsPVar var else HsPWildCard | p <- [0 .. l - 1]]
-        els = HsMatch _sloc n [HsPWildCard] (HsUnGuardedRhs HsError { hsExpSrcLoc = _sloc, hsExpString = show n, hsExpErrorType = HsErrorFieldSelect } ) []
-    var = nameName $ toName Val "x"
-
-
-
hunk ./src/FrontEnd/Rename.hs 48
-data ScopeState = ScopeState {
-    unique         :: {-# UNPACK #-} !Int,
-    errorTable     :: Map.Map HsName String
+newtype ScopeState = ScopeState {
+    unique         :: Int
hunk ./src/FrontEnd/Rename.hs 52
+data Context
+    = ContextTopLevel
+    | ContextInstance Name
+    | ContextLocal
+    deriving(Eq)
+
hunk ./src/FrontEnd/Rename.hs 60
+    errorTable     :: Map.Map HsName String,
hunk ./src/FrontEnd/Rename.hs 82
-        mult xs@(~((n,sl):_)) = warn sl "multiply-defined" (show n ++ " is defined multiple times: " ++ show xs )
-    --z cdefs
+        mult xs@(~((n,sl):_)) = warn sl "multiply-defined" (show n ++ " is defined multiple times: " ++ show xs)
+    z cdefs
hunk ./src/FrontEnd/Rename.hs 86
+createSelectors sloc ds = mapM g ns where
+    ds' :: [(HsName,[(HsName,HsBangType)])]
+    ds' = [ (c,[(n,t) | (ns,t) <- rs , n <- ns ]) | HsRecDecl { hsConDeclName = c, hsConDeclRecArg = rs } <- ds ]
+    ns = sortGroupUnderF fst $ concatMap f ds' -- [  | (c,nts) <- ds' ]
+    f (c,nts) = [ (n,(c,i,length nts)) | (n,_) <- nts | i <- [0..]]
+    g (n,cs) = do
+        var <- clobberedName (toName Val "_sel")
+        let f (_,(c,i,l)) = HsMatch sloc n [pat c i l] (HsUnGuardedRhs (HsVar var)) []
+            pat c i l = HsPApp c [ if p == i then HsPVar var else HsPWildCard | p <- [0 .. l - 1]]
+            els = HsMatch sloc n [HsPWildCard] (HsUnGuardedRhs HsError { hsExpSrcLoc = sloc, hsExpString = show n, hsExpErrorType = HsErrorFieldSelect } ) []
+        return $ HsFunBind (map f cs ++ [els]) where
hunk ./src/FrontEnd/Rename.hs 111
-    startState = ScopeState {
-        unique         = 1,
-        errorTable     = errorTab
-        }
+    startState = ScopeState { unique = 1 }
hunk ./src/FrontEnd/Rename.hs 114
+        errorTable     = errorTab,
hunk ./src/FrontEnd/Rename.hs 138
-    decls' <- rename (hsModuleDecls mod)
-    mapM_ HsErrors.hsDeclTopLevel decls'
+    decls' <- renameHsDecls ContextTopLevel (hsModuleDecls mod)
+--    mapM_ HsErrors.hsDeclTopLevel decls'
hunk ./src/FrontEnd/Rename.hs 197
+renameHsDecls :: Context -> [HsDecl] -> RM [HsDecl]
+renameHsDecls c ds = f ds where
+    f (d:ds) = do
+        d' <- rename d
+        when (c == ContextTopLevel) $ HsErrors.hsDeclTopLevel d'
+        eds <- g d'
+        ds' <- f ds
+        return $ d':eds ++ ds'
+    f [] = return []
+    g HsDataDecl { hsDeclSrcLoc = sloc, hsDeclCons = cs } = createSelectors sloc cs
+    g HsNewTypeDecl { hsDeclSrcLoc = sloc, hsDeclCon = c } = createSelectors sloc [c]
+    g _ = return []
+
hunk ./src/FrontEnd/Rename.hs 577
-desugarEnum s as = foldl HsApp (HsVar (nameName $ toName Val s)) as
+desugarEnum s as = foldl HsApp (HsVar (toName Val s)) as
hunk ./src/FrontEnd/Rename.hs 673
---instance Rename HsName where
---    rename n = do
---        subTable <- asks envSubTable
---        renameHsName n subTable
hunk ./src/FrontEnd/Rename.hs 679
-renameName :: Name -> RM Name
-renameName n = do
-    st <- asks envSubTable
-    renameHsName n st
hunk ./src/FrontEnd/Rename.hs 683
-renameHsName :: HsName -> SubTable -> RM (HsName)
-renameHsName hsName subTable
+renameName :: Name -> RM Name
+-- a few hard coded cases
+renameName hsName
hunk ./src/FrontEnd/Rename.hs 687
-    -- | Qual (Module ('@':m)) (HsIdent i) <- hsName = return $ Qual (Module m) (HsIdent i)
hunk ./src/FrontEnd/Rename.hs 688
-renameHsName hsName subTable = case mlookup hsName subTable of
-    Just name@(getModule -> Just _) -> return name
-    Just _ -> error "renameHsName"
-    Nothing
-        | Just n <- V.fromTupname hsName -> return hsName
-        | otherwise -> do
-            sl <- getSrcLoc
-            et <- gets errorTable
-            let err = case mlookup hsName et of {
-                Just s -> s;
-                Nothing -> "Unknown name: " ++ show hsName }
-            warn sl "undefined-name" err
-            -- e <- createError ("Undefined Name: " ++ show hsName)
-            return $ hsName
-            --return (Qual modName name)
+renameName hsName = do
+    subTable <- asks envSubTable
+    case mlookup hsName subTable of
+        Just name@(getModule -> Just _) -> return name
+        Just _ -> error "renameHsName"
+        Nothing
+            | Just n <- V.fromTupname hsName -> return hsName
+            | otherwise -> do
+                sl <- getSrcLoc
+                et <- asks errorTable
+                let err = case mlookup hsName et of {
+                    Just s -> s;
+                    Nothing -> "Unknown name: " ++ show hsName }
+                warn sl "undefined-name" err
+                -- e <- createError ("Undefined Name: " ++ show hsName)
+                return $ hsName
+                --return (Qual modName name)
+clobberedName :: Name -> RM Name
+clobberedName hsName = do
+    unique     <- newUniq
+    currModule <- getCurrentModule
+    return $ renameAndQualify hsName unique currModule
hunk ./src/FrontEnd/Rename.hs 713
-    unique     <- newUniq
-    currModule <- getCurrentModule
-    let hsName' = renameAndQualify hsName unique currModule
+    hsName' <- clobberedName hsName
hunk ./src/FrontEnd/Rename.hs 778
-    f (HsForeignDecl a _ n _)  = tellName a (toName Val n)
+    f (HsForeignDecl a _ n _)    = tellName a (toName Val n)
hunk ./src/FrontEnd/Tc/Module.hs 5
-import IO
-import List
-import Maybe
-import Monad