[improve desugaring of lambdas, do, and list comprehensions
John Meacham <john@repetae.net>**20061108223259] hunk ./FrontEnd/Desugar.hs 259
+patVarNames (HsPUnboxedTuple pats)
+   = concatMap patVarNames pats
hunk ./FrontEnd/Desugar.hs 290
+replaceVarNamesInPat name (HsPUnboxedTuple pats)
+   = HsPUnboxedTuple (map (replaceVarNamesInPat name) pats)
hunk ./FrontEnd/Desugar.hs 325
+
+
hunk ./FrontEnd/Desugar.hs 329
-    | all isHsPVar pats = do
+    | all isLazyPat pats = do
hunk ./FrontEnd/Desugar.hs 361
-        return (doToExp newStmts)
+        ss <- doToExp newStmts
+        return ss
hunk ./FrontEnd/Desugar.hs 430
-doToExp :: [HsStmt] -> HsExp
hunk ./FrontEnd/Desugar.hs 441
-doToExp [] = error "doToExp: empty statements in do notation"
-doToExp [HsQualifier e] = e
-doToExp [gen@(HsGenerator srcLoc _pat _e)]
-   = error $ "doToExp: last expression n do notation is a generator (srcLoc):" ++ show srcLoc
-doToExp [letst@(HsLetStmt _decls)]
-   = error $ "doToExp: last expression n do notation is a let statement"
-doToExp ((HsQualifier e):ss)
-   = HsInfixApp (hsParen e) (HsVar f_bind_) (hsParen $ doToExp ss)
-doToExp ((HsGenerator _srcLoc pat@(HsPVar {}) e):ss)
-   = HsInfixApp (hsParen e) (HsVar f_bind) (HsLambda _srcLoc [pat] (doToExp ss))
-doToExp ((HsGenerator srcLoc pat e):ss) = HsInfixApp (hsParen e) (HsVar f_bind) (HsLambda srcLoc [HsPVar newPatVarName] kase)  where
-   kase = HsCase (HsVar newPatVarName) [a1, a2 ]
-   a1 =  HsAlt srcLoc pat (HsUnGuardedRhs (doToExp ss)) []
-   a2 =  HsAlt srcLoc HsPWildCard (HsUnGuardedRhs (HsApp (HsVar f_fail) (HsLit $ HsString $ show srcLoc ++ " failed pattern match in do"))) []
-doToExp ((HsLetStmt decls):ss)
-   = HsLet decls (doToExp ss)
+doToExp :: Monad m => [HsStmt] -> m HsExp
+doToExp [] = fail "doToExp: empty statements in do notation"
+doToExp [HsQualifier e] = return e
+doToExp [gen@(HsGenerator srcLoc _pat _e)] = fail $ "doToExp: last expression n do notation is a generator (srcLoc):" ++ show srcLoc
+doToExp [letst@(HsLetStmt _decls)] = fail $ "doToExp: last expression n do notation is a let statement"
+doToExp ((HsQualifier e):ss) = do
+    ss <- doToExp ss
+    return $ HsInfixApp (hsParen e) (HsVar f_bind_) (hsParen ss)
+doToExp ((HsGenerator _srcLoc pat e):ss) | isLazyPat pat = do
+    ss <- doToExp ss
+    return $ HsInfixApp (hsParen e) (HsVar f_bind) (HsLambda _srcLoc [pat] ss)
+doToExp ((HsGenerator srcLoc pat e):ss) = do
+    ss <- doToExp ss
+    let kase = HsCase patVar [a1, a2 ]
+        a1 =  HsAlt srcLoc pat (HsUnGuardedRhs ss) []
+        a2 =  HsAlt srcLoc HsPWildCard (HsUnGuardedRhs (HsApp (HsVar f_fail) (HsLit $ HsString $ show srcLoc ++ " failed pattern match in do"))) []
+    return $ HsInfixApp (hsParen e) (HsVar f_bind) (HsLambda srcLoc [HsPVar newPatVarName] kase)  where
+doToExp (HsLetStmt decls:ss) = do
+    ss <- doToExp ss
+    return $ HsLet decls ss
hunk ./FrontEnd/Desugar.hs 472
-    f ((HsGenerator srcLoc pat e):ss) | isHsPVar pat, Just exp' <- g ss = hsParen $ HsApp (HsApp (HsVar f_map)  (hsParen $ HsLambda srcLoc [pat] exp')) e
+    f ((HsGenerator srcLoc pat e):ss) | isLazyPat pat, Just exp' <- g ss = hsParen $ HsApp (HsApp (HsVar f_map)  (hsParen $ HsLambda srcLoc [pat] exp')) e
hunk ./FrontEnd/Desugar.hs 474
-    f ((HsGenerator srcLoc pat e):HsQualifier q:ss) | isHsPVar 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) | isHsPVar pat = hsParen $ HsApp (HsApp (HsVar f_concatMap)  (hsParen $ HsLambda srcLoc [pat] (f ss))) e
+    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
hunk ./FrontEnd/Desugar.hs 496
--- refutable - may bottom out
--- irrefutable - match no matter what
+-- refutable or strict - may bottom out
+-- irrefutable or lazy - match no matter what
hunk ./FrontEnd/Desugar.hs 503
+    f (HsPUnboxedTuple ps) = any isFailablePat ps
hunk ./FrontEnd/Desugar.hs 507
+isLazyPat pat = not (isStrictPat pat)
hunk ./FrontEnd/Infix.hs 241
+    HsPUnboxedTuple xs -> tf $ HsPUnboxedTuple (map pp xs)
hunk ./FrontEnd/Infix.hs 300
+    HsUnboxedTuple exps -> (HsUnboxedTuple (map processExp' exps), terminalFixity)
hunk ./FrontEnd/Rename.hs 701
-    let e = doToExp hsStmts
+    e <- doToExp hsStmts
hunk ./FrontEnd/Tc/Main.hs 296
-tiExpr (HsDo stmts) typ = do
-        let newExp = doToExp stmts
-        withContext (simpleMsg "in a do expression")
-                    (tcExpr newExp typ)
+tiExpr (HsDo stmts) typ = withContext (simpleMsg "in a do expression") $ do
+        newExp <- doToExp stmts
+        tcExpr newExp typ
hunk ./FrontEnd/TypeSyns.hs 300
-    let e = doToExp hsStmts
+    e <- doToExp hsStmts