[don't desugar list comprehensions until after renaming has occured, always bind to the prelude functions in list comprehension expansion
John Meacham <john@repetae.net>**20090228034520
 Ignore-this: eb81f6946c340c9681b57b755807e9b0
] hunk ./FrontEnd/Desugar.hs 259
-    f name (HsPRec conName fields) = HsPRec conName [ HsPFieldPat fname (f name pat) 
+    f name (HsPRec conName fields) = HsPRec conName [ HsPFieldPat fname (f name pat)
hunk ./FrontEnd/Desugar.hs 434
-listCompToExp :: HsExp -> [HsStmt] -> HsExp
-listCompToExp exp ss = hsParen (f ss) where
-    f [] = HsList [exp]
+listCompToExp :: Monad m => m HsName -> HsExp -> [HsStmt] -> m HsExp
+listCompToExp newName exp ss = hsParen `liftM` f ss where
+    f [] = return $ HsList [exp]
hunk ./FrontEnd/Desugar.hs 438
-    f ((HsLetStmt ds):ss) = hsParen (HsLet ds (f ss))
-    f (HsQualifier e:ss) = hsParen (HsIf e (f ss) (HsList []))
-    f ((HsGenerator srcLoc pat e):ss) | isLazyPat pat, Just exp' <- g ss = hsParen $ HsApp (HsApp (HsVar f_map)  (hsParen $ HsLambda srcLoc [pat] exp')) e
+    f ((HsLetStmt ds):ss) = do ss' <- f ss; return $ hsParen (HsLet ds ss')
+    f (HsQualifier e:ss) = do ss' <- f ss; return $ hsParen (HsIf e ss' (HsList []))
+    f ((HsGenerator srcLoc pat e):ss) | isLazyPat pat, Just exp' <- g ss = do
+        return $ hsParen $ HsVar f_map `app` HsLambda srcLoc [pat] exp' `app` e
hunk ./FrontEnd/Desugar.hs 443
-    f ((HsGenerator srcLoc pat e):HsQualifier q:ss) | isLazyPat pat, Just exp' <- g ss =  hsApp (HsVar f_foldr)  [HsLambda srcLoc [pat,HsPVar newPatVarName] $ hsIf q (hsApp (HsCon con_cons) [exp',patVar]) (HsVar newPatVarName), HsList [],e]
-    f ((HsGenerator srcLoc pat e):ss) | isLazyPat pat = hsParen $ HsApp (HsApp (HsVar f_concatMap)  (hsParen $ HsLambda srcLoc [pat] (f ss))) e
-    f ((HsGenerator srcLoc pat e):HsQualifier q:ss) | isFailablePat pat || Nothing == (g ss) = hsParen $ HsApp (HsApp (HsVar f_concatMap)  (hsParen $ HsLambda srcLoc [HsPVar newPatVarName] kase)) e where
-        kase = HsCase (HsVar newPatVarName) [a1, a2 ]
-        a1 =  HsAlt srcLoc pat (HsGuardedRhss [HsGuardedRhs srcLoc q (f ss)]) []
-        a2 =  HsAlt srcLoc HsPWildCard (HsUnGuardedRhs $ HsList []) []
-    f ((HsGenerator srcLoc pat e):ss) | isFailablePat pat || Nothing == (g ss) = hsParen $ HsApp (HsApp (HsVar f_concatMap)  (hsParen $ HsLambda srcLoc [HsPVar newPatVarName] kase)) e where
-        kase = HsCase (HsVar newPatVarName) [a1, a2 ]
-        a1 =  HsAlt srcLoc pat (HsUnGuardedRhs (f ss)) []
-        a2 =  HsAlt srcLoc HsPWildCard (HsUnGuardedRhs $ HsList []) []
-    f ((HsGenerator srcLoc pat e):ss)  = hsParen $ HsApp (HsApp (HsVar f_map)  (hsParen $ HsLambda srcLoc [HsPVar newPatVarName] kase)) e where
-        Just exp' = g ss
-        kase = HsCase (HsVar newPatVarName) [a1 ]
-        a1 =  HsAlt srcLoc pat (HsUnGuardedRhs exp') []
+    f ((HsGenerator srcLoc pat e):HsQualifier q:ss) | isLazyPat pat, Just exp' <- g ss = do
+        npvar <- newName
+        return $ hsApp (HsVar f_foldr)  [HsLambda srcLoc [pat,HsPVar npvar] $ hsIf q (hsApp (HsCon con_cons) [exp',HsVar npvar]) (HsVar npvar), HsList [],e]
+    f ((HsGenerator srcLoc pat e):ss) | isLazyPat pat = do
+        ss' <- f ss
+        return $ hsParen $ HsVar f_concatMap `app`  HsLambda srcLoc [pat] ss' `app` e
+    f ((HsGenerator srcLoc pat e):HsQualifier q:ss) | isFailablePat pat || Nothing == g ss = do
+        npvar <- newName
+        ss' <- f ss
+        let kase = HsCase (HsVar npvar) [a1, a2 ]
+            a1 =  HsAlt srcLoc pat (HsGuardedRhss [HsGuardedRhs srcLoc q ss']) []
+            a2 =  HsAlt srcLoc HsPWildCard (HsUnGuardedRhs $ HsList []) []
+        return $ hsParen $ HsVar f_concatMap `app`  HsLambda srcLoc [HsPVar npvar] kase `app`  e
+    f ((HsGenerator srcLoc pat e):ss) | isFailablePat pat || Nothing == g ss = do
+        npvar <- newName
+        ss' <- f ss
+        let kase = HsCase (HsVar npvar) [a1, a2 ]
+            a1 =  HsAlt srcLoc pat (HsUnGuardedRhs ss') []
+            a2 =  HsAlt srcLoc HsPWildCard (HsUnGuardedRhs $ HsList []) []
+        return $ hsParen $ HsVar f_concatMap `app` HsLambda srcLoc [HsPVar npvar] kase `app` e
+    f ((HsGenerator srcLoc pat e):ss) = do
+        npvar <- newName
+        let Just exp' = g ss
+            kase = HsCase (HsVar npvar) [a1 ]
+            a1 =  HsAlt srcLoc pat (HsUnGuardedRhs exp') []
+        return $ hsParen $ HsVar f_map `app` HsLambda srcLoc [HsPVar npvar] kase `app` e
hunk ./FrontEnd/Desugar.hs 474
-    f_concatMap = nameName $ toUnqualified v_concatMap
-    f_map = nameName $ toUnqualified v_map
-    f_foldr = nameName $ toUnqualified v_foldr
-    f_and = nameName $ toUnqualified v_and
-    con_cons = nameName $ toUnqualified dc_Cons
+    app x y = HsApp x (hsParen y)
+    f_concatMap = nameName v_concatMap
+    f_map = nameName v_map
+    f_foldr = nameName v_foldr
+    f_and = nameName v_and
+    con_cons = nameName dc_Cons
hunk ./FrontEnd/Rename.hs 528
-    --f (HsDo hsStmts) = return HsDo `ap` rename hsStmts
-    rename (HsList hsExps) = do
-        unique <- newUniq
-        hsExps' <- rename hsExps
-        mod <- getCurrentModule
-        let hsName' = Qual mod (HsIdent $ show unique ++ "_as@")
-        return (HsAsPat hsName' $ HsList hsExps')
hunk ./FrontEnd/Rename.hs 544
-        rename (listCompToExp hsExp hsStmts)
-        --updateWith hsStmts $ do
-        --    hsStmts' <- rename hsStmts
-        --    hsExp' <- rename hsExp
-        --    return (HsListComp hsExp' hsStmts')
+        (ss,e) <- renameHsStmts hsStmts (rename hsExp)
+        listCompToExp newVar e ss
hunk ./FrontEnd/Rename.hs 618
+renameHsStmts :: [HsStmt] -> RM a  -> RM ([HsStmt],a)
+renameHsStmts ss fe = f ss [] where
+    f (HsGenerator sl p e:ss) rs = do
+        e' <- rename e
+        updateWith p $ do
+          p' <- rename p
+          f ss (HsGenerator sl p' e':rs)
+    f (s:ss) rs = do
+        updateWith s $ do
+          s' <- rename s
+          f ss (s':rs)
+    f [] rs = do
+        e <- fe
+        return (reverse rs,e)
hunk ./FrontEnd/Rename.hs 634
+{-
+renameHsStmts (hsStmt:hsStmts) exp = do
+    updateWith hsStmt $ do
+      subTable' <- getUpdates hsStmt
+      withSubTable subTable' $ do
+      hsStmt' <- withSubTable subTable' $ rename hsStmt
+      (hsStmts',subTable'') <- renameHsStmts hsStmts subTable'
+      return ((hsStmt':hsStmts'),subTable'')
+renameHsStmts [] = do
+    fe <- exp
+    return ([],subTable)
+
hunk ./FrontEnd/Rename.hs 663
+ -}
hunk ./FrontEnd/Tc/Main.hs 120
+wrapInAsPatEnv :: HsExp -> Type -> Tc HsExp
+wrapInAsPatEnv e typ = do
+    (ne,ap) <- wrapInAsPat e
+    addToCollectedEnv (Map.singleton ap typ)
+    return ne
+
hunk ./FrontEnd/Tc/Main.hs 159
-    (ne,ap) <- wrapInAsPat (HsCase e' alts')
-    addToCollectedEnv (Map.singleton ap typ)
-    return ne
+    wrapInAsPatEnv (HsCase e' alts') typ
hunk ./FrontEnd/Tc/Main.hs 165
-    (ne,ap) <- wrapInAsPat (HsCon conName)
-    addToCollectedEnv (Map.singleton ap typ)
-    return ne
+    wrapInAsPatEnv (HsCon conName) typ
hunk ./FrontEnd/Tc/Main.hs 173
-    (ne,n) <- wrapInAsPat (HsLit l)
-    addToCollectedEnv (Map.singleton n ty)
-    return ne
+    wrapInAsPatEnv (HsLit l) ty
hunk ./FrontEnd/Tc/Main.hs 179
-    (ne,n) <- wrapInAsPat (HsLit l)
-    addToCollectedEnv (Map.singleton n typ)
-    return ne
+    wrapInAsPatEnv (HsLit l) typ
hunk ./FrontEnd/Tc/Main.hs 183
-    (ne,n) <- wrapInAsPat err
-    addToCollectedEnv (Map.singleton n typ)
-    return ne
+    wrapInAsPatEnv err typ
hunk ./FrontEnd/Tc/Main.hs 298
-    return (HsList [])
+    wrapInAsPatEnv (HsList []) (TAp c v)
hunk ./FrontEnd/Tc/Main.hs 305
-    return (HsList [])
+    wrapInAsPatEnv (HsList []) typ
hunk ./FrontEnd/Tc/Main.hs 310
-        return (HsList exps')
+        wrapInAsPatEnv (HsList exps') (TAp tList' v)
hunk ./FrontEnd/Tc/Main.hs 317
-        return (HsList exps')
+        wrapInAsPatEnv (HsList exps') typ