APIAnnotations:add Locations in hsSyn for layout

Summary:
At the moment ghc-exactprint, which uses the GHC API Annotations to
provide a framework for roundtripping Haskell source code with optional
AST edits, has to implement a horrible workaround to manage the points
where layout needs to be captured.

These are

    MatchGroup
    HsDo
    HsCmdDo
    HsLet
    LetStmt
    HsCmdLet
    GRHSs

To provide a more natural representation, the contents subject to layout
rules need to be wrapped in a SrcSpan.

This commit does this.

Trac ticket #10250

Test Plan: ./validate

Reviewers: hvr, goldfire, bgamari, austin, mpickering

Reviewed By: mpickering

Subscribers: thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D1370

GHC Trac Issues: #10250

24 files changed, 258 insertions, 230 deletions

diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index 0678acec97..aec2a3fada 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -508,14 +508,14 @@ addTickHsExpr (HsMultiIf ty alts)
   = do { let isOneOfMany = case alts of [_] -> False; _ -> True
        ; alts' <- mapM (liftL $ addTickGRHS isOneOfMany False) alts
        ; return $ HsMultiIf ty alts' }
-addTickHsExpr (HsLet binds e) =
+addTickHsExpr (HsLet (L l binds) e) =
         bindLocals (collectLocalBinders binds) $
-        liftM2 HsLet
-                (addTickHsLocalBinds binds) -- to think about: !patterns.
-                (addTickLHsExprLetBody e)
-addTickHsExpr (HsDo cxt stmts srcloc)
+          liftM2 (HsLet . L l)
+                  (addTickHsLocalBinds binds) -- to think about: !patterns.
+                  (addTickLHsExprLetBody e)
+addTickHsExpr (HsDo cxt (L l stmts) srcloc)
   = do { (stmts', _) <- addTickLStmts' forQual stmts (return ())
-       ; return (HsDo cxt stmts' srcloc) }
+       ; return (HsDo cxt (L l stmts') srcloc) }
   where
         forQual = case cxt of
                     ListComp -> Just $ BinBox QualBinBox
@@ -610,10 +610,10 @@ addTickTupArg (L l (Present e))  = do { e' <- addTickLHsExpr e
 addTickTupArg (L l (Missing ty)) = return (L l (Missing ty))
 
 addTickMatchGroup :: Bool{-is lambda-} -> MatchGroup Id (LHsExpr Id) -> TM (MatchGroup Id (LHsExpr Id))
-addTickMatchGroup is_lam mg@(MG { mg_alts = matches }) = do
+addTickMatchGroup is_lam mg@(MG { mg_alts = L l matches }) = do
   let isOneOfMany = matchesOneOfMany matches
   matches' <- mapM (liftL (addTickMatch isOneOfMany is_lam)) matches
-  return $ mg { mg_alts = matches' }
+  return $ mg { mg_alts = L l matches' }
 
 addTickMatch :: Bool -> Bool -> Match Id (LHsExpr Id) -> TM (Match Id (LHsExpr Id))
 addTickMatch isOneOfMany isLambda (Match mf pats opSig gRHSs) =
@@ -622,11 +622,11 @@ addTickMatch isOneOfMany isLambda (Match mf pats opSig gRHSs) =
     return $ Match mf pats opSig gRHSs'
 
 addTickGRHSs :: Bool -> Bool -> GRHSs Id (LHsExpr Id) -> TM (GRHSs Id (LHsExpr Id))
-addTickGRHSs isOneOfMany isLambda (GRHSs guarded local_binds) = do
+addTickGRHSs isOneOfMany isLambda (GRHSs guarded (L l local_binds)) = do
   bindLocals binders $ do
     local_binds' <- addTickHsLocalBinds local_binds
     guarded' <- mapM (liftL (addTickGRHS isOneOfMany isLambda)) guarded
-    return $ GRHSs guarded' local_binds'
+    return $ GRHSs guarded' (L l local_binds')
   where
     binders = collectLocalBinders local_binds
 
@@ -679,8 +679,8 @@ addTickStmt isGuard (BodyStmt e bind' guard' ty) = do
                 (addTickSyntaxExpr hpcSrcSpan bind')
                 (addTickSyntaxExpr hpcSrcSpan guard')
                 (return ty)
-addTickStmt _isGuard (LetStmt binds) = do
-        liftM LetStmt
+addTickStmt _isGuard (LetStmt (L l binds)) = do
+        liftM (LetStmt . L l)
                 (addTickHsLocalBinds binds)
 addTickStmt isGuard (ParStmt pairs mzipExpr bindExpr) = do
     liftM3 ParStmt
@@ -815,14 +815,14 @@ addTickHsCmd (HsCmdIf cnd e1 c2 c3) =
                 (addBinTickLHsExpr (BinBox CondBinBox) e1)
                 (addTickLHsCmd c2)
                 (addTickLHsCmd c3)
-addTickHsCmd (HsCmdLet binds c) =
+addTickHsCmd (HsCmdLet (L l binds) c) =
         bindLocals (collectLocalBinders binds) $
-        liftM2 HsCmdLet
-                (addTickHsLocalBinds binds) -- to think about: !patterns.
-                (addTickLHsCmd c)
-addTickHsCmd (HsCmdDo stmts srcloc)
+          liftM2 (HsCmdLet . L l)
+                   (addTickHsLocalBinds binds) -- to think about: !patterns.
+                   (addTickLHsCmd c)
+addTickHsCmd (HsCmdDo (L l stmts) srcloc)
   = do { (stmts', _) <- addTickLCmdStmts' stmts (return ())
-       ; return (HsCmdDo stmts' srcloc) }
+       ; return (HsCmdDo (L l stmts') srcloc) }
 
 addTickHsCmd (HsCmdArrApp   e1 e2 ty1 arr_ty lr) =
         liftM5 HsCmdArrApp
@@ -844,9 +844,9 @@ addTickHsCmd (HsCmdCast co cmd)
 --addTickHsCmd e  = pprPanic "addTickHsCmd" (ppr e)
 
 addTickCmdMatchGroup :: MatchGroup Id (LHsCmd Id) -> TM (MatchGroup Id (LHsCmd Id))
-addTickCmdMatchGroup mg@(MG { mg_alts = matches }) = do
+addTickCmdMatchGroup mg@(MG { mg_alts = L l matches }) = do
   matches' <- mapM (liftL addTickCmdMatch) matches
-  return $ mg { mg_alts = matches' }
+  return $ mg { mg_alts = L l matches' }
 
 addTickCmdMatch :: Match Id (LHsCmd Id) -> TM (Match Id (LHsCmd Id))
 addTickCmdMatch (Match mf pats opSig gRHSs) =
@@ -855,11 +855,11 @@ addTickCmdMatch (Match mf pats opSig gRHSs) =
     return $ Match mf pats opSig gRHSs'
 
 addTickCmdGRHSs :: GRHSs Id (LHsCmd Id) -> TM (GRHSs Id (LHsCmd Id))
-addTickCmdGRHSs (GRHSs guarded local_binds) = do
+addTickCmdGRHSs (GRHSs guarded (L l local_binds)) = do
   bindLocals binders $ do
     local_binds' <- addTickHsLocalBinds local_binds
     guarded' <- mapM (liftL addTickCmdGRHS) guarded
-    return $ GRHSs guarded' local_binds'
+    return $ GRHSs guarded' (L l local_binds')
   where
     binders = collectLocalBinders local_binds
 
@@ -903,8 +903,8 @@ addTickCmdStmt (BodyStmt c bind' guard' ty) = do
                 (addTickSyntaxExpr hpcSrcSpan bind')
                 (addTickSyntaxExpr hpcSrcSpan guard')
                 (return ty)
-addTickCmdStmt (LetStmt binds) = do
-        liftM LetStmt
+addTickCmdStmt (LetStmt (L l binds)) = do
+        liftM (LetStmt . L l)
                 (addTickHsLocalBinds binds)
 addTickCmdStmt stmt@(RecStmt {})
   = do { stmts' <- addTickLCmdStmts (recS_stmts stmt)
diff --git a/compiler/deSugar/DsArrows.hs b/compiler/deSugar/DsArrows.hs
index 1657a5f49d..14c38b0e9a 100644
--- a/compiler/deSugar/DsArrows.hs
+++ b/compiler/deSugar/DsArrows.hs
@@ -400,8 +400,8 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdApp cmd arg) env_ids = do
 --              ---> premap (\ ((xs), (p1, ... (pk,stk)...)) -> ((ys),stk)) cmd
 
 dsCmd ids local_vars stack_ty res_ty
-        (HsCmdLam (MG { mg_alts = [L _ (Match _ pats _
-                                       (GRHSs [L _ (GRHS [] body)] _ ))] }))
+        (HsCmdLam (MG { mg_alts = L _ [L _ (Match _ pats _
+                                           (GRHSs [L _ (GRHS [] body)] _ ))] }))
         env_ids = do
     let
         pat_vars = mkVarSet (collectPatsBinders pats)
@@ -505,7 +505,8 @@ case bodies, containing the following fields:
 -}
 
 dsCmd ids local_vars stack_ty res_ty
-      (HsCmdCase exp (MG { mg_alts = matches, mg_arg_tys = arg_tys, mg_origin = origin }))
+      (HsCmdCase exp (MG { mg_alts = L l matches, mg_arg_tys = arg_tys
+                         , mg_origin = origin }))
       env_ids = do
     stack_id <- newSysLocalDs stack_ty
 
@@ -548,7 +549,8 @@ dsCmd ids local_vars stack_ty res_ty
         (_, matches') = mapAccumL (replaceLeavesMatch res_ty) leaves' matches
         in_ty = envStackType env_ids stack_ty
 
-    core_body <- dsExpr (HsCase exp (MG { mg_alts = matches', mg_arg_tys = arg_tys
+    core_body <- dsExpr (HsCase exp (MG { mg_alts = L l matches'
+                                        , mg_arg_tys = arg_tys
                                         , mg_res_ty = sum_ty, mg_origin = origin }))
         -- Note that we replace the HsCase result type by sum_ty,
         -- which is the type of matches'
@@ -563,7 +565,7 @@ dsCmd ids local_vars stack_ty res_ty
 --
 --              ---> premap (\ ((xs),stk) -> let binds in ((ys),stk)) c
 
-dsCmd ids local_vars stack_ty res_ty (HsCmdLet binds body) env_ids = do
+dsCmd ids local_vars stack_ty res_ty (HsCmdLet (L _ binds) body) env_ids = do
     let
         defined_vars = mkVarSet (collectLocalBinders binds)
         local_vars' = defined_vars `unionVarSet` local_vars
@@ -588,7 +590,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdLet binds body) env_ids = do
 --
 --              ---> premap (\ (env,stk) -> env) c
 
-dsCmd ids local_vars stack_ty res_ty (HsCmdDo stmts _) env_ids = do
+dsCmd ids local_vars stack_ty res_ty (HsCmdDo (L _ stmts) _) env_ids = do
     (core_stmts, env_ids') <- dsCmdDo ids local_vars res_ty stmts env_ids
     let env_ty = mkBigCoreVarTupTy env_ids
     core_fst <- mkFstExpr env_ty stack_ty
@@ -833,7 +835,7 @@ dsCmdStmt ids local_vars out_ids (BindStmt pat cmd _ _) env_ids = do
 --
 --              ---> arr (\ (xs) -> let binds in (xs')) >>> ss
 
-dsCmdStmt ids local_vars out_ids (LetStmt binds) env_ids = do
+dsCmdStmt ids local_vars out_ids (LetStmt (L _ binds)) env_ids = do
     -- build a new environment using the let bindings
     core_binds <- dsLocalBinds binds (mkBigCoreVarTup out_ids)
     -- match the old environment against the input
@@ -1048,7 +1050,7 @@ matchSimplys _ _ _ _ _ = panic "matchSimplys"
 -- List of leaf expressions, with set of variables bound in each
 
 leavesMatch :: LMatch Id (Located (body Id)) -> [(Located (body Id), IdSet)]
-leavesMatch (L _ (Match _ pats _ (GRHSs grhss binds)))
+leavesMatch (L _ (Match _ pats _ (GRHSs grhss (L _ binds))))
   = let
         defined_vars = mkVarSet (collectPatsBinders pats)
                         `unionVarSet`
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index 0f5d6e5d53..dc6be9cddd 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -319,19 +319,19 @@ dsExpr (HsCase discrim matches)
 
 -- Pepe: The binds are in scope in the body but NOT in the binding group
 --       This is to avoid silliness in breakpoints
-dsExpr (HsLet binds body) = do
+dsExpr (HsLet (L _ binds) body) = do
     body' <- dsLExpr body
     dsLocalBinds binds body'
 
 -- We need the `ListComp' form to use `deListComp' (rather than the "do" form)
 -- because the interpretation of `stmts' depends on what sort of thing it is.
 --
-dsExpr (HsDo ListComp     stmts res_ty) = dsListComp stmts res_ty
-dsExpr (HsDo PArrComp     stmts _)      = dsPArrComp (map unLoc stmts)
-dsExpr (HsDo DoExpr       stmts _)      = dsDo stmts
-dsExpr (HsDo GhciStmtCtxt stmts _)      = dsDo stmts
-dsExpr (HsDo MDoExpr      stmts _)      = dsDo stmts
-dsExpr (HsDo MonadComp    stmts _)      = dsMonadComp stmts
+dsExpr (HsDo ListComp     (L _ stmts) res_ty) = dsListComp stmts res_ty
+dsExpr (HsDo PArrComp     (L _ stmts) _)      = dsPArrComp (map unLoc stmts)
+dsExpr (HsDo DoExpr       (L _ stmts) _)      = dsDo stmts
+dsExpr (HsDo GhciStmtCtxt (L _ stmts) _)      = dsDo stmts
+dsExpr (HsDo MDoExpr      (L _ stmts) _)      = dsDo stmts
+dsExpr (HsDo MonadComp    (L _ stmts) _)      = dsMonadComp stmts
 
 dsExpr (HsIf mb_fun guard_expr then_expr else_expr)
   = do { pred <- dsLExpr guard_expr
@@ -567,7 +567,8 @@ dsExpr expr@(RecordUpd record_expr fields
         -- constructor aguments.
         ; alts <- mapM (mk_alt upd_fld_env) cons_to_upd
         ; ([discrim_var], matching_code)
-                <- matchWrapper RecUpd (MG { mg_alts = alts, mg_arg_tys = [in_ty]
+                <- matchWrapper RecUpd (MG { mg_alts = noLoc alts
+                                           , mg_arg_tys = [in_ty]
                                            , mg_res_ty = out_ty, mg_origin = FromSource })
                                            -- FromSource is not strictly right, but we
                                            -- want incomplete pattern-match warnings
@@ -857,7 +858,7 @@ dsDo stmts
            ; rest <- goL stmts
            ; return (mkApps then_expr2 [rhs2, rest]) }
 
-    go _ (LetStmt binds) stmts
+    go _ (LetStmt (L _ binds)) stmts
       = do { rest <- goL stmts
            ; dsLocalBinds binds rest }
 
@@ -888,10 +889,10 @@ dsDo stmts
            ; rhss' <- sequence rhss
            ; ops' <- mapM dsExpr (map fst args)
 
-           ; let body' = noLoc $ HsDo DoExpr stmts body_ty
+           ; let body' = noLoc $ HsDo DoExpr (noLoc stmts) body_ty
 
            ; let fun = L noSrcSpan $ HsLam $
-                   MG { mg_alts = [mkSimpleMatch pats body']
+                   MG { mg_alts = noLoc [mkSimpleMatch pats body']
                       , mg_arg_tys = arg_tys
                       , mg_res_ty = body_ty
                       , mg_origin = Generated }
@@ -921,11 +922,13 @@ dsDo stmts
         later_pats   = rec_tup_pats
         rets         = map noLoc rec_rets
         mfix_app     = nlHsApp (noLoc mfix_op) mfix_arg
-        mfix_arg     = noLoc $ HsLam (MG { mg_alts = [mkSimpleMatch [mfix_pat] body]
-                                         , mg_arg_tys = [tup_ty], mg_res_ty = body_ty
-                                         , mg_origin = Generated })
+        mfix_arg     = noLoc $ HsLam
+                           (MG { mg_alts = noLoc [mkSimpleMatch [mfix_pat] body]
+                               , mg_arg_tys = [tup_ty], mg_res_ty = body_ty
+                               , mg_origin = Generated })
         mfix_pat     = noLoc $ LazyPat $ mkBigLHsPatTupId rec_tup_pats
-        body         = noLoc $ HsDo DoExpr (rec_stmts ++ [ret_stmt]) body_ty
+        body         = noLoc $ HsDo
+                                DoExpr (noLoc (rec_stmts ++ [ret_stmt])) body_ty
         ret_app      = nlHsApp (noLoc return_op) (mkBigLHsTupId rets)
         ret_stmt     = noLoc $ mkLastStmt ret_app
                      -- This LastStmt will be desugared with dsDo,
diff --git a/compiler/deSugar/DsGRHSs.hs b/compiler/deSugar/DsGRHSs.hs
index 6e4056a7c3..3eafd12c73 100644
--- a/compiler/deSugar/DsGRHSs.hs
+++ b/compiler/deSugar/DsGRHSs.hs
@@ -57,7 +57,7 @@ dsGRHSs :: HsMatchContext Name -> [Pat Id]      -- These are to build a MatchCon
         -> GRHSs Id (LHsExpr Id)                -- Guarded RHSs
         -> Type                                 -- Type of RHS
         -> DsM MatchResult
-dsGRHSs hs_ctx _ (GRHSs grhss binds) rhs_ty
+dsGRHSs hs_ctx _ (GRHSs grhss (L _ binds)) rhs_ty
   = ASSERT( notNull grhss )
     do { match_results <- mapM (dsGRHS hs_ctx rhs_ty) grhss
        ; let match_result1 = foldr1 combineMatchResults match_results
@@ -106,7 +106,7 @@ matchGuards (BodyStmt expr _ _ _ : stmts) ctx rhs rhs_ty = do
     pred_expr <- dsLExpr expr
     return (mkGuardedMatchResult pred_expr match_result)
 
-matchGuards (LetStmt binds : stmts) ctx rhs rhs_ty = do
+matchGuards (LetStmt (L _ binds) : stmts) ctx rhs rhs_ty = do
     match_result <- matchGuards stmts ctx rhs rhs_ty
     return (adjustMatchResultDs (dsLocalBinds binds) match_result)
         -- NB the dsLet occurs inside the match_result
diff --git a/compiler/deSugar/DsListComp.hs b/compiler/deSugar/DsListComp.hs
index 985b12e19f..4d11fa21b8 100644
--- a/compiler/deSugar/DsListComp.hs
+++ b/compiler/deSugar/DsListComp.hs
@@ -221,7 +221,7 @@ deListComp (BodyStmt guard _ _ _ : quals) list = do  -- rule B above
     return (mkIfThenElse core_guard core_rest list)
 
 -- [e | let B, qs] = let B in [e | qs]
-deListComp (LetStmt binds : quals) list = do
+deListComp (LetStmt (L _ binds) : quals) list = do
     core_rest <- deListComp quals list
     dsLocalBinds binds core_rest
 
@@ -326,7 +326,7 @@ dfListComp c_id n_id (BodyStmt guard _ _ _  : quals) = do
     core_rest <- dfListComp c_id n_id quals
     return (mkIfThenElse core_guard core_rest (Var n_id))
 
-dfListComp c_id n_id (LetStmt binds : quals) = do
+dfListComp c_id n_id (LetStmt (L _ binds) : quals) = do
     -- new in 1.3, local bindings
     core_rest <- dfListComp c_id n_id quals
     dsLocalBinds binds core_rest
@@ -568,7 +568,7 @@ dePArrComp (BindStmt p e _ _ : qs) pa cea = do
 --  where
 --    {x_1, ..., x_n} = DV (ds)         -- Defined Variables
 --
-dePArrComp (LetStmt ds : qs) pa cea = do
+dePArrComp (LetStmt (L _ ds) : qs) pa cea = do
     mapP <- dsDPHBuiltin mapPVar
     let xs     = collectLocalBinders ds
         ty'cea = parrElemType cea
@@ -680,7 +680,7 @@ dsMcStmt (LastStmt body _ ret_op) stmts
        ; return (App ret_op' body') }
 
 --   [ .. | let binds, stmts ]
-dsMcStmt (LetStmt binds) stmts
+dsMcStmt (LetStmt (L _ binds)) stmts
   = do { rest <- dsMcStmts stmts
        ; dsLocalBinds binds rest }
 
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 2ad38c0e36..c0f0ba0db1 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -1081,8 +1081,8 @@ repE e@(HsRecFld f) = case f of
         -- HsOverlit can definitely occur
 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
 repE (HsLit l)     = do { a <- repLiteral l;           repLit a }
-repE (HsLam (MG { mg_alts = [m] })) = repLambda m
-repE (HsLamCase _ (MG { mg_alts = ms }))
+repE (HsLam (MG { mg_alts = L _ [m] })) = repLambda m
+repE (HsLamCase _ (MG { mg_alts = L _ ms }))
                    = do { ms' <- mapM repMatchTup ms
                         ; core_ms <- coreList matchQTyConName ms'
                         ; repLamCase core_ms }
@@ -1100,7 +1100,7 @@ repE (NegApp x _)        = do
 repE (HsPar x)            = repLE x
 repE (SectionL x y)       = do { a <- repLE x; b <- repLE y; repSectionL a b }
 repE (SectionR x y)       = do { a <- repLE x; b <- repLE y; repSectionR a b }
-repE (HsCase e (MG { mg_alts = ms }))
+repE (HsCase e (MG { mg_alts = L _ ms }))
                           = do { arg <- repLE e
                                ; ms2 <- mapM repMatchTup ms
                                ; core_ms2 <- coreList matchQTyConName ms2
@@ -1114,13 +1114,13 @@ repE (HsMultiIf _ alts)
   = do { (binds, alts') <- liftM unzip $ mapM repLGRHS alts
        ; expr' <- repMultiIf (nonEmptyCoreList alts')
        ; wrapGenSyms (concat binds) expr' }
-repE (HsLet bs e)         = do { (ss,ds) <- repBinds bs
-                               ; e2 <- addBinds ss (repLE e)
-                               ; z <- repLetE ds e2
-                               ; wrapGenSyms ss z }
+repE (HsLet (L _ bs) e)         = do { (ss,ds) <- repBinds bs
+                                     ; e2 <- addBinds ss (repLE e)
+                                     ; z <- repLetE ds e2
+                                     ; wrapGenSyms ss z }
 
 -- FIXME: I haven't got the types here right yet
-repE e@(HsDo ctxt sts _)
+repE e@(HsDo ctxt (L _ sts) _)
  | case ctxt of { DoExpr -> True; GhciStmtCtxt -> True; _ -> False }
  = do { (ss,zs) <- repLSts sts;
         e'      <- repDoE (nonEmptyCoreList zs);
@@ -1187,7 +1187,7 @@ repE e                     = notHandled "Expression form" (ppr e)
 -- Building representations of auxillary structures like Match, Clause, Stmt,
 
 repMatchTup ::  LMatch Name (LHsExpr Name) -> DsM (Core TH.MatchQ)
-repMatchTup (L _ (Match _ [p] _ (GRHSs guards wheres))) =
+repMatchTup (L _ (Match _ [p] _ (GRHSs guards (L _ wheres)))) =
   do { ss1 <- mkGenSyms (collectPatBinders p)
      ; addBinds ss1 $ do {
      ; p1 <- repLP p
@@ -1199,7 +1199,7 @@ repMatchTup (L _ (Match _ [p] _ (GRHSs guards wheres))) =
 repMatchTup _ = panic "repMatchTup: case alt with more than one arg"
 
 repClauseTup ::  LMatch Name (LHsExpr Name) -> DsM (Core TH.ClauseQ)
-repClauseTup (L _ (Match _ ps _ (GRHSs guards wheres))) =
+repClauseTup (L _ (Match _ ps _ (GRHSs guards (L _ wheres)))) =
   do { ss1 <- mkGenSyms (collectPatsBinders ps)
      ; addBinds ss1 $ do {
        ps1 <- repLPs ps
@@ -1286,7 +1286,7 @@ repSts (BindStmt p e _ _ : ss) =
       ; (ss2,zs) <- repSts ss
       ; z <- repBindSt p1 e2
       ; return (ss1++ss2, z : zs) }}
-repSts (LetStmt bs : ss) =
+repSts (LetStmt (L _ bs) : ss) =
    do { (ss1,ds) <- repBinds bs
       ; z <- repLetSt ds
       ; (ss2,zs) <- addBinds ss1 (repSts ss)
@@ -1365,8 +1365,9 @@ rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
 -- with an empty list of patterns
 rep_bind (L loc (FunBind
                  { fun_id = fn,
-                   fun_matches = MG { mg_alts = [L _ (Match _ [] _
-                                                   (GRHSs guards wheres))] } }))
+                   fun_matches = MG { mg_alts
+                           = L _ [L _ (Match _ [] _
+                                             (GRHSs guards (L _ wheres)))] } }))
  = do { (ss,wherecore) <- repBinds wheres
         ; guardcore <- addBinds ss (repGuards guards)
         ; fn'  <- lookupLBinder fn
@@ -1375,13 +1376,15 @@ rep_bind (L loc (FunBind
         ; ans' <- wrapGenSyms ss ans
         ; return (loc, ans') }
 
-rep_bind (L loc (FunBind { fun_id = fn, fun_matches = MG { mg_alts = ms } }))
+rep_bind (L loc (FunBind { fun_id = fn
+                         , fun_matches = MG { mg_alts = L _ ms } }))
  =   do { ms1 <- mapM repClauseTup ms
         ; fn' <- lookupLBinder fn
         ; ans <- repFun fn' (nonEmptyCoreList ms1)
         ; return (loc, ans) }
 
-rep_bind (L loc (PatBind { pat_lhs = pat, pat_rhs = GRHSs guards wheres }))
+rep_bind (L loc (PatBind { pat_lhs = pat
+                         , pat_rhs = GRHSs guards (L _ wheres) }))
  =   do { patcore <- repLP pat
         ; (ss,wherecore) <- repBinds wheres
         ; guardcore <- addBinds ss (repGuards guards)
@@ -1425,7 +1428,7 @@ rep_bind (L _ dec@(PatSynBind {})) = notHandled "pattern synonyms" (ppr dec)
 -- (\ p1 .. pn -> exp) by causing an error.
 
 repLambda :: LMatch Name (LHsExpr Name) -> DsM (Core TH.ExpQ)
-repLambda (L _ (Match _ ps _ (GRHSs [L _ (GRHS [] e)] EmptyLocalBinds)))
+repLambda (L _ (Match _ ps _ (GRHSs [L _ (GRHS [] e)] (L _ EmptyLocalBinds))))
  = do { let bndrs = collectPatsBinders ps ;
       ; ss  <- mkGenSyms bndrs
       ; lam <- addBinds ss (
diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs
index 8af0a6e5e3..fc92bad79d 100644
--- a/compiler/deSugar/Match.hs
+++ b/compiler/deSugar/Match.hs
@@ -791,7 +791,7 @@ one pattern, and match simply only accepts one pattern.
 JJQC 30-Nov-1997
 -}
 
-matchWrapper ctxt (MG { mg_alts = matches
+matchWrapper ctxt (MG { mg_alts = L _ matches
                       , mg_arg_tys = arg_tys
                       , mg_res_ty = rhs_ty
                       , mg_origin = origin })
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 2d7194e2b3..0b8ede6087 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -156,7 +156,7 @@ cvtDec (TH.ValD pat body ds)
         ; body' <- cvtGuard body
         ; ds' <- cvtLocalDecs (ptext (sLit "a where clause")) ds
         ; returnJustL $ Hs.ValD $
-          PatBind { pat_lhs = pat', pat_rhs = GRHSs body' ds'
+          PatBind { pat_lhs = pat', pat_rhs = GRHSs body' (noLoc ds')
                   , pat_rhs_ty = placeHolderType, bind_fvs = placeHolderNames
                   , pat_ticks = ([],[]) } }
 
@@ -630,7 +630,8 @@ cvtClause (Clause ps body wheres)
   = do  { ps' <- cvtPats ps
         ; g'  <- cvtGuard body
         ; ds' <- cvtLocalDecs (ptext (sLit "a where clause")) wheres
-        ; returnL $ Hs.Match NonFunBindMatch ps' Nothing (GRHSs g' ds') }
+        ; returnL $ Hs.Match NonFunBindMatch ps' Nothing
+                             (GRHSs g' (noLoc ds')) }
 
 
 -------------------------------------------------------------------
@@ -669,7 +670,7 @@ cvtl e = wrapL (cvt e)
       | otherwise      = do { alts' <- mapM cvtpair alts
                             ; return $ HsMultiIf placeHolderType alts' }
     cvt (LetE ds e)    = do { ds' <- cvtLocalDecs (ptext (sLit "a let expression")) ds
-                            ; e' <- cvtl e; return $ HsLet ds' e' }
+                            ; e' <- cvtl e; return $ HsLet (noLoc ds') e' }
     cvt (CaseE e ms)   = do { e' <- cvtl e; ms' <- mapM cvtMatch ms
                             ; return $ HsCase e' (mkMatchGroup FromSource ms') }
     cvt (DoE ss)       = cvtHsDo DoExpr ss
@@ -828,7 +829,7 @@ cvtHsDo do_or_lc stmts
                     L loc (BodyStmt body _ _ _) -> return (L loc (mkLastStmt body))
                     _ -> failWith (bad_last last')
 
-        ; return $ HsDo do_or_lc (stmts'' ++ [last'']) placeHolderType }
+        ; return $ HsDo do_or_lc (noLoc (stmts'' ++ [last''])) placeHolderType }
   where
     bad_last stmt = vcat [ ptext (sLit "Illegal last statement of") <+> pprAStmtContext do_or_lc <> colon
                          , nest 2 $ Outputable.ppr stmt
@@ -841,7 +842,7 @@ cvtStmt :: TH.Stmt -> CvtM (Hs.LStmt RdrName (LHsExpr RdrName))
 cvtStmt (NoBindS e)    = do { e' <- cvtl e; returnL $ mkBodyStmt e' }
 cvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnL $ mkBindStmt p' e' }
 cvtStmt (TH.LetS ds)   = do { ds' <- cvtLocalDecs (ptext (sLit "a let binding")) ds
-                            ; returnL $ LetStmt ds' }
+                            ; returnL $ LetStmt (noLoc ds') }
 cvtStmt (TH.ParS dss)  = do { dss' <- mapM cvt_one dss; returnL $ ParStmt dss' noSyntaxExpr noSyntaxExpr }
                        where
                          cvt_one ds = do { ds' <- cvtStmts ds; return (ParStmtBlock ds' undefined noSyntaxExpr) }
@@ -851,7 +852,8 @@ cvtMatch (TH.Match p body decs)
   = do  { p' <- cvtPat p
         ; g' <- cvtGuard body
         ; decs' <- cvtLocalDecs (ptext (sLit "a where clause")) decs
-        ; returnL $ Hs.Match NonFunBindMatch [p'] Nothing (GRHSs g' decs') }
+        ; returnL $ Hs.Match NonFunBindMatch [p'] Nothing
+                             (GRHSs g' (noLoc decs')) }
 
 cvtGuard :: TH.Body -> CvtM [LGRHS RdrName (LHsExpr RdrName)]
 cvtGuard (GuardedB pairs) = mapM cvtpair pairs
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index 19e7d2fade..a0a9907079 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -237,7 +237,7 @@ data HsExpr id
   --       'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsLet       (HsLocalBinds id)
+  | HsLet       (Located (HsLocalBinds id))
                 (LHsExpr  id)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
@@ -246,11 +246,11 @@ data HsExpr id
   --             'ApiAnnotation.AnnClose'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsDo        (HsStmtContext Name) -- The parameterisation is unimportant
-                                     -- because in this context we never use
-                                     -- the PatGuard or ParStmt variant
-                [ExprLStmt id]       -- "do":one or more stmts
-                (PostTc id Type)     -- Type of the whole expression
+  | HsDo        (HsStmtContext Name)     -- The parameterisation is unimportant
+                                         -- because in this context we never use
+                                         -- the PatGuard or ParStmt variant
+                (Located [ExprLStmt id]) -- "do":one or more stmts
+                (PostTc id Type)         -- Type of the whole expression
 
   -- | Syntactic list: [a,b,c,...]
   --
@@ -713,15 +713,15 @@ ppr_expr (HsMultiIf _ alts)
               , ptext (sLit "->") <+> pprDeeper (ppr expr) ]
 
 -- special case: let ... in let ...
-ppr_expr (HsLet binds expr@(L _ (HsLet _ _)))
+ppr_expr (HsLet (L _ binds) expr@(L _ (HsLet _ _)))
   = sep [hang (ptext (sLit "let")) 2 (hsep [pprBinds binds, ptext (sLit "in")]),
          ppr_lexpr expr]
 
-ppr_expr (HsLet binds expr)
+ppr_expr (HsLet (L _ binds) expr)
   = sep [hang (ptext (sLit "let")) 2 (pprBinds binds),
          hang (ptext (sLit "in"))  2 (ppr expr)]
 
-ppr_expr (HsDo do_or_list_comp stmts _) = pprDo do_or_list_comp stmts
+ppr_expr (HsDo do_or_list_comp (L _ stmts) _) = pprDo do_or_list_comp stmts
 
 ppr_expr (ExplicitList _ _ exprs)
   = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
@@ -944,7 +944,7 @@ data HsCmd id
 
     -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsCmdLet    (HsLocalBinds id)               -- let(rec)
+  | HsCmdLet    (Located (HsLocalBinds id))      -- let(rec)
                 (LHsCmd  id)
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',
     --       'ApiAnnotation.AnnOpen' @'{'@,
@@ -952,7 +952,7 @@ data HsCmd id
 
     -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsCmdDo     [CmdLStmt id]
+  | HsCmdDo     (Located [CmdLStmt id])
                 (PostTc id Type)                -- Type of the whole expression
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
     --             'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',
@@ -1037,15 +1037,15 @@ ppr_cmd (HsCmdIf _ e ct ce)
          nest 4 (ppr ce)]
 
 -- special case: let ... in let ...
-ppr_cmd (HsCmdLet binds cmd@(L _ (HsCmdLet _ _)))
+ppr_cmd (HsCmdLet (L _ binds) cmd@(L _ (HsCmdLet _ _)))
   = sep [hang (ptext (sLit "let")) 2 (hsep [pprBinds binds, ptext (sLit "in")]),
          ppr_lcmd cmd]
 
-ppr_cmd (HsCmdLet binds cmd)
+ppr_cmd (HsCmdLet (L _ binds) cmd)
   = sep [hang (ptext (sLit "let")) 2 (pprBinds binds),
          hang (ptext (sLit "in"))  2 (ppr cmd)]
 
-ppr_cmd (HsCmdDo stmts _)  = pprDo ArrowExpr stmts
+ppr_cmd (HsCmdDo (L  _ stmts) _)  = pprDo ArrowExpr stmts
 ppr_cmd (HsCmdCast co cmd) = sep [ ppr_cmd cmd
                                  , ptext (sLit "|>") <+> ppr co ]
 
@@ -1106,7 +1106,7 @@ patterns in each equation.
 -}
 
 data MatchGroup id body
-  = MG { mg_alts    :: [LMatch id body]  -- The alternatives
+  = MG { mg_alts    :: Located [LMatch id body]  -- The alternatives
        , mg_arg_tys :: [PostTc id Type]  -- Types of the arguments, t1..tn
        , mg_res_ty  :: PostTc id Type    -- Type of the result, tr
        , mg_origin  :: Origin }
@@ -1174,13 +1174,13 @@ isInfixMatch match = case m_fixity match of
   _                   -> False
 
 isEmptyMatchGroup :: MatchGroup id body -> Bool
-isEmptyMatchGroup (MG { mg_alts = ms }) = null ms
+isEmptyMatchGroup (MG { mg_alts = ms }) = null $ unLoc ms
 
 matchGroupArity :: MatchGroup id body -> Arity
 -- Precondition: MatchGroup is non-empty
 -- This is called before type checking, when mg_arg_tys is not set
 matchGroupArity (MG { mg_alts = alts })
-  | (alt1:_) <- alts = length (hsLMatchPats alt1)
+  | L _ (alt1:_) <- alts = length (hsLMatchPats alt1)
   | otherwise        = panic "matchGroupArity"
 
 hsLMatchPats :: LMatch id body -> [LPat id]
@@ -1197,7 +1197,7 @@ hsLMatchPats (L _ (Match _ pats _ _)) = pats
 data GRHSs id body
   = GRHSs {
       grhssGRHSs :: [LGRHS id body],       -- ^ Guarded RHSs
-      grhssLocalBinds :: (HsLocalBinds id) -- ^ The where clause
+      grhssLocalBinds :: Located (HsLocalBinds id) -- ^ The where clause
     } deriving (Typeable)
 deriving instance (Data body,DataId id) => Data (GRHSs id body)
 
@@ -1214,7 +1214,7 @@ deriving instance (Data body,DataId id) => Data (GRHS id body)
 pprMatches :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
            => HsMatchContext idL -> MatchGroup idR body -> SDoc
 pprMatches ctxt (MG { mg_alts = matches })
-    = vcat (map (pprMatch ctxt) (map unLoc matches))
+    = vcat (map (pprMatch ctxt) (map unLoc (unLoc matches)))
       -- Don't print the type; it's only a place-holder before typechecking
 
 -- Exported to HsBinds, which can't see the defn of HsMatchContext
@@ -1266,7 +1266,7 @@ pprMatch ctxt match
 
 pprGRHSs :: (OutputableBndr idR, Outputable body)
          => HsMatchContext idL -> GRHSs idR body -> SDoc
-pprGRHSs ctxt (GRHSs grhss binds)
+pprGRHSs ctxt (GRHSs grhss (L _ binds))
   = vcat (map (pprGRHS ctxt . unLoc) grhss)
  $$ ppUnless (isEmptyLocalBinds binds)
       (text "where" $$ nest 4 (pprBinds binds))
@@ -1360,7 +1360,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
   --          'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@,
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | LetStmt  (HsLocalBindsLR idL idR)
+  | LetStmt  (Located (HsLocalBindsLR idL idR))
 
   -- ParStmts only occur in a list/monad comprehension
   | ParStmt  [ParStmtBlock idL idR]
@@ -1607,7 +1607,7 @@ pprStmt (LastStmt expr ret_stripped _)
        (if ret_stripped then ptext (sLit "return") else empty) <+>
        ppr expr
 pprStmt (BindStmt pat expr _ _)   = hsep [ppr pat, larrow, ppr expr]
-pprStmt (LetStmt binds)           = hsep [ptext (sLit "let"), pprBinds binds]
+pprStmt (LetStmt (L _ binds))     = hsep [ptext (sLit "let"), pprBinds binds]
 pprStmt (BodyStmt expr _ _ _)     = ppr expr
 pprStmt (ParStmt stmtss _ _)      = sep (punctuate (ptext (sLit " | ")) (map ppr stmtss))
 
@@ -1657,7 +1657,8 @@ pprStmt (ApplicativeStmt args mb_join _)
    pp_arg (_, ApplicativeArgMany stmts return pat) =
      ppr pat <+>
      ptext (sLit "<-") <+>
-     ppr (HsDo DoExpr (stmts ++ [noLoc (LastStmt (noLoc return) False noSyntaxExpr)])
+     ppr (HsDo DoExpr (noLoc
+                (stmts ++ [noLoc (LastStmt (noLoc return) False noSyntaxExpr)]))
            (error "pprStmt"))
 
 pprTransformStmt :: OutputableBndr id => [id] -> LHsExpr id -> Maybe (LHsExpr id) -> SDoc
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index e88c7b64f3..259edcaab9 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -142,20 +142,27 @@ mkSimpleMatch pats rhs
                 (pat:_) -> combineSrcSpans (getLoc pat) (getLoc rhs)
 
 unguardedGRHSs :: Located (body id) -> GRHSs id (Located (body id))
-unguardedGRHSs rhs@(L loc _) = GRHSs (unguardedRHS loc rhs) emptyLocalBinds
+unguardedGRHSs rhs@(L loc _)
+  = GRHSs (unguardedRHS loc rhs) (noLoc emptyLocalBinds)
 
 unguardedRHS :: SrcSpan -> Located (body id) -> [LGRHS id (Located (body id))]
 unguardedRHS loc rhs = [L loc (GRHS [] rhs)]
 
 mkMatchGroup :: Origin -> [LMatch RdrName (Located (body RdrName))]
              -> MatchGroup RdrName (Located (body RdrName))
-mkMatchGroup origin matches = MG { mg_alts = matches, mg_arg_tys = []
+mkMatchGroup origin matches = MG { mg_alts = mkLocatedList matches
+                                 , mg_arg_tys = []
                                  , mg_res_ty = placeHolderType
                                  , mg_origin = origin }
 
+mkLocatedList ::  [Located a] -> Located [Located a]
+mkLocatedList [] = noLoc []
+mkLocatedList ms = L (combineLocs (head ms) (last ms)) ms
+
 mkMatchGroupName :: Origin -> [LMatch Name (Located (body Name))]
              -> MatchGroup Name (Located (body Name))
-mkMatchGroupName origin matches = MG { mg_alts = matches, mg_arg_tys = []
+mkMatchGroupName origin matches = MG { mg_alts = mkLocatedList matches
+                                     , mg_arg_tys = []
                                      , mg_res_ty = placeHolderType
                                      , mg_origin = origin }
 
@@ -236,7 +243,7 @@ mkHsIsString src s  = OverLit (HsIsString   src s) noRebindableInfo noSyntaxExpr
 noRebindableInfo :: PlaceHolder
 noRebindableInfo = PlaceHolder -- Just another placeholder;
 
-mkHsDo ctxt stmts = HsDo ctxt stmts placeHolderType
+mkHsDo ctxt stmts = HsDo ctxt (mkLocatedList stmts) placeHolderType
 mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])
   where
     last_stmt = L (getLoc expr) $ mkLastStmt expr
@@ -641,9 +648,7 @@ mkPatSynBind name details lpat dir = PatSynBind psb
 -- considered infix.
 isInfixFunBind :: HsBindLR id1 id2 -> Bool
 isInfixFunBind (FunBind _ (MG matches _ _ _) _ _ _)
-  = any isInfix matches
-  where
-    isInfix (L _ match) = isInfixMatch match
+  = any (isInfixMatch . unLoc) (unLoc matches)
 isInfixFunBind _ = False
 
 
@@ -651,13 +656,14 @@ isInfixFunBind _ = False
 mk_easy_FunBind :: SrcSpan -> RdrName -> [LPat RdrName]
                 -> LHsExpr RdrName -> LHsBind RdrName
 mk_easy_FunBind loc fun pats expr
-  = L loc $ mkFunBind (L loc fun) [mkMatch pats expr emptyLocalBinds]
+  = L loc $ mkFunBind (L loc fun) [mkMatch pats expr (noLoc emptyLocalBinds)]
 
 ------------
-mkMatch :: [LPat id] -> LHsExpr id -> HsLocalBinds id -> LMatch id (LHsExpr id)
-mkMatch pats expr binds
+mkMatch :: [LPat id] -> LHsExpr id -> Located (HsLocalBinds id)
+        -> LMatch id (LHsExpr id)
+mkMatch pats expr lbinds
   = noLoc (Match NonFunBindMatch (map paren pats) Nothing
-                 (GRHSs (unguardedRHS noSrcSpan expr) binds))
+                 (GRHSs (unguardedRHS noSrcSpan expr) lbinds))
   where
     paren lp@(L l p) | hsPatNeedsParens p = L l (ParPat lp)
                      | otherwise          = lp
@@ -752,12 +758,12 @@ collectLStmtBinders = collectStmtBinders . unLoc
 
 collectStmtBinders :: StmtLR idL idR body -> [idL]
   -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
-collectStmtBinders (BindStmt pat _ _ _) = collectPatBinders pat
-collectStmtBinders (LetStmt binds)      = collectLocalBinders binds
-collectStmtBinders (BodyStmt {})        = []
-collectStmtBinders (LastStmt {})        = []
-collectStmtBinders (ParStmt xs _ _)     = collectLStmtsBinders
-                                        $ [s | ParStmtBlock ss _ _ <- xs, s <- ss]
+collectStmtBinders (BindStmt pat _ _ _)  = collectPatBinders pat
+collectStmtBinders (LetStmt (L _ binds)) = collectLocalBinders binds
+collectStmtBinders (BodyStmt {})         = []
+collectStmtBinders (LastStmt {})         = []
+collectStmtBinders (ParStmt xs _ _)   = collectLStmtsBinders
+                                      $ [s | ParStmtBlock ss _ _ <- xs, s <- ss]
 collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts
 collectStmtBinders (RecStmt { recS_stmts = ss })     = collectLStmtsBinders ss
 collectStmtBinders ApplicativeStmt{} = []
@@ -987,7 +993,7 @@ lStmtsImplicits = hs_lstmts
     hs_stmt (ApplicativeStmt args _ _) = unionNameSets (map do_arg args)
       where do_arg (_, ApplicativeArgOne pat _) = lPatImplicits pat
             do_arg (_, ApplicativeArgMany stmts _ _) = hs_lstmts stmts
-    hs_stmt (LetStmt binds)      = hs_local_binds binds
+    hs_stmt (LetStmt binds)      = hs_local_binds (unLoc binds)
     hs_stmt (BodyStmt {})        = emptyNameSet
     hs_stmt (LastStmt {})        = emptyNameSet
     hs_stmt (ParStmt xs _ _)     = hs_lstmts [s | ParStmtBlock ss _ _ <- xs, s <- ss]
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 2b2fdaf9e8..1ef3ceb8b1 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -1029,7 +1029,7 @@ compileParsedExpr expr@(L loc _) = withSession $ \hsc_env -> do
   -- create a new binding.
   let expr_fs = fsLit "_compileParsedExpr"
       expr_name = mkInternalName (getUnique expr_fs) (mkTyVarOccFS expr_fs) loc
-      let_stmt = L loc . LetStmt . HsValBinds $
+      let_stmt = L loc . LetStmt . L loc . HsValBinds $
         ValBindsIn (unitBag $ mkHsVarBind loc (getRdrName expr_name) expr) []
 
   Just (ids, hvals_io, fix_env) <- liftIO $ hscParsedStmt hsc_env let_stmt
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 40481e5d20..a74d7a8b95 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1323,35 +1323,35 @@ decls   :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }
         | decl                          { sL1 $1 ([], unitOL $1) }
         | {- empty -}                   { noLoc ([],nilOL) }
 
-decllist :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }
+decllist :: { Located ([AddAnn],Located (OrdList (LHsDecl RdrName))) }
         : '{'            decls '}'     { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
-                                                   ,snd $ unLoc $2) }
-        |     vocurly    decls close   { L (gl $2) (fst $ unLoc $2,snd $ unLoc $2) }
+                                                   ,sL1 $2 $ snd $ unLoc $2) }
+        |     vocurly    decls close   { L (gl $2) (fst $ unLoc $2,sL1 $2 $ snd $ unLoc $2) }
 
 -- Binding groups other than those of class and instance declarations
 --
-binds   ::  { Located ([AddAnn],HsLocalBinds RdrName) }
+binds   ::  { Located ([AddAnn],Located (HsLocalBinds RdrName)) }
                                          -- May have implicit parameters
                                                 -- No type declarations
-        : decllist          {% do { val_binds <- cvBindGroup (snd $ unLoc $1)
+        : decllist          {% do { val_binds <- cvBindGroup (unLoc $ snd $ unLoc $1)
                                   ; return (sL1 $1 (fst $ unLoc $1
-                                                    ,HsValBinds val_binds)) } }
+                                                    ,sL1 $1 $ HsValBinds val_binds)) } }
 
         | '{'            dbinds '}'     { sLL $1 $> ([moc $1,mcc $3]
-                                             ,HsIPBinds (IPBinds (unLoc $2)
+                                             ,sL1 $2 $ HsIPBinds (IPBinds (unLoc $2)
                                                          emptyTcEvBinds)) }
 
         |     vocurly    dbinds close   { L (getLoc $2) ([]
-                                            ,HsIPBinds (IPBinds (unLoc $2)
+                                            ,sL1 $2 $ HsIPBinds (IPBinds (unLoc $2)
                                                         emptyTcEvBinds)) }
 
 
-wherebinds :: { Located ([AddAnn],HsLocalBinds RdrName) }
+wherebinds :: { Located ([AddAnn],Located (HsLocalBinds RdrName)) }
                                                 -- May have implicit parameters
                                                 -- No type declarations
         : 'where' binds                 { sLL $1 $> (mj AnnWhere $1 : (fst $ unLoc $2)
                                              ,snd $ unLoc $2) }
-        | {- empty -}                   { noLoc ([],emptyLocalBinds) }
+        | {- empty -}                   { noLoc ([],noLoc emptyLocalBinds) }
 
 
 -----------------------------------------------------------------------------
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index f804e44f17..384913a1a0 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -388,13 +388,15 @@ getMonoBind :: LHsBind RdrName -> [LHsDecl RdrName]
 -- No AndMonoBinds or EmptyMonoBinds here; just single equations
 
 getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1),
-                               fun_matches = MG { mg_alts = mtchs1 } })) binds
+                               fun_matches
+                                 = MG { mg_alts = L _ mtchs1 } })) binds
   | has_args mtchs1
   = go mtchs1 loc1 binds []
   where
     go mtchs loc
        (L loc2 (ValD (FunBind { fun_id = L _ f2,
-                                fun_matches = MG { mg_alts = mtchs2 } })) : binds) _
+                                fun_matches
+                                  = MG { mg_alts = L _ mtchs2 } })) : binds) _
         | f1 == f2 = go (mtchs2 ++ mtchs)
                         (combineSrcSpans loc loc2) binds []
     go mtchs loc (doc_decl@(L loc2 (DocD _)) : binds) doc_decls
@@ -1115,8 +1117,8 @@ checkCmd _ (HsIf cf ep et ee) = do
     return $ HsCmdIf cf ep pt pe
 checkCmd _ (HsLet lb e) =
     checkCommand e >>= (\c -> return $ HsCmdLet lb c)
-checkCmd _ (HsDo DoExpr stmts ty) =
-    mapM checkCmdLStmt stmts >>= (\ss -> return $ HsCmdDo ss ty)
+checkCmd _ (HsDo DoExpr (L l stmts) ty) =
+    mapM checkCmdLStmt stmts >>= (\ss -> return $ HsCmdDo (L l ss) ty)
 
 checkCmd _ (OpApp eLeft op _fixity eRight) = do
     -- OpApp becomes a HsCmdArrForm with a (Just fixity) in it
@@ -1145,9 +1147,9 @@ checkCmdStmt _ stmt@(RecStmt { recS_stmts = stmts }) = do
 checkCmdStmt l stmt = cmdStmtFail l stmt
 
 checkCmdMatchGroup :: MatchGroup RdrName (LHsExpr RdrName) -> P (MatchGroup RdrName (LHsCmd RdrName))
-checkCmdMatchGroup mg@(MG { mg_alts = ms }) = do
+checkCmdMatchGroup mg@(MG { mg_alts = L l ms }) = do
     ms' <- mapM (locMap $ const convert) ms
-    return $ mg { mg_alts = ms' }
+    return $ mg { mg_alts = L l ms' }
     where convert (Match mf pat mty grhss) = do
             grhss' <- checkCmdGRHSs grhss
             return $ Match mf pat mty grhss'
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index 8db6603f0f..9ec71df7e1 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -1043,7 +1043,7 @@ rnMatchGroup :: Outputable (body RdrName) => HsMatchContext Name
              -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
              -> MatchGroup RdrName (Located (body RdrName))
              -> RnM (MatchGroup Name (Located (body Name)), FreeVars)
-rnMatchGroup ctxt rnBody (MG { mg_alts = ms, mg_origin = origin })
+rnMatchGroup ctxt rnBody (MG { mg_alts = L _ ms, mg_origin = origin })
   = do { empty_case_ok <- xoptM Opt_EmptyCase
        ; when (null ms && not empty_case_ok) (addErr (emptyCaseErr ctxt))
        ; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt rnBody) ms
@@ -1108,10 +1108,10 @@ rnGRHSs :: HsMatchContext Name
         -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
         -> GRHSs RdrName (Located (body RdrName))
         -> RnM (GRHSs Name (Located (body Name)), FreeVars)
-rnGRHSs ctxt rnBody (GRHSs grhss binds)
+rnGRHSs ctxt rnBody (GRHSs grhss (L l binds))
   = rnLocalBindsAndThen binds   $ \ binds' _ -> do
     (grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt rnBody) grhss
-    return (GRHSs grhss' binds', fvGRHSs)
+    return (GRHSs grhss' (L l binds'), fvGRHSs)
 
 rnGRHS :: HsMatchContext Name
        -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index 81ed15731e..5764765fd3 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -213,17 +213,17 @@ rnExpr (HsCase expr matches)
        ; (new_matches, ms_fvs) <- rnMatchGroup CaseAlt rnLExpr matches
        ; return (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs) }
 
-rnExpr (HsLet binds expr)
+rnExpr (HsLet (L l binds) expr)
   = rnLocalBindsAndThen binds $ \binds' _ -> do
       { (expr',fvExpr) <- rnLExpr expr
-      ; return (HsLet binds' expr', fvExpr) }
+      ; return (HsLet (L l binds') expr', fvExpr) }
 
-rnExpr (HsDo do_or_lc stmts _)
+rnExpr (HsDo do_or_lc (L l stmts) _)
   = do  { ((stmts', _), fvs) <-
            rnStmtsWithPostProcessing do_or_lc rnLExpr
              postProcessStmtsForApplicativeDo stmts
              (\ _ -> return ((), emptyFVs))
-        ; return ( HsDo do_or_lc stmts' placeHolderType, fvs ) }
+        ; return ( HsDo do_or_lc (L l stmts') placeHolderType, fvs ) }
 
 rnExpr (ExplicitList _ _  exps)
   = do  { opt_OverloadedLists <- xoptM Opt_OverloadedLists
@@ -518,15 +518,15 @@ rnCmd (HsCmdIf _ p b1 b2)
        ; (mb_ite, fvITE) <- lookupIfThenElse
        ; return (HsCmdIf mb_ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2]) }
 
-rnCmd (HsCmdLet binds cmd)
+rnCmd (HsCmdLet (L l binds) cmd)
   = rnLocalBindsAndThen binds $ \ binds' _ -> do
       { (cmd',fvExpr) <- rnLCmd cmd
-      ; return (HsCmdLet binds' cmd', fvExpr) }
+      ; return (HsCmdLet (L l binds') cmd', fvExpr) }
 
-rnCmd (HsCmdDo stmts _)
+rnCmd (HsCmdDo (L l stmts) _)
   = do  { ((stmts', _), fvs) <-
             rnStmts ArrowExpr rnLCmd stmts (\ _ -> return ((), emptyFVs))
-        ; return ( HsCmdDo stmts' placeHolderType, fvs ) }
+        ; return ( HsCmdDo (L l stmts') placeHolderType, fvs ) }
 
 rnCmd cmd@(HsCmdCast {}) = pprPanic "rnCmd" (ppr cmd)
 
@@ -552,10 +552,10 @@ methodNamesCmd (HsCmdPar c) = methodNamesLCmd c
 methodNamesCmd (HsCmdIf _ _ c1 c2)
   = methodNamesLCmd c1 `plusFV` methodNamesLCmd c2 `addOneFV` choiceAName
 
-methodNamesCmd (HsCmdLet _ c)      = methodNamesLCmd c
-methodNamesCmd (HsCmdDo stmts _) = methodNamesStmts stmts
-methodNamesCmd (HsCmdApp c _)      = methodNamesLCmd c
-methodNamesCmd (HsCmdLam match)    = methodNamesMatch match
+methodNamesCmd (HsCmdLet _ c)          = methodNamesLCmd c
+methodNamesCmd (HsCmdDo (L _ stmts) _) = methodNamesStmts stmts
+methodNamesCmd (HsCmdApp c _)          = methodNamesLCmd c
+methodNamesCmd (HsCmdLam match)        = methodNamesMatch match
 
 methodNamesCmd (HsCmdCase _ matches)
   = methodNamesMatch matches `addOneFV` choiceAName
@@ -567,7 +567,7 @@ methodNamesCmd (HsCmdCase _ matches)
 
 ---------------------------------------------------
 methodNamesMatch :: MatchGroup Name (LHsCmd Name) -> FreeVars
-methodNamesMatch (MG { mg_alts = ms })
+methodNamesMatch (MG { mg_alts = L _ ms })
   = plusFVs (map do_one ms)
  where
     do_one (L _ (Match _ _ _ grhss)) = methodNamesGRHSs grhss
@@ -793,10 +793,10 @@ rnStmt ctxt rnBody (L loc (BindStmt pat body _ _)) thing_inside
        -- fv_expr shouldn't really be filtered by the rnPatsAndThen
         -- but it does not matter because the names are unique
 
-rnStmt _ _ (L loc (LetStmt binds)) thing_inside
+rnStmt _ _ (L loc (LetStmt (L l binds))) thing_inside
   = do  { rnLocalBindsAndThen binds $ \binds' bind_fvs -> do
         { (thing, fvs) <- thing_inside (collectLocalBinders binds')
-        ; return (([(L loc (LetStmt binds'), bind_fvs)], thing), fvs) }  }
+        ; return (([(L loc (LetStmt (L l binds')), bind_fvs)], thing), fvs) }  }
 
 rnStmt ctxt rnBody (L loc (RecStmt { recS_stmts = rec_stmts })) thing_inside
   = do  { (return_op, fvs1)  <- lookupStmtName ctxt returnMName
@@ -996,11 +996,11 @@ rnRecStmtsAndThen rnBody s cont
 collectRecStmtsFixities :: [LStmtLR RdrName RdrName body] -> [LFixitySig RdrName]
 collectRecStmtsFixities l =
     foldr (\ s -> \acc -> case s of
-                            (L _ (LetStmt (HsValBinds (ValBindsIn _ sigs)))) ->
-                                foldr (\ sig -> \ acc -> case sig of
-                                                           (L loc (FixSig s)) -> (L loc s) : acc
-                                                           _ -> acc) acc sigs
-                            _ -> acc) [] l
+            (L _ (LetStmt (L _ (HsValBinds (ValBindsIn _ sigs))))) ->
+                foldr (\ sig -> \ acc -> case sig of
+                                           (L loc (FixSig s)) -> (L loc s) : acc
+                                           _ -> acc) acc sigs
+            _ -> acc) [] l
 
 -- left-hand sides
 
@@ -1024,12 +1024,12 @@ rn_rec_stmt_lhs fix_env (L loc (BindStmt pat body a b))
       return [(L loc (BindStmt pat' body a b),
                fv_pat)]
 
-rn_rec_stmt_lhs _ (L _ (LetStmt binds@(HsIPBinds _)))
+rn_rec_stmt_lhs _ (L _ (LetStmt (L _ binds@(HsIPBinds _))))
   = failWith (badIpBinds (ptext (sLit "an mdo expression")) binds)
 
-rn_rec_stmt_lhs fix_env (L loc (LetStmt (HsValBinds binds)))
+rn_rec_stmt_lhs fix_env (L loc (LetStmt (L l(HsValBinds binds))))
     = do (_bound_names, binds') <- rnLocalValBindsLHS fix_env binds
-         return [(L loc (LetStmt (HsValBinds binds')),
+         return [(L loc (LetStmt (L l (HsValBinds binds'))),
                  -- Warning: this is bogus; see function invariant
                  emptyFVs
                  )]
@@ -1047,7 +1047,7 @@ rn_rec_stmt_lhs _ stmt@(L _ (TransStmt {}))     -- Syntactically illegal in mdo
 rn_rec_stmt_lhs _ stmt@(L _ (ApplicativeStmt {})) -- Shouldn't appear yet
   = pprPanic "rn_rec_stmt" (ppr stmt)
 
-rn_rec_stmt_lhs _ (L _ (LetStmt EmptyLocalBinds))
+rn_rec_stmt_lhs _ (L _ (LetStmt (L _ EmptyLocalBinds)))
   = panic "rn_rec_stmt LetStmt EmptyLocalBinds"
 
 rn_rec_stmts_lhs :: Outputable body => MiniFixityEnv
@@ -1094,15 +1094,15 @@ rn_rec_stmt rnBody _ (L loc (BindStmt pat' body _ _), fv_pat)
        ; return [(bndrs, fvs, bndrs `intersectNameSet` fvs,
                   L loc (BindStmt pat' body' bind_op fail_op))] }
 
-rn_rec_stmt _ _ (L _ (LetStmt binds@(HsIPBinds _)), _)
+rn_rec_stmt _ _ (L _ (LetStmt (L _ binds@(HsIPBinds _))), _)
   = failWith (badIpBinds (ptext (sLit "an mdo expression")) binds)
 
-rn_rec_stmt _ all_bndrs (L loc (LetStmt (HsValBinds binds')), _)
+rn_rec_stmt _ all_bndrs (L loc (LetStmt (L l (HsValBinds binds'))), _)
   = do { (binds', du_binds) <- rnLocalValBindsRHS (mkNameSet all_bndrs) binds'
            -- fixities and unused are handled above in rnRecStmtsAndThen
        ; let fvs = allUses du_binds
        ; return [(duDefs du_binds, fvs, emptyNameSet,
-                 L loc (LetStmt (HsValBinds binds')))] }
+                 L loc (LetStmt (L l (HsValBinds binds'))))] }
 
 -- no RecStmt case because they get flattened above when doing the LHSes
 rn_rec_stmt _ _ stmt@(L _ (RecStmt {}), _)
@@ -1114,7 +1114,7 @@ rn_rec_stmt _ _ stmt@(L _ (ParStmt {}), _)       -- Syntactically illegal in mdo
 rn_rec_stmt _ _ stmt@(L _ (TransStmt {}), _)     -- Syntactically illegal in mdo
   = pprPanic "rn_rec_stmt: TransStmt" (ppr stmt)
 
-rn_rec_stmt _ _ (L _ (LetStmt EmptyLocalBinds), _)
+rn_rec_stmt _ _ (L _ (LetStmt (L _ EmptyLocalBinds)), _)
   = panic "rn_rec_stmt: LetStmt EmptyLocalBinds"
 
 rn_rec_stmt _ _ stmt@(L _ (ApplicativeStmt {}), _)
@@ -1747,8 +1747,8 @@ okPatGuardStmt stmt
 -------------
 okParStmt dflags ctxt stmt
   = case stmt of
-      LetStmt (HsIPBinds {}) -> emptyInvalid
-      _                      -> okStmt dflags ctxt stmt
+      LetStmt (L _ (HsIPBinds {})) -> emptyInvalid
+      _                            -> okStmt dflags ctxt stmt
 
 ----------------
 okDoStmt dflags ctxt stmt
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 37a972aa4d..7fff70312d 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -954,7 +954,7 @@ checkPrecMatch :: Name -> MatchGroup Name body -> RnM ()
   --   eg  a `op` b `C` c = ...
   -- See comments with rnExpr (OpApp ...) about "deriving"
 
-checkPrecMatch op (MG { mg_alts = ms })
+checkPrecMatch op (MG { mg_alts = L _ ms })
   = mapM_ check ms
   where
     check (L _ (Match _ (L l1 p1 : L l2 p2 :_) _ _))
diff --git a/compiler/typecheck/TcArrows.hs b/compiler/typecheck/TcArrows.hs
index 76ef03785b..bb7a3744f0 100644
--- a/compiler/typecheck/TcArrows.hs
+++ b/compiler/typecheck/TcArrows.hs
@@ -136,11 +136,11 @@ tc_cmd env (HsCmdPar cmd) res_ty
   = do  { cmd' <- tcCmd env cmd res_ty
         ; return (HsCmdPar cmd') }
 
-tc_cmd env (HsCmdLet binds (L body_loc body)) res_ty
+tc_cmd env (HsCmdLet (L l binds) (L body_loc body)) res_ty
   = do  { (binds', body') <- tcLocalBinds binds         $
                              setSrcSpan body_loc        $
                              tc_cmd env body res_ty
-        ; return (HsCmdLet binds' (L body_loc body')) }
+        ; return (HsCmdLet (L l binds') (L body_loc body')) }
 
 tc_cmd env in_cmd@(HsCmdCase scrut matches) (stk, res_ty)
   = addErrCtxt (cmdCtxt in_cmd) $ do
@@ -234,7 +234,7 @@ tc_cmd env cmd@(HsCmdApp fun arg) (cmd_stk, res_ty)
 -- D;G |-a (\x.cmd) : (t,stk) --> res
 
 tc_cmd env
-       (HsCmdLam (MG { mg_alts = [L mtch_loc
+       (HsCmdLam (MG { mg_alts = L l [L mtch_loc
                                    (match@(Match _ pats _maybe_rhs_sig grhss))],
                        mg_origin = origin }))
        (cmd_stk, res_ty)
@@ -248,7 +248,7 @@ tc_cmd env
 
         ; let match' = L mtch_loc (Match NonFunBindMatch pats' Nothing grhss')
               arg_tys = map hsLPatType pats'
-              cmd' = HsCmdLam (MG { mg_alts = [match'], mg_arg_tys = arg_tys
+              cmd' = HsCmdLam (MG { mg_alts = L l [match'], mg_arg_tys = arg_tys
                                   , mg_res_ty = res_ty, mg_origin = origin })
         ; return (mkHsCmdCast co cmd') }
   where
@@ -256,10 +256,10 @@ tc_cmd env
     match_ctxt = (LambdaExpr :: HsMatchContext Name)    -- Maybe KappaExpr?
     pg_ctxt    = PatGuard match_ctxt
 
-    tc_grhss (GRHSs grhss binds) stk_ty res_ty
+    tc_grhss (GRHSs grhss (L l binds)) stk_ty res_ty
         = do { (binds', grhss') <- tcLocalBinds binds $
                                    mapM (wrapLocM (tc_grhs stk_ty res_ty)) grhss
-             ; return (GRHSs grhss' binds') }
+             ; return (GRHSs grhss' (L l binds')) }
 
     tc_grhs stk_ty res_ty (GRHS guards body)
         = do { (guards', rhs') <- tcStmtsAndThen pg_ctxt tcGuardStmt guards res_ty $
@@ -269,10 +269,10 @@ tc_cmd env
 -------------------------------------------
 --              Do notation
 
-tc_cmd env (HsCmdDo stmts _) (cmd_stk, res_ty)
+tc_cmd env (HsCmdDo (L l stmts) _) (cmd_stk, res_ty)
   = do  { co <- unifyType unitTy cmd_stk  -- Expecting empty argument stack
         ; stmts' <- tcStmts ArrowExpr (tcArrDoStmt env) stmts res_ty
-        ; return (mkHsCmdCast co (HsCmdDo stmts' res_ty)) }
+        ; return (mkHsCmdCast co (HsCmdDo (L l stmts') res_ty)) }
 
 
 -----------------------------------------------------------------
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index 9f96a91c9a..ff97fecd50 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -1797,8 +1797,8 @@ decideGeneralisationPlan dflags type_env bndr_names lbinds sig_fn
     restricted (PatSynBind {}) = panic "isRestrictedGroup/unrestricted PatSynBind"
     restricted (AbsBinds {}) = panic "isRestrictedGroup/unrestricted AbsBinds"
 
-    restricted_match (MG { mg_alts = L _ (Match _ [] _ _) : _ }) = True
-    restricted_match _                                           = False
+    restricted_match (MG { mg_alts = L _ (L _ (Match _ [] _ _) : _ )}) = True
+    restricted_match _                                                 = False
         -- No args => like a pattern binding
         -- Some args => a function binding
 
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index caf732ba7f..a97c75424e 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -434,10 +434,10 @@ tcExpr (ExplicitPArr _ exprs) res_ty    -- maybe empty
 ************************************************************************
 -}
 
-tcExpr (HsLet binds expr) res_ty
+tcExpr (HsLet (L l binds) expr) res_ty
   = do  { (binds', expr') <- tcLocalBinds binds $
                              tcMonoExpr expr res_ty
-        ; return (HsLet binds' expr') }
+        ; return (HsLet (L l binds') expr') }
 
 tcExpr (HsCase scrut matches) exp_ty
   = do  {  -- We used to typecheck the case alternatives first.
diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs
index 753ea052d0..284c594036 100644
--- a/compiler/typecheck/TcGenDeriv.hs
+++ b/compiler/typecheck/TcGenDeriv.hs
@@ -1720,7 +1720,7 @@ mkSimpleConMatch fold extra_pats con insides = do
     let vars_needed = takeList insides as_RDRs
     let pat = nlConVarPat con_name vars_needed
     rhs <- fold con_name (zipWith nlHsApp insides (map nlHsVar vars_needed))
-    return $ mkMatch (extra_pats ++ [pat]) rhs emptyLocalBinds
+    return $ mkMatch (extra_pats ++ [pat]) rhs (noLoc emptyLocalBinds)
 
 -- "case x of (a1,a2,a3) -> fold [x1 a1, x2 a2, x3 a3]"
 mkSimpleTupleCase :: Monad m => ([LPat RdrName] -> DataCon -> [a]
@@ -1919,7 +1919,8 @@ makeG_d.
 gen_Lift_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
 gen_Lift_binds loc tycon
   | null data_cons = (unitBag (L loc $ mkFunBind (L loc lift_RDR)
-                       [mkMatch [nlWildPat] errorMsg_Expr emptyLocalBinds])
+                       [mkMatch [nlWildPat] errorMsg_Expr
+                                            (noLoc emptyLocalBinds)])
                      , emptyBag)
   | otherwise = (unitBag lift_bind, emptyBag)
   where
@@ -2157,7 +2158,7 @@ mk_FunBind :: SrcSpan -> RdrName
 mk_FunBind loc fun pats_and_exprs
   = mkRdrFunBind (L loc fun) matches
   where
-    matches = [mkMatch p e emptyLocalBinds | (p,e) <-pats_and_exprs]
+    matches = [mkMatch p e (noLoc emptyLocalBinds) | (p,e) <-pats_and_exprs]
 
 mkRdrFunBind :: Located RdrName -> [LMatch RdrName (LHsExpr RdrName)] -> LHsBind RdrName
 mkRdrFunBind fun@(L loc fun_rdr) matches = L loc (mkFunBind fun matches')
@@ -2168,7 +2169,7 @@ mkRdrFunBind fun@(L loc fun_rdr) matches = L loc (mkFunBind fun matches')
    -- which can happen with -XEmptyDataDecls
    -- See Trac #4302
    matches' = if null matches
-              then [mkMatch [] (error_Expr str) emptyLocalBinds]
+              then [mkMatch [] (error_Expr str) (noLoc emptyLocalBinds)]
               else matches
    str = "Void " ++ occNameString (rdrNameOcc fun_rdr)
 
diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs
index 7dd9559089..a11f9d6370 100644
--- a/compiler/typecheck/TcHsSyn.hs
+++ b/compiler/typecheck/TcHsSyn.hs
@@ -537,11 +537,13 @@ zonkLTcSpecPrags env ps
 zonkMatchGroup :: ZonkEnv
                -> (ZonkEnv -> Located (body TcId) -> TcM (Located (body Id)))
                -> MatchGroup TcId (Located (body TcId)) -> TcM (MatchGroup Id (Located (body Id)))
-zonkMatchGroup env zBody (MG { mg_alts = ms, mg_arg_tys = arg_tys, mg_res_ty = res_ty, mg_origin = origin })
+zonkMatchGroup env zBody (MG { mg_alts = L l ms, mg_arg_tys = arg_tys
+                             , mg_res_ty = res_ty, mg_origin = origin })
   = do  { ms' <- mapM (zonkMatch env zBody) ms
         ; arg_tys' <- zonkTcTypeToTypes env arg_tys
         ; res_ty'  <- zonkTcTypeToType env res_ty
-        ; return (MG { mg_alts = ms', mg_arg_tys = arg_tys', mg_res_ty = res_ty', mg_origin = origin }) }
+        ; return (MG { mg_alts = L l ms', mg_arg_tys = arg_tys'
+                     , mg_res_ty = res_ty', mg_origin = origin }) }
 
 zonkMatch :: ZonkEnv
           -> (ZonkEnv -> Located (body TcId) -> TcM (Located (body Id)))
@@ -556,7 +558,7 @@ zonkGRHSs :: ZonkEnv
           -> (ZonkEnv -> Located (body TcId) -> TcM (Located (body Id)))
           -> GRHSs TcId (Located (body TcId)) -> TcM (GRHSs Id (Located (body Id)))
 
-zonkGRHSs env zBody (GRHSs grhss binds) = do
+zonkGRHSs env zBody (GRHSs grhss (L l binds)) = do
     (new_env, new_binds) <- zonkLocalBinds env binds
     let
         zonk_grhs (GRHS guarded rhs)
@@ -564,7 +566,7 @@ zonkGRHSs env zBody (GRHSs grhss binds) = do
                new_rhs <- zBody env2 rhs
                return (GRHS new_guarded new_rhs)
     new_grhss <- mapM (wrapLocM zonk_grhs) grhss
-    return (GRHSs new_grhss new_binds)
+    return (GRHSs new_grhss (L l new_binds))
 
 {-
 ************************************************************************
@@ -680,15 +682,15 @@ zonkExpr env (HsMultiIf ty alts)
                ; expr'          <- zonkLExpr env' expr
                ; return $ GRHS guard' expr' }
 
-zonkExpr env (HsLet binds expr)
+zonkExpr env (HsLet (L l binds) expr)
   = do (new_env, new_binds) <- zonkLocalBinds env binds
        new_expr <- zonkLExpr new_env expr
-       return (HsLet new_binds new_expr)
+       return (HsLet (L l new_binds) new_expr)
 
-zonkExpr env (HsDo do_or_lc stmts ty)
+zonkExpr env (HsDo do_or_lc (L l stmts) ty)
   = do (_, new_stmts) <- zonkStmts env zonkLExpr stmts
        new_ty <- zonkTcTypeToType env ty
-       return (HsDo do_or_lc new_stmts new_ty)
+       return (HsDo do_or_lc (L l new_stmts) new_ty)
 
 zonkExpr env (ExplicitList ty wit exprs)
   = do new_ty <- zonkTcTypeToType env ty
@@ -818,15 +820,15 @@ zonkCmd env (HsCmdIf eCond ePred cThen cElse)
        ; new_cElse <- zonkLCmd env cElse
        ; return (HsCmdIf new_eCond new_ePred new_cThen new_cElse) }
 
-zonkCmd env (HsCmdLet binds cmd)
+zonkCmd env (HsCmdLet (L l binds) cmd)
   = do (new_env, new_binds) <- zonkLocalBinds env binds
        new_cmd <- zonkLCmd new_env cmd
-       return (HsCmdLet new_binds new_cmd)
+       return (HsCmdLet (L l new_binds) new_cmd)
 
-zonkCmd env (HsCmdDo stmts ty)
+zonkCmd env (HsCmdDo (L l stmts) ty)
   = do (_, new_stmts) <- zonkStmts env zonkLCmd stmts
        new_ty <- zonkTcTypeToType env ty
-       return (HsCmdDo new_stmts new_ty)
+       return (HsCmdDo (L l new_stmts) new_ty)
 
 
 
@@ -979,9 +981,9 @@ zonkStmt env _ (TransStmt { trS_stmts = stmts, trS_bndrs = binderMap
         newBinder' <- zonkIdBndr env newBinder
         return (oldBinder', newBinder')
 
-zonkStmt env _ (LetStmt binds)
+zonkStmt env _ (LetStmt (L l binds))
   = do (env1, new_binds) <- zonkLocalBinds env binds
-       return (env1, LetStmt new_binds)
+       return (env1, LetStmt (L l new_binds))
 
 zonkStmt env zBody (BindStmt pat body bind_op fail_op)
   = do  { new_body <- zBody env body
diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs
index 81dfb6cc52..d7dbddf6ec 100644
--- a/compiler/typecheck/TcMatches.hs
+++ b/compiler/typecheck/TcMatches.hs
@@ -104,7 +104,8 @@ tcMatchesCase :: (Outputable (body Name)) =>
 
 tcMatchesCase ctxt scrut_ty matches res_ty
   | isEmptyMatchGroup matches   -- Allow empty case expressions
-  = return (MG { mg_alts = [], mg_arg_tys = [scrut_ty], mg_res_ty = res_ty, mg_origin = mg_origin matches })
+  = return (MG { mg_alts = noLoc [], mg_arg_tys = [scrut_ty]
+               , mg_res_ty = res_ty, mg_origin = mg_origin matches })
 
   | otherwise
   = tcMatches ctxt [scrut_ty] res_ty matches
@@ -170,10 +171,11 @@ data TcMatchCtxt body   -- c.f. TcStmtCtxt, also in this module
                  -> TcRhoType
                  -> TcM (Located (body TcId)) }
 
-tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = matches, mg_origin = origin })
+tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches, mg_origin = origin })
   = ASSERT( not (null matches) )        -- Ensure that rhs_ty is filled in
     do  { matches' <- mapM (tcMatch ctxt pat_tys rhs_ty) matches
-        ; return (MG { mg_alts = matches', mg_arg_tys = pat_tys, mg_res_ty = rhs_ty, mg_origin = origin }) }
+        ; return (MG { mg_alts = L l matches', mg_arg_tys = pat_tys
+                     , mg_res_ty = rhs_ty, mg_origin = origin }) }
 
 -------------
 tcMatch :: (Outputable (body Name)) => TcMatchCtxt body
@@ -215,11 +217,11 @@ tcGRHSs :: TcMatchCtxt body -> GRHSs Name (Located (body Name)) -> TcRhoType
 -- We used to force it to be a monotype when there was more than one guard
 -- but we don't need to do that any more
 
-tcGRHSs ctxt (GRHSs grhss binds) res_ty
+tcGRHSs ctxt (GRHSs grhss (L l binds)) res_ty
   = do  { (binds', grhss') <- tcLocalBinds binds $
                               mapM (wrapLocM (tcGRHS ctxt res_ty)) grhss
 
-        ; return (GRHSs grhss' binds') }
+        ; return (GRHSs grhss' (L l binds')) }
 
 -------------
 tcGRHS :: TcMatchCtxt body -> TcRhoType -> GRHS Name (Located (body Name))
@@ -241,32 +243,32 @@ tcGRHS ctxt res_ty (GRHS guards rhs)
 -}
 
 tcDoStmts :: HsStmtContext Name
-          -> [LStmt Name (LHsExpr Name)]
+          -> Located [LStmt Name (LHsExpr Name)]
           -> TcRhoType
           -> TcM (HsExpr TcId)          -- Returns a HsDo
-tcDoStmts ListComp stmts res_ty
+tcDoStmts ListComp (L l stmts) res_ty
   = do  { (co, elt_ty) <- matchExpectedListTy res_ty
         ; let list_ty = mkListTy elt_ty
         ; stmts' <- tcStmts ListComp (tcLcStmt listTyCon) stmts elt_ty
-        ; return $ mkHsWrapCo co (HsDo ListComp stmts' list_ty) }
+        ; return $ mkHsWrapCo co (HsDo ListComp (L l stmts') list_ty) }
 
-tcDoStmts PArrComp stmts res_ty
+tcDoStmts PArrComp (L l stmts) res_ty
   = do  { (co, elt_ty) <- matchExpectedPArrTy res_ty
         ; let parr_ty = mkPArrTy elt_ty
         ; stmts' <- tcStmts PArrComp (tcLcStmt parrTyCon) stmts elt_ty
-        ; return $ mkHsWrapCo co (HsDo PArrComp stmts' parr_ty) }
+        ; return $ mkHsWrapCo co (HsDo PArrComp (L l stmts') parr_ty) }
 
-tcDoStmts DoExpr stmts res_ty
+tcDoStmts DoExpr (L l stmts) res_ty
   = do  { stmts' <- tcStmts DoExpr tcDoStmt stmts res_ty
-        ; return (HsDo DoExpr stmts' res_ty) }
+        ; return (HsDo DoExpr (L l stmts') res_ty) }
 
-tcDoStmts MDoExpr stmts res_ty
+tcDoStmts MDoExpr (L l stmts) res_ty
   = do  { stmts' <- tcStmts MDoExpr tcDoStmt stmts res_ty
-        ; return (HsDo MDoExpr stmts' res_ty) }
+        ; return (HsDo MDoExpr (L l stmts') res_ty) }
 
-tcDoStmts MonadComp stmts res_ty
+tcDoStmts MonadComp (L l stmts) res_ty
   = do  { stmts' <- tcStmts MonadComp tcMcStmt stmts res_ty
-        ; return (HsDo MonadComp stmts' res_ty) }
+        ; return (HsDo MonadComp (L l stmts') res_ty) }
 
 tcDoStmts ctxt _ _ = pprPanic "tcDoStmts" (pprStmtContext ctxt)
 
@@ -320,10 +322,11 @@ tcStmtsAndThen _ _ [] res_ty thing_inside
         ; return ([], thing) }
 
 -- LetStmts are handled uniformly, regardless of context
-tcStmtsAndThen ctxt stmt_chk (L loc (LetStmt binds) : stmts) res_ty thing_inside
+tcStmtsAndThen ctxt stmt_chk (L loc (LetStmt (L l binds)) : stmts)
+                                                             res_ty thing_inside
   = do  { (binds', (stmts',thing)) <- tcLocalBinds binds $
               tcStmtsAndThen ctxt stmt_chk stmts res_ty thing_inside
-        ; return (L loc (LetStmt binds') : stmts', thing) }
+        ; return (L loc (LetStmt (L l binds')) : stmts', thing) }
 
 -- Don't set the error context for an ApplicativeStmt.  It ought to be
 -- possible to do this with a popErrCtxt in the tcStmt case for
@@ -950,9 +953,9 @@ number of args are used in each equation.
 -}
 
 checkArgs :: Name -> MatchGroup Name body -> TcM ()
-checkArgs _ (MG { mg_alts = [] })
+checkArgs _ (MG { mg_alts = L _ [] })
     = return ()
-checkArgs fun (MG { mg_alts = match1:matches })
+checkArgs fun (MG { mg_alts = L _ (match1:matches) })
     | null bad_matches
     = return ()
     | otherwise
diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs
index 094d3f62af..b27c9e38ff 100644
--- a/compiler/typecheck/TcPatSyn.hs
+++ b/compiler/typecheck/TcPatSyn.hs
@@ -331,20 +331,21 @@ tcPatSynMatcher (L loc name) lpat
              body = mkLHsWrap (mkWpLet req_ev_binds) $
                     L (getLoc lpat) $
                     HsCase (nlHsVar scrutinee) $
-                    MG{ mg_alts = cases
+                    MG{ mg_alts = L (getLoc lpat) cases
                       , mg_arg_tys = [pat_ty]
                       , mg_res_ty = res_ty
                       , mg_origin = Generated
                       }
              body' = noLoc $
                      HsLam $
-                     MG{ mg_alts = [mkSimpleMatch args body]
+                     MG{ mg_alts = noLoc [mkSimpleMatch args body]
                        , mg_arg_tys = [pat_ty, cont_ty, res_ty]
                        , mg_res_ty = res_ty
                        , mg_origin = Generated
                        }
-             match = mkMatch [] (mkHsLams (res_tv:univ_tvs) req_dicts body') EmptyLocalBinds
-             mg = MG{ mg_alts = [match]
+             match = mkMatch [] (mkHsLams (res_tv:univ_tvs) req_dicts body')
+                             (noLoc EmptyLocalBinds)
+             mg = MG{ mg_alts = L (getLoc match) [match]
                     , mg_arg_tys = []
                     , mg_res_ty = res_ty
                     , mg_origin = Generated
@@ -446,9 +447,9 @@ tcPatSynBuilderBind PSB{ psb_id = L loc name, psb_def = lpat
 
     mk_mg :: LHsExpr Name -> MatchGroup Name (LHsExpr Name)
     mk_mg body = mkMatchGroupName Generated [builder_match]
-               where
-                 builder_args  = [L loc (VarPat n) | L loc n <- args]
-                 builder_match = mkMatch builder_args body EmptyLocalBinds
+             where
+               builder_args  = [L loc (VarPat n) | L loc n <- args]
+               builder_match = mkMatch builder_args body (noLoc EmptyLocalBinds)
 
     args = case details of
               PrefixPatSyn args     -> args
@@ -456,8 +457,10 @@ tcPatSynBuilderBind PSB{ psb_id = L loc name, psb_def = lpat
               RecordPatSyn args     -> map recordPatSynPatVar args
 
     add_dummy_arg :: MatchGroup Name (LHsExpr Name) -> MatchGroup Name (LHsExpr Name)
-    add_dummy_arg mg@(MG {mg_alts = [L l (Match NonFunBindMatch [] ty grhss)] })
-      = mg { mg_alts = [L l (Match NonFunBindMatch [nlWildPatName] ty grhss)] }
+    add_dummy_arg mg@(MG { mg_alts
+                            = L l [L loc (Match NonFunBindMatch [] ty grhss)] })
+      = mg { mg_alts
+                = L l [L loc (Match NonFunBindMatch [nlWildPatName] ty grhss)] }
     add_dummy_arg other_mg = pprPanic "add_dummy_arg" $
                              pprMatches (PatSyn :: HsMatchContext Name) other_mg
 
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index febd8900f5..1987354dbd 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -1597,7 +1597,7 @@ tcUserStmt (L loc (BodyStmt expr _ _ _))
         ; uniq <- newUnique
         ; interPrintName <- getInteractivePrintName
         ; let fresh_it  = itName uniq loc
-              matches   = [mkMatch [] rn_expr emptyLocalBinds]
+              matches   = [mkMatch [] rn_expr (noLoc emptyLocalBinds)]
               -- [it = expr]
               the_bind  = L loc $ (mkTopFunBind FromSource (L loc fresh_it) matches) { bind_fvs = fvs }
                           -- Care here!  In GHCi the expression might have
@@ -1605,7 +1605,7 @@ tcUserStmt (L loc (BodyStmt expr _ _ _))
                           -- (if we are at a breakpoint, say).  We must put those free vars
 
               -- [let it = expr]
-              let_stmt  = L loc $ LetStmt $ HsValBinds $
+              let_stmt  = L loc $ LetStmt $ noLoc $ HsValBinds $
                           ValBindsOut [(NonRecursive,unitBag the_bind)] []
 
               -- [it <- e]
@@ -1734,7 +1734,7 @@ tcGhciStmts stmts
             stmts = tc_stmts ++ [noLoc (mkLastStmt ret_expr)]
         } ;
         return (ids, mkHsDictLet (EvBinds const_binds) $
-                     noLoc (HsDo GhciStmtCtxt stmts io_ret_ty))
+                     noLoc (HsDo GhciStmtCtxt (noLoc stmts) io_ret_ty))
     }
 
 -- | Generate a typed ghciStepIO expression (ghciStep :: Ty a -> IO a)