API Annotations tweaks.

Summary:
HsTyLit now has SourceText

Update documentation of HsSyn to reflect which annotations are attached to which element.

Ensure that the parser always keeps HsSCC and HsTickPragma values, to
be ignored in the desugar phase if not needed

Bringing in SourceText for pragmas

Add Location in NPlusKPat

Add Location in FunDep

Make RecCon payload Located

Explicitly add AnnVal to RdrName where it is compound

Add Location in IPBind

Add Location to name in IEThingAbs

Add Maybe (Located id,Bool) to Match to track fun_id,infix
  This includes converting Match into a record and adding a note about why
  the fun_id needs to be replicated in the Match.

Add Location in KindedTyVar

Sort out semi-colons for parsing

  - import statements
  - stmts
  - decls
  - decls_cls
  - decls_inst

This updates the haddock submodule.

Test Plan: ./validate

Reviewers: hvr, austin, goldfire, simonpj

Reviewed By: simonpj

Subscribers: thomie, carter

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

9 files changed, 86 insertions, 66 deletions

diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 7284db3bc8..3d53e698d8 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -452,11 +452,11 @@ get_lit :: Pat id -> Maybe HsLit
 -- It doesn't matter which one, because they will only be compared
 -- with other HsLits gotten in the same way
 get_lit (LitPat lit)                                      = Just lit
-get_lit (NPat (OverLit { ol_val = HsIntegral src i})    mb _)
+get_lit (NPat (L _ (OverLit { ol_val = HsIntegral src i}))    mb _)
                         = Just (HsIntPrim src (mb_neg negate              mb i))
-get_lit (NPat (OverLit { ol_val = HsFractional f }) mb _)
+get_lit (NPat (L _ (OverLit { ol_val = HsFractional f })) mb _)
                         = Just (HsFloatPrim (mb_neg negateFractionalLit mb f))
-get_lit (NPat (OverLit { ol_val = HsIsString src s })   _  _)
+get_lit (NPat (L _ (OverLit { ol_val = HsIsString src s }))   _  _)
                         = Just (HsStringPrim src (fastStringToByteString s))
 get_lit _                                                 = Nothing
 
@@ -727,7 +727,7 @@ tidy_pat (TuplePat ps boxity tys)
   where
     arity = length ps
 
-tidy_pat (NPat lit mb_neg eq) = tidyNPat tidy_lit_pat lit mb_neg eq
+tidy_pat (NPat (L _ lit) mb_neg eq) = tidyNPat tidy_lit_pat lit mb_neg eq
 tidy_pat (LitPat lit)         = tidy_lit_pat lit
 
 tidy_pat (ConPatIn {})        = panic "Check.tidy_pat: ConPatIn"
diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index d81599d30e..b44e9d8fa4 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -567,7 +567,7 @@ addTickHsExpr (HsTick t e) =
 addTickHsExpr (HsBinTick t0 t1 e) =
         liftM (HsBinTick t0 t1) (addTickLHsExprNever e)
 
-addTickHsExpr (HsTickPragma _ (L pos e0)) = do
+addTickHsExpr (HsTickPragma _ _ (L pos e0)) = do
     e2 <- allocTickBox (ExpBox False) False False pos $
                 addTickHsExpr e0
     return $ unLoc e2
@@ -575,12 +575,14 @@ addTickHsExpr (PArrSeq   ty arith_seq) =
         liftM2 PArrSeq
                 (return ty)
                 (addTickArithSeqInfo arith_seq)
-addTickHsExpr (HsSCC nm e) =
-        liftM2 HsSCC
+addTickHsExpr (HsSCC src nm e) =
+        liftM3 HsSCC
+                (return src)
                 (return nm)
                 (addTickLHsExpr e)
-addTickHsExpr (HsCoreAnn nm e) =
-        liftM2 HsCoreAnn
+addTickHsExpr (HsCoreAnn src nm e) =
+        liftM3 HsCoreAnn
+                (return src)
                 (return nm)
                 (addTickLHsExpr e)
 addTickHsExpr e@(HsBracket     {})   = return e
@@ -614,10 +616,10 @@ addTickMatchGroup is_lam mg@(MG { mg_alts = matches }) = do
   return $ mg { mg_alts = matches' }
 
 addTickMatch :: Bool -> Bool -> Match Id (LHsExpr Id) -> TM (Match Id (LHsExpr Id))
-addTickMatch isOneOfMany isLambda (Match pats opSig gRHSs) =
+addTickMatch isOneOfMany isLambda (Match mf pats opSig gRHSs) =
   bindLocals (collectPatsBinders pats) $ do
     gRHSs' <- addTickGRHSs isOneOfMany isLambda gRHSs
-    return $ Match 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
@@ -829,10 +831,10 @@ addTickCmdMatchGroup mg@(MG { mg_alts = matches }) = do
   return $ mg { mg_alts = matches' }
 
 addTickCmdMatch :: Match Id (LHsCmd Id) -> TM (Match Id (LHsCmd Id))
-addTickCmdMatch (Match pats opSig gRHSs) =
+addTickCmdMatch (Match mf pats opSig gRHSs) =
   bindLocals (collectPatsBinders pats) $ do
     gRHSs' <- addTickCmdGRHSs gRHSs
-    return $ Match 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
@@ -1204,7 +1206,7 @@ hpcSrcSpan = mkGeneralSrcSpan (fsLit "Haskell Program Coverage internals")
 matchesOneOfMany :: [LMatch Id body] -> Bool
 matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1
   where
-        matchCount (L _ (Match _pats _ty (GRHSs grhss _binds))) = length grhss
+        matchCount (L _ (Match _ _pats _ty (GRHSs grhss _binds))) = length grhss
 
 type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel)
 
diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index 70fa88e657..e4181b9bdb 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -461,12 +461,12 @@ by simpleOptExpr (for the LHS) resp. the simplifiers (for the RHS).
 -}
 
 dsVect :: LVectDecl Id -> DsM CoreVect
-dsVect (L loc (HsVect (L _ v) rhs))
+dsVect (L loc (HsVect _ (L _ v) rhs))
   = putSrcSpanDs loc $
     do { rhs' <- dsLExpr rhs
        ; return $ Vect v rhs'
        }
-dsVect (L _loc (HsNoVect (L _ v)))
+dsVect (L _loc (HsNoVect _ (L _ v)))
   = return $ NoVect v
 dsVect (L _loc (HsVectTypeOut isScalar tycon rhs_tycon))
   = return $ VectType isScalar tycon' rhs_tycon
@@ -474,11 +474,11 @@ dsVect (L _loc (HsVectTypeOut isScalar tycon rhs_tycon))
     tycon' | Just ty <- coreView $ mkTyConTy tycon
            , (tycon', []) <- splitTyConApp ty      = tycon'
            | otherwise                             = tycon
-dsVect vd@(L _ (HsVectTypeIn _ _ _))
+dsVect vd@(L _ (HsVectTypeIn _ _ _ _))
   = pprPanic "Desugar.dsVect: unexpected 'HsVectTypeIn'" (ppr vd)
 dsVect (L _loc (HsVectClassOut cls))
   = return $ VectClass (classTyCon cls)
-dsVect vc@(L _ (HsVectClassIn _))
+dsVect vc@(L _ (HsVectClassIn _ _))
   = pprPanic "Desugar.dsVect: unexpected 'HsVectClassIn'" (ppr vc)
 dsVect (L _loc (HsVectInstOut inst))
   = return $ VectInst (instanceDFunId inst)
diff --git a/compiler/deSugar/DsArrows.hs b/compiler/deSugar/DsArrows.hs
index 8f5b30e73d..220ed3cbad 100644
--- a/compiler/deSugar/DsArrows.hs
+++ b/compiler/deSugar/DsArrows.hs
@@ -399,7 +399,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 _ (Match _ pats _
+                                       (GRHSs [L _ (GRHS [] body)] _ ))] }))
         env_ids = do
     let
         pat_vars = mkVarSet (collectPatsBinders pats)
@@ -1046,7 +1047,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 binds)))
   = let
         defined_vars = mkVarSet (collectPatsBinders pats)
                         `unionVarSet`
@@ -1065,11 +1066,11 @@ replaceLeavesMatch
         -> LMatch Id (Located (body Id))        -- the matches of a case command
         -> ([Located (body' Id)],               -- remaining leaf expressions
             LMatch Id (Located (body' Id)))     -- updated match
-replaceLeavesMatch _res_ty leaves (L loc (Match pat mt (GRHSs grhss binds)))
+replaceLeavesMatch _res_ty leaves (L loc (Match mf pat mt (GRHSs grhss binds)))
   = let
         (leaves', grhss') = mapAccumL replaceLeavesGRHS leaves grhss
     in
-    (leaves', L loc (Match pat mt (GRHSs grhss' binds)))
+    (leaves', L loc (Match mf pat mt (GRHSs grhss' binds)))
 
 replaceLeavesGRHS
         :: [Located (body' Id)]                 -- replacement leaf expressions of that type
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index 4bffdbc06a..3b176a5847 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -300,13 +300,18 @@ dsExpr (ExplicitTuple tup_args boxity)
                   mkCoreConApps (tupleCon (boxityNormalTupleSort boxity) (length tup_args))
                                 (map (Type . exprType) args ++ args) }
 
-dsExpr (HsSCC cc expr@(L loc _)) = do
-    mod_name <- getModule
-    count <- goptM Opt_ProfCountEntries
-    uniq <- newUnique
-    Tick (ProfNote (mkUserCC cc mod_name loc uniq) count True) <$> dsLExpr expr
-
-dsExpr (HsCoreAnn _ expr)
+dsExpr (HsSCC _ cc expr@(L loc _)) = do
+    dflags <- getDynFlags
+    if gopt Opt_SccProfilingOn dflags
+      then do
+        mod_name <- getModule
+        count <- goptM Opt_ProfCountEntries
+        uniq <- newUnique
+        Tick (ProfNote (mkUserCC cc mod_name loc uniq) count True)
+               <$> dsLExpr expr
+      else dsLExpr expr
+
+dsExpr (HsCoreAnn _ _ expr)
   = dsLExpr expr
 
 dsExpr (HsCase discrim matches)
@@ -669,13 +674,18 @@ dsExpr (HsBinTick ixT ixF e) = do
        mkBinaryTickBox ixT ixF e2
      }
 
+dsExpr (HsTickPragma _ _ expr) = do
+  dflags <- getDynFlags
+  if gopt Opt_Hpc dflags
+    then panic "dsExpr:HsTickPragma"
+    else dsLExpr expr
+
 -- HsSyn constructs that just shouldn't be here:
 dsExpr (ExprWithTySig {})  = panic "dsExpr:ExprWithTySig"
 dsExpr (HsBracket     {})  = panic "dsExpr:HsBracket"
 dsExpr (HsQuasiQuoteE {})  = panic "dsExpr:HsQuasiQuoteE"
 dsExpr (HsArrApp      {})  = panic "dsExpr:HsArrApp"
 dsExpr (HsArrForm     {})  = panic "dsExpr:HsArrForm"
-dsExpr (HsTickPragma  {})  = panic "dsExpr:HsTickPragma"
 dsExpr (EWildPat      {})  = panic "dsExpr:EWildPat"
 dsExpr (EAsPat        {})  = panic "dsExpr:EAsPat"
 dsExpr (EViewPat      {})  = panic "dsExpr:EViewPat"
@@ -684,6 +694,7 @@ dsExpr (HsType        {})  = panic "dsExpr:HsType"
 dsExpr (HsDo          {})  = panic "dsExpr:HsDo"
 
 
+
 findField :: [LHsRecField Id arg] -> Name -> [arg]
 findField rbinds lbl
   = [rhs | L _ (HsRecField { hsRecFieldId = id, hsRecFieldArg = rhs }) <- rbinds
diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs
index 0ae14f8d1d..715e1ce087 100644
--- a/compiler/deSugar/DsForeign.hs
+++ b/compiler/deSugar/DsForeign.hs
@@ -713,7 +713,7 @@ toCType = f False
            -- Note that we aren't looking through type synonyms or
            -- anything, as it may be the synonym that is annotated.
            | TyConApp tycon _ <- t
-           , Just (CType mHeader cType) <- tyConCType_maybe tycon
+           , Just (CType _ mHeader cType) <- tyConCType_maybe tycon
               = (mHeader, ftext cType)
            -- If we don't know a C type for this type, then try looking
            -- through one layer of type synonym etc.
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index b7445a8e2b..63b65398eb 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -147,9 +147,11 @@ repTopDs group@(HsGroup { hs_valds   = valds
                      ; fix_ds   <- mapM repFixD fixds
                      ; _        <- mapM no_default_decl defds
                      ; for_ds   <- mapM repForD fords
-                     ; _        <- mapM no_warn warnds
+                     ; _        <- mapM no_warn (concatMap (wd_warnings . unLoc)
+                                                           warnds)
                      ; ann_ds   <- mapM repAnnD annds
-                     ; rule_ds  <- mapM repRuleD ruleds
+                     ; rule_ds  <- mapM repRuleD (concatMap (rds_rules . unLoc)
+                                                            ruleds)
                      ; _        <- mapM no_vect vects
                      ; _        <- mapM no_doc docs
 
@@ -361,7 +363,7 @@ mk_extra_tvs tc tvs defn
       = do { uniq <- newUnique
            ; let { occ = mkTyVarOccFS (fsLit "t")
                  ; nm = mkInternalName uniq occ loc
-                 ; hs_tv = L loc (KindedTyVar nm kind) }
+                 ; hs_tv = L loc (KindedTyVar (noLoc nm) kind) }
            ; hs_tvs <- go rest
            ; return (hs_tv : hs_tvs) }
 
@@ -374,13 +376,14 @@ mk_extra_tvs tc tvs defn
 -------------------------
 -- represent fundeps
 --
-repLFunDeps :: [Located (FunDep Name)] -> DsM (Core [TH.FunDep])
+repLFunDeps :: [Located (FunDep (Located Name))] -> DsM (Core [TH.FunDep])
 repLFunDeps fds = repList funDepTyConName repLFunDep fds
 
-repLFunDep :: Located (FunDep Name) -> DsM (Core TH.FunDep)
-repLFunDep (L _ (xs, ys)) = do xs' <- repList nameTyConName lookupBinder xs
-                               ys' <- repList nameTyConName lookupBinder ys
-                               repFunDep xs' ys'
+repLFunDep :: Located (FunDep (Located Name)) -> DsM (Core TH.FunDep)
+repLFunDep (L _ (xs, ys))
+   = do xs' <- repList nameTyConName (lookupBinder . unLoc) xs
+        ys' <- repList nameTyConName (lookupBinder . unLoc) ys
+        repFunDep xs' ys'
 
 -- represent family declaration flavours
 --
@@ -550,17 +553,17 @@ repRuleBndr (L _ (RuleBndrSig n (HsWB { hswb_cts = ty })))
        ; rep2 typedRuleVarName [n', ty'] }
 
 repAnnD :: LAnnDecl Name -> DsM (SrcSpan, Core TH.DecQ)
-repAnnD (L loc (HsAnnotation ann_prov (L _ exp)))
+repAnnD (L loc (HsAnnotation _ ann_prov (L _ exp)))
   = do { target <- repAnnProv ann_prov
        ; exp'   <- repE exp
        ; dec    <- repPragAnn target exp'
        ; return (loc, dec) }
 
 repAnnProv :: AnnProvenance Name -> DsM (Core TH.AnnTarget)
-repAnnProv (ValueAnnProvenance n)
+repAnnProv (ValueAnnProvenance (L _ n))
   = do { MkC n' <- globalVar n  -- ANNs are allowed only at top-level
        ; rep2 valueAnnotationName [ n' ] }
-repAnnProv (TypeAnnProvenance n)
+repAnnProv (TypeAnnProvenance (L _ n))
   = do { MkC n' <- globalVar n
        ; rep2 typeAnnotationName [ n' ] }
 repAnnProv ModuleAnnProvenance
@@ -619,7 +622,7 @@ mkGadtCtxt :: [Name]            -- Tyvars of the data type
 -- This function is fiddly, but not really hard
 mkGadtCtxt _ ResTyH98
   = return ([], [])
-mkGadtCtxt data_tvs (ResTyGADT res_ty)
+mkGadtCtxt data_tvs (ResTyGADT _ res_ty)
   | Just (_, tys) <- hsTyGetAppHead_maybe res_ty
   , data_tvs `equalLength` tys
   = return (go [] [] (data_tvs `zip` tys))
@@ -651,9 +654,9 @@ repBangTy ty= do
   rep2 strictTypeName [s, t]
   where
     (str, ty') = case ty of
-                   L _ (HsBangTy (HsSrcBang (Just True) True) ty) -> (unpackedName,  ty)
-                   L _ (HsBangTy (HsSrcBang _     True) ty)       -> (isStrictName,  ty)
-                   _                                              -> (notStrictName, ty)
+         L _ (HsBangTy (HsSrcBang _ (Just True) True) ty) -> (unpackedName,  ty)
+         L _ (HsBangTy (HsSrcBang _ _     True) ty)       -> (isStrictName,  ty)
+         _                                                -> (notStrictName, ty)
 
 -------------------------------------------------------
 --                      Deriving clause
@@ -695,7 +698,7 @@ rep_sig (L _   (FixSig {}))           = return [] -- fixity sigs at top level
 rep_sig (L loc (InlineSig nm ispec))  = rep_inline nm ispec loc
 rep_sig (L loc (SpecSig nm tys ispec))
    = concatMapM (\t -> rep_specialise nm t ispec loc) tys
-rep_sig (L loc (SpecInstSig ty))      = rep_specialiseInst ty loc
+rep_sig (L loc (SpecInstSig _ ty))    = rep_specialiseInst ty loc
 rep_sig (L _   (MinimalSig {}))       = notHandled "MINIMAL pragmas" empty
 
 rep_ty_sig :: Name -> SrcSpan -> LHsType Name -> Located Name
@@ -913,11 +916,11 @@ repTy (HsTyLit lit) = do
 repTy ty                      = notHandled "Exotic form of type" (ppr ty)
 
 repTyLit :: HsTyLit -> DsM (Core TH.TyLitQ)
-repTyLit (HsNumTy i) = do iExpr <- mkIntegerExpr i
-                          rep2 numTyLitName [iExpr]
-repTyLit (HsStrTy s) = do { s' <- mkStringExprFS s
-                         ; rep2 strTyLitName [s']
-                         }
+repTyLit (HsNumTy _ i) = do iExpr <- mkIntegerExpr i
+                            rep2 numTyLitName [iExpr]
+repTyLit (HsStrTy _ s) = do { s' <- mkStringExprFS s
+                            ; rep2 strTyLitName [s']
+                            }
 
 -- represent a kind
 --
@@ -1104,7 +1107,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 wheres))) =
   do { ss1 <- mkGenSyms (collectPatBinders p)
      ; addBinds ss1 $ do {
      ; p1 <- repLP p
@@ -1116,7 +1119,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 wheres))) =
   do { ss1 <- mkGenSyms (collectPatsBinders ps)
      ; addBinds ss1 $ do {
        ps1 <- repLPs ps
@@ -1268,8 +1271,10 @@ rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
 -- Note GHC treats declarations of a variable (not a pattern)
 -- e.g.  x = g 5 as a Fun MonoBinds. This is indicated by a single match
 -- with an empty list of patterns
-rep_bind (L loc (FunBind { fun_id = fn,
-                           fun_matches = MG { mg_alts = [L _ (Match [] _ (GRHSs guards wheres))] } }))
+rep_bind (L loc (FunBind
+                 { fun_id = fn,
+                   fun_matches = MG { mg_alts = [L _ (Match _ [] _
+                                                   (GRHSs guards wheres))] } }))
  = do { (ss,wherecore) <- repBinds wheres
         ; guardcore <- addBinds ss (repGuards guards)
         ; fn'  <- lookupLBinder fn
@@ -1328,7 +1333,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)] EmptyLocalBinds)))
  = do { let bndrs = collectPatsBinders ps ;
       ; ss  <- mkGenSyms bndrs
       ; lam <- addBinds ss (
@@ -1380,7 +1385,7 @@ repP (ConPatIn dc details)
                           ; MkC p <- repLP (hsRecFieldArg fld)
                           ; rep2 fieldPatName [v,p] }
 
-repP (NPat l Nothing _)  = do { a <- repOverloadedLiteral l; repPlit a }
+repP (NPat (L _ l) Nothing _)  = do { a <- repOverloadedLiteral l; repPlit a }
 repP (ViewPat e p _) = do { e' <- repLE e; p' <- repLP p; repPview e' p' }
 repP p@(NPat _ (Just _) _) = notHandled "Negative overloaded patterns" (ppr p)
 repP p@(SigPatIn {})  = notHandled "Type signatures in patterns" (ppr p)
@@ -1848,7 +1853,7 @@ repConstr con (PrefixCon ps)
     = do arg_tys  <- repList strictTypeQTyConName repBangTy ps
          rep2 normalCName [unC con, unC arg_tys]
 
-repConstr con (RecCon ips)
+repConstr con (RecCon (L _ ips))
     = do { args <- concatMapM rep_ip ips
          ; arg_vtys <- coreList varStrictTypeQTyConName args
          ; rep2 recCName [unC con, unC arg_vtys] }
diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs
index 5089f86298..c8e30f18a7 100644
--- a/compiler/deSugar/Match.hs
+++ b/compiler/deSugar/Match.hs
@@ -575,7 +575,7 @@ tidy1 _ (LitPat lit)
   = return (idDsWrapper, tidyLitPat lit)
 
 -- NPats: we *might* be able to replace these w/ a simpler form
-tidy1 _ (NPat lit mb_neg eq)
+tidy1 _ (NPat (L _ lit) mb_neg eq)
   = return (idDsWrapper, tidyNPat tidyLitPat lit mb_neg eq)
 
 -- Everything else goes through unchanged...
@@ -803,7 +803,7 @@ matchWrapper ctxt (MG { mg_alts = matches
                          matchEquations ctxt new_vars eqns_info rhs_ty
         ; return (new_vars, result_expr) }
   where
-    mk_eqn_info (L _ (Match pats _ grhss))
+    mk_eqn_info (L _ (Match _ pats _ grhss))
       = do { let upats = map unLoc pats
            ; match_result <- dsGRHSs ctxt upats grhss rhs_ty
            ; return (EqnInfo { eqn_pats = upats, eqn_rhs  = match_result}) }
@@ -1062,8 +1062,9 @@ patGroup _      (ConPatOut { pat_con = con }) = case unLoc con of
     RealDataCon dcon -> PgCon dcon
     PatSynCon psyn -> PgSyn psyn
 patGroup dflags (LitPat lit)                  = PgLit (hsLitKey dflags lit)
-patGroup _      (NPat olit mb_neg _)          = PgN   (hsOverLitKey olit (isJust mb_neg))
-patGroup _      (NPlusKPat _ olit _ _)        = PgNpK (hsOverLitKey olit False)
+patGroup _      (NPat (L _ olit) mb_neg _)
+                                     = PgN   (hsOverLitKey olit (isJust mb_neg))
+patGroup _      (NPlusKPat _ (L _ olit) _ _)  = PgNpK (hsOverLitKey olit False)
 patGroup _      (CoPat _ p _)                 = PgCo  (hsPatType p) -- Type of innelexp pattern
 patGroup _      (ViewPat expr p _)            = PgView expr (hsPatType (unLoc p))
 patGroup _      (ListPat _ _ (Just _))        = PgOverloadedList
diff --git a/compiler/deSugar/MatchLit.hs b/compiler/deSugar/MatchLit.hs
index 914b21016c..25021f56c5 100644
--- a/compiler/deSugar/MatchLit.hs
+++ b/compiler/deSugar/MatchLit.hs
@@ -324,7 +324,7 @@ tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _
                    _ -> Nothing
 
 tidyNPat _ over_lit mb_neg eq
-  = NPat over_lit mb_neg eq
+  = NPat (noLoc over_lit) mb_neg eq
 
 {-
 ************************************************************************
@@ -417,7 +417,7 @@ litValKey (HsIsString _ s) neg   = ASSERT( not neg) MachStr
 
 matchNPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
 matchNPats (var:vars) ty (eqn1:eqns)    -- All for the same literal
-  = do  { let NPat lit mb_neg eq_chk = firstPat eqn1
+  = do  { let NPat (L _ lit) mb_neg eq_chk = firstPat eqn1
         ; lit_expr <- dsOverLit lit
         ; neg_lit <- case mb_neg of
                             Nothing -> return lit_expr
@@ -450,7 +450,7 @@ We generate:
 matchNPlusKPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
 -- All NPlusKPats, for the *same* literal k
 matchNPlusKPats (var:vars) ty (eqn1:eqns)
-  = do  { let NPlusKPat (L _ n1) lit ge minus = firstPat eqn1
+  = do  { let NPlusKPat (L _ n1) (L _ lit) ge minus = firstPat eqn1
         ; ge_expr     <- dsExpr ge
         ; minus_expr  <- dsExpr minus
         ; lit_expr    <- dsOverLit lit