Remove HasSrcSpan (#17494)
authorVladislav Zavialov <vlad.z.4096@gmail.com>
Wed, 20 Nov 2019 12:44:49 +0000 (15:44 +0300)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Sat, 30 Nov 2019 07:58:34 +0000 (02:58 -0500)
Metric Decrease:
    haddock.compiler

52 files changed:
compiler/GHC/Hs/Expr.hs
compiler/GHC/Hs/Pat.hs
compiler/GHC/Hs/Types.hs
compiler/GHC/Hs/Utils.hs
compiler/GHC/HsToCore/PmCheck.hs
compiler/GHC/ThToHs.hs
compiler/basicTypes/Name.hs
compiler/basicTypes/SrcLoc.hs
compiler/deSugar/Coverage.hs
compiler/deSugar/Desugar.hs
compiler/deSugar/DsArrows.hs
compiler/deSugar/DsBinds.hs
compiler/deSugar/DsExpr.hs
compiler/deSugar/DsForeign.hs
compiler/deSugar/DsGRHSs.hs
compiler/deSugar/DsListComp.hs
compiler/deSugar/DsMeta.hs
compiler/deSugar/DsUtils.hs
compiler/deSugar/ExtractDocs.hs
compiler/deSugar/Match.hs
compiler/deSugar/MatchCon.hs
compiler/deSugar/MatchLit.hs
compiler/hieFile/HieAst.hs
compiler/main/GHC.hs
compiler/main/HeaderInfo.hs
compiler/main/HscStats.hs
compiler/main/HscTypes.hs
compiler/parser/Parser.y
compiler/parser/RdrHsSyn.hs
compiler/rename/RnExpr.hs
compiler/rename/RnHsDoc.hs
compiler/rename/RnPat.hs
compiler/rename/RnSource.hs
compiler/rename/RnSplice.hs
compiler/rename/RnTypes.hs
compiler/rename/RnUtils.hs
compiler/typecheck/TcBinds.hs
compiler/typecheck/TcErrors.hs
compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcHsType.hs
compiler/typecheck/TcPat.hs
compiler/typecheck/TcPatSyn.hs
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcRnExports.hs
compiler/typecheck/TcRnMonad.hs
compiler/typecheck/TcTyClsDecls.hs
compiler/typecheck/TcTyDecls.hs
ghc/GHCi/UI/Info.hs
testsuite/tests/ghc-api/T6145.hs
testsuite/tests/pmcheck/should_compile/pmc009.hs
testsuite/tests/pmcheck/should_compile/pmc009.stderr
utils/haddock

index 8a8eb77..9955efa 100644 (file)
@@ -920,7 +920,7 @@ ppr_expr (SectionR _ op expr)
 ppr_expr (ExplicitTuple _ exprs boxity)
     -- Special-case unary boxed tuples so that they are pretty-printed as
     -- `Unit x`, not `(x)`
-  | [dL -> L _ (Present _ expr)] <- exprs
+  | [L _ (Present _ expr)] <- exprs
   , Boxed <- boxity
   = hsep [text (mkTupleStr Boxed 1), ppr expr]
   | otherwise
index cae7144..d8ae451 100644 (file)
@@ -710,7 +710,7 @@ isIrrefutableHsPat
 
     go (ConPatIn {})       = False     -- Conservative
     go (ConPatOut
-        { pat_con  = (dL->L _ (RealDataCon con))
+        { pat_con  = L _ (RealDataCon con)
         , pat_args = details })
                            =
       isJust (tyConSingleDataCon_maybe (dataConTyCon con))
@@ -718,9 +718,8 @@ isIrrefutableHsPat
       -- the latter is false of existentials. See #4439
       && all goL (hsConPatArgs details)
     go (ConPatOut
-        { pat_con = (dL->L _ (PatSynCon _pat)) })
+        { pat_con = L _ (PatSynCon _pat) })
                            = False -- Conservative
-    go (ConPatOut{})       = panic "ConPatOut:Impossible Match" -- due to #15884
     go (LitPat {})         = False
     go (NPat {})           = False
     go (NPlusKPat {})      = False
@@ -790,8 +789,8 @@ conPatNeedsParens p = go
 -- | @'parenthesizePat' p pat@ checks if @'patNeedsParens' p pat@ is true, and
 -- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat@.
 parenthesizePat :: PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
-parenthesizePat p lpat@(dL->L loc pat)
-  | patNeedsParens p pat = cL loc (ParPat noExtField lpat)
+parenthesizePat p lpat@(L loc pat)
+  | patNeedsParens p pat = L loc (ParPat noExtField lpat)
   | otherwise            = lpat
 
 {-
index 7af0a1e..e92928c 100644 (file)
@@ -1063,14 +1063,14 @@ hsAllLTyVarNames (HsQTvs { hsq_ext = kvs
 hsAllLTyVarNames (XLHsQTyVars nec) = noExtCon nec
 
 hsLTyVarLocName :: LHsTyVarBndr (GhcPass p) -> Located (IdP (GhcPass p))
-hsLTyVarLocName = onHasSrcSpan hsTyVarName
+hsLTyVarLocName = mapLoc hsTyVarName
 
 hsLTyVarLocNames :: LHsQTyVars (GhcPass p) -> [Located (IdP (GhcPass p))]
 hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvExplicit qtvs)
 
 -- | Convert a LHsTyVarBndr to an equivalent LHsType.
 hsLTyVarBndrToType :: LHsTyVarBndr (GhcPass p) -> LHsType (GhcPass p)
-hsLTyVarBndrToType = onHasSrcSpan cvt
+hsLTyVarBndrToType = mapLoc cvt
   where cvt (UserTyVar _ n) = HsTyVar noExtField NotPromoted n
         cvt (KindedTyVar _ (L name_loc n) kind)
           = HsKindSig noExtField
index bac4dff..b0d66c6 100644 (file)
@@ -147,13 +147,13 @@ just attach 'noSrcSpan' to everything.
 
 -- | e => (e)
 mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-mkHsPar e = cL (getLoc e) (HsPar noExtField e)
+mkHsPar e = L (getLoc e) (HsPar noExtField e)
 
 mkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
               -> [LPat (GhcPass p)] -> Located (body (GhcPass p))
               -> LMatch (GhcPass p) (Located (body (GhcPass p)))
 mkSimpleMatch ctxt pats rhs
-  = cL loc $
+  = L loc $
     Match { m_ext = noExtField, m_ctxt = ctxt, m_pats = pats
           , m_grhss = unguardedGRHSs rhs }
   where
@@ -163,12 +163,12 @@ mkSimpleMatch ctxt pats rhs
 
 unguardedGRHSs :: Located (body (GhcPass p))
                -> GRHSs (GhcPass p) (Located (body (GhcPass p)))
-unguardedGRHSs rhs@(dL->L loc _)
+unguardedGRHSs rhs@(L loc _)
   = GRHSs noExtField (unguardedRHS loc rhs) (noLoc emptyLocalBinds)
 
 unguardedRHS :: SrcSpan -> Located (body (GhcPass p))
              -> [LGRHS (GhcPass p) (Located (body (GhcPass p)))]
-unguardedRHS loc rhs = [cL loc (GRHS noExtField [] rhs)]
+unguardedRHS loc rhs = [L loc (GRHS noExtField [] rhs)]
 
 mkMatchGroup :: (XMG name (Located (body name)) ~ NoExtField)
              => Origin -> [LMatch name (Located (body name))]
@@ -179,7 +179,7 @@ mkMatchGroup origin matches = MG { mg_ext = noExtField
 
 mkLocatedList ::  [Located a] -> Located [Located a]
 mkLocatedList [] = noLoc []
-mkLocatedList ms = cL (combineLocs (head ms) (last ms)) ms
+mkLocatedList ms = L (combineLocs (head ms) (last ms)) ms
 
 mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
 mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExtField e1 e2)
@@ -196,7 +196,7 @@ mkHsAppTypes = foldl' mkHsAppType
 
 mkHsLam :: (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) =>
   [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
-mkHsLam pats body = mkHsPar (cL (getLoc body) (HsLam noExtField matches))
+mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam noExtField matches))
   where
     matches = mkMatchGroup Generated
                            [mkSimpleMatch LambdaExpr pats' body]
@@ -225,13 +225,13 @@ nlHsTyApps fun_id tys xs = foldl' nlHsApp (nlHsTyApp fun_id tys) xs
 -- | Wrap in parens if (hsExprNeedsParens appPrec) says it needs them
 -- So   'f x'  becomes '(f x)', but '3' stays as '3'
 mkLHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-mkLHsPar le@(dL->L loc e)
-  | hsExprNeedsParens appPrec e = cL loc (HsPar noExtField le)
+mkLHsPar le@(L loc e)
+  | hsExprNeedsParens appPrec e = L loc (HsPar noExtField le)
   | otherwise                   = le
 
 mkParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
-mkParPat lp@(dL->L loc p)
-  | patNeedsParens appPrec p = cL loc (ParPat noExtField lp)
+mkParPat lp@(L loc p)
+  | patNeedsParens appPrec p = L loc (ParPat noExtField lp)
   | otherwise                = lp
 
 nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
@@ -277,7 +277,7 @@ mkHsIsString src s  = OverLit noExtField (HsIsString   src s) noExpr
 mkHsDo ctxt stmts = HsDo noExtField ctxt (mkLocatedList stmts)
 mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])
   where
-    last_stmt = cL (getLoc expr) $ mkLastStmt expr
+    last_stmt = L (getLoc expr) $ mkLastStmt expr
 
 mkHsIf :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
        -> HsExpr (GhcPass p)
@@ -531,7 +531,7 @@ missingTupArg = Missing noExtField
 mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn
 mkLHsPatTup []     = noLoc $ TuplePat noExtField [] Boxed
 mkLHsPatTup [lpat] = lpat
-mkLHsPatTup lpats  = cL (getLoc (head lpats)) $ TuplePat noExtField lpats Boxed
+mkLHsPatTup lpats  = L (getLoc (head lpats)) $ TuplePat noExtField lpats Boxed
 
 -- | The Big equivalents for the source tuple expressions
 mkBigLHsVarTup :: [IdP (GhcPass id)] -> LHsExpr (GhcPass id)
@@ -620,12 +620,12 @@ mkHsSigEnv get_info sigs
    -- of which use this function
   where
     (gen_dm_sigs, ordinary_sigs) = partition is_gen_dm_sig sigs
-    is_gen_dm_sig (dL->L _ (ClassOpSig _ True _ _)) = True
-    is_gen_dm_sig _                                 = False
+    is_gen_dm_sig (L _ (ClassOpSig _ True _ _)) = True
+    is_gen_dm_sig _                             = False
 
     mk_pairs :: [LSig GhcRn] -> [(Name, a)]
     mk_pairs sigs = [ (n,a) | Just (ns,a) <- map get_info sigs
-                            , (dL->L _ n) <- ns ]
+                            , L _ n <- ns ]
 
 mkClassOpSigs :: [LSig GhcPs] -> [LSig GhcPs]
 -- ^ Convert TypeSig to ClassOpSig
@@ -634,8 +634,8 @@ mkClassOpSigs :: [LSig GhcPs] -> [LSig GhcPs]
 mkClassOpSigs sigs
   = map fiddle sigs
   where
-    fiddle (dL->L loc (TypeSig _ nms ty))
-      = cL loc (ClassOpSig noExtField False nms (dropWildCards ty))
+    fiddle (L loc (TypeSig _ nms ty))
+      = L loc (ClassOpSig noExtField False nms (dropWildCards ty))
     fiddle sig = sig
 
 typeToLHsType :: Type -> LHsType GhcPs
@@ -753,7 +753,7 @@ positions in the kind of the tycon.
 ********************************************************************* -}
 
 mkLHsWrap :: HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-mkLHsWrap co_fn (dL->L loc e) = cL loc (mkHsWrap co_fn e)
+mkLHsWrap co_fn (L loc e) = L loc (mkHsWrap co_fn e)
 
 -- | Avoid (HsWrap co (HsWrap co' _)).
 -- See Note [Detecting forced eta expansion] in DsExpr
@@ -771,14 +771,14 @@ mkHsWrapCoR :: TcCoercionR   -- A Representational coercion  a ~R b
 mkHsWrapCoR co e = mkHsWrap (mkWpCastR co) e
 
 mkLHsWrapCo :: TcCoercionN -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-mkLHsWrapCo co (dL->L loc e) = cL loc (mkHsWrapCo co e)
+mkLHsWrapCo co (L loc e) = L loc (mkHsWrapCo co e)
 
 mkHsCmdWrap :: HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p)
 mkHsCmdWrap w cmd | isIdHsWrapper w = cmd
                   | otherwise       = HsCmdWrap noExtField w cmd
 
 mkLHsCmdWrap :: HsWrapper -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)
-mkLHsCmdWrap w (dL->L loc c) = cL loc (mkHsCmdWrap w c)
+mkLHsCmdWrap w (L loc c) = L loc (mkHsCmdWrap w c)
 
 mkHsWrapPat :: HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
 mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p
@@ -824,7 +824,7 @@ mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr GhcPs -> LHsBind GhcPs
 mkHsVarBind loc var rhs = mkSimpleGeneratedFunBind loc var [] rhs
 
 mkVarBind :: IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p)
-mkVarBind var rhs = cL (getLoc rhs) $
+mkVarBind var rhs = L (getLoc rhs) $
                     VarBind { var_ext = noExtField,
                               var_id = var, var_rhs = rhs, var_inline = False }
 
@@ -852,8 +852,8 @@ isInfixFunBind _ = False
 mkSimpleGeneratedFunBind :: SrcSpan -> RdrName -> [LPat GhcPs]
                 -> LHsExpr GhcPs -> LHsBind GhcPs
 mkSimpleGeneratedFunBind loc fun pats expr
-  = cL loc $ mkFunBind Generated (cL loc fun)
-              [mkMatch (mkPrefixFunRhs (cL loc fun)) pats expr
+  = L loc $ mkFunBind Generated (L loc fun)
+              [mkMatch (mkPrefixFunRhs (L loc fun)) pats expr
                        (noLoc emptyLocalBinds)]
 
 -- | Make a prefix, non-strict function 'HsMatchContext'
@@ -873,8 +873,8 @@ mkMatch ctxt pats expr lbinds
                  , m_pats  = map paren pats
                  , m_grhss = GRHSs noExtField (unguardedRHS noSrcSpan expr) lbinds })
   where
-    paren lp@(dL->L l p)
-      | patNeedsParens appPrec p = cL l (ParPat noExtField lp)
+    paren lp@(L l p)
+      | patNeedsParens appPrec p = L l (ParPat noExtField lp)
       | otherwise                = lp
 
 {-
@@ -954,7 +954,7 @@ isBangedHsBind :: HsBind GhcTc -> Bool
 isBangedHsBind (AbsBinds { abs_binds = binds })
   = anyBag (isBangedHsBind . unLoc) binds
 isBangedHsBind (FunBind {fun_matches = matches})
-  | [dL->L _ match] <- unLoc $ mg_alts matches
+  | [L _ match] <- unLoc $ mg_alts matches
   , FunRhs{mc_strictness = SrcStrict} <- m_ctxt match
   = True
 isBangedHsBind (PatBind {pat_lhs = pat})
@@ -976,8 +976,8 @@ collectHsIdBinders, collectHsValBinders
 collectHsIdBinders  = collect_hs_val_binders True
 collectHsValBinders = collect_hs_val_binders False
 
-collectHsBindBinders :: (SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p))=>
-                        HsBindLR p idR -> [IdP p]
+collectHsBindBinders :: XRec pass Pat ~ Located (Pat pass) =>
+                        HsBindLR pass idR -> [IdP pass]
 -- ^ Collect both Ids and pattern-synonym binders
 collectHsBindBinders b = collect_bind False b []
 
@@ -1003,16 +1003,17 @@ collect_binds :: Bool -> LHsBindsLR (GhcPass p) idR ->
 -- ^ Collect Ids, or Ids + pattern synonyms, depending on boolean flag
 collect_binds ps binds acc = foldr (collect_bind ps . unLoc) acc binds
 
-collect_bind :: (SrcSpanLess (LPat p) ~ Pat p , HasSrcSpan (LPat p)) =>
-                Bool -> HsBindLR p idR -> [IdP p] -> [IdP p]
+collect_bind :: XRec pass Pat ~ Located (Pat pass) =>
+                Bool -> HsBindLR pass idR ->
+                [IdP pass] -> [IdP pass]
 collect_bind _ (PatBind { pat_lhs = p })           acc = collect_lpat p acc
-collect_bind _ (FunBind { fun_id = (dL->L _ f) })  acc = f : acc
+collect_bind _ (FunBind { fun_id = L _ f })        acc = f : acc
 collect_bind _ (VarBind { var_id = f })            acc = f : acc
 collect_bind _ (AbsBinds { abs_exports = dbinds }) acc = map abe_poly dbinds ++ acc
         -- I don't think we want the binders from the abe_binds
 
         -- binding (hence see AbsBinds) is in zonking in TcHsSyn
-collect_bind omitPatSyn (PatSynBind _ (PSB { psb_id = (dL->L _ ps) })) acc
+collect_bind omitPatSyn (PatSynBind _ (PSB { psb_id = L _ ps })) acc
   | omitPatSyn                  = acc
   | otherwise                   = ps : acc
 collect_bind _ (PatSynBind _ (XPatSynBind _)) acc = acc
@@ -1066,8 +1067,8 @@ collectPatsBinders :: [LPat (GhcPass p)] -> [IdP (GhcPass p)]
 collectPatsBinders pats = foldr collect_lpat [] pats
 
 -------------
-collect_lpat :: (SrcSpanLess (LPat p) ~ Pat p , HasSrcSpan (LPat p)) =>
-                 LPat p -> [IdP p] -> [IdP p]
+collect_lpat :: XRec pass Pat ~ Located (Pat pass) =>
+                LPat pass -> [IdP pass] -> [IdP pass]
 collect_lpat p bndrs
   = go (unLoc p)
   where
@@ -1160,39 +1161,37 @@ hsLTyClDeclBinders :: Located (TyClDecl (GhcPass p))
 -- Each returned (Located name) has a SrcSpan for the /whole/ declaration.
 -- See Note [SrcSpan for binders]
 
-hsLTyClDeclBinders (dL->L loc (FamDecl { tcdFam = FamilyDecl
-                                            { fdLName = (dL->L _ name) } }))
-  = ([cL loc name], [])
-hsLTyClDeclBinders (dL->L _ (FamDecl { tcdFam = XFamilyDecl nec }))
+hsLTyClDeclBinders (L loc (FamDecl { tcdFam = FamilyDecl
+                                            { fdLName = (L _ name) } }))
+  = ([L loc name], [])
+hsLTyClDeclBinders (L _ (FamDecl { tcdFam = XFamilyDecl nec }))
   = noExtCon nec
-hsLTyClDeclBinders (dL->L loc (SynDecl
-                               { tcdLName = (dL->L _ name) }))
-  = ([cL loc name], [])
-hsLTyClDeclBinders (dL->L loc (ClassDecl
-                               { tcdLName = (dL->L _ cls_name)
+hsLTyClDeclBinders (L loc (SynDecl
+                               { tcdLName = (L _ name) }))
+  = ([L loc name], [])
+hsLTyClDeclBinders (L loc (ClassDecl
+                               { tcdLName = (L _ cls_name)
                                , tcdSigs  = sigs
                                , tcdATs   = ats }))
-  = (cL loc cls_name :
-     [ cL fam_loc fam_name | (dL->L fam_loc (FamilyDecl
+  = (L loc cls_name :
+     [ L fam_loc fam_name | (L fam_loc (FamilyDecl
                                         { fdLName = L _ fam_name })) <- ats ]
      ++
-     [ cL mem_loc mem_name | (dL->L mem_loc (ClassOpSig _ False ns _)) <- sigs
-                           , (dL->L _ mem_name) <- ns ]
+     [ L mem_loc mem_name | (L mem_loc (ClassOpSig _ False ns _)) <- sigs
+                          , (L _ mem_name) <- ns ]
     , [])
-hsLTyClDeclBinders (dL->L loc (DataDecl    { tcdLName = (dL->L _ name)
-                                           , tcdDataDefn = defn }))
-  = (\ (xs, ys) -> (cL loc name : xs, ys)) $ hsDataDefnBinders defn
-hsLTyClDeclBinders (dL->L _ (XTyClDecl nec)) = noExtCon nec
-hsLTyClDeclBinders _ = panic "hsLTyClDeclBinders: Impossible Match"
-                             -- due to #15884
+hsLTyClDeclBinders (L loc (DataDecl    { tcdLName = (L _ name)
+                                       , tcdDataDefn = defn }))
+  = (\ (xs, ys) -> (L loc name : xs, ys)) $ hsDataDefnBinders defn
+hsLTyClDeclBinders (L _ (XTyClDecl nec)) = noExtCon nec
 
 
 -------------------
 hsForeignDeclsBinders :: [LForeignDecl pass] -> [Located (IdP pass)]
 -- ^ See Note [SrcSpan for binders]
 hsForeignDeclsBinders foreign_decls
-  = [ cL decl_loc n
-    | (dL->L decl_loc (ForeignImport { fd_name = (dL->L _ n) }))
+  = [ L decl_loc n
+    | L decl_loc (ForeignImport { fd_name = L _ n })
         <- foreign_decls]
 
 
@@ -1213,24 +1212,22 @@ addPatSynSelector bind sels
 getPatSynBinds :: [(RecFlag, LHsBinds id)] -> [PatSynBind id id]
 getPatSynBinds binds
   = [ psb | (_, lbinds) <- binds
-          , (dL->L _ (PatSynBind _ psb)) <- bagToList lbinds ]
+          , L _ (PatSynBind _ psb) <- bagToList lbinds ]
 
 -------------------
 hsLInstDeclBinders :: LInstDecl (GhcPass p)
                    -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
-hsLInstDeclBinders (dL->L _ (ClsInstD
+hsLInstDeclBinders (L _ (ClsInstD
                              { cid_inst = ClsInstDecl
                                           { cid_datafam_insts = dfis }}))
   = foldMap (hsDataFamInstBinders . unLoc) dfis
-hsLInstDeclBinders (dL->L _ (DataFamInstD { dfid_inst = fi }))
+hsLInstDeclBinders (L _ (DataFamInstD { dfid_inst = fi }))
   = hsDataFamInstBinders fi
-hsLInstDeclBinders (dL->L _ (TyFamInstD {})) = mempty
-hsLInstDeclBinders (dL->L _ (ClsInstD _ (XClsInstDecl nec)))
+hsLInstDeclBinders (L _ (TyFamInstD {})) = mempty
+hsLInstDeclBinders (L _ (ClsInstD _ (XClsInstDecl nec)))
   = noExtCon nec
-hsLInstDeclBinders (dL->L _ (XInstDecl nec))
+hsLInstDeclBinders (L _ (XInstDecl nec))
   = noExtCon nec
-hsLInstDeclBinders _ = panic "hsLInstDeclBinders: Impossible Match"
-                             -- due to #15884
 
 -------------------
 -- | the SrcLoc returned are for the whole declarations, not just the names
@@ -1278,13 +1275,13 @@ hsConDeclsBinders cons
            -- remove only the first occurrence of any seen field in order to
            -- avoid circumventing detection of duplicate fields (#9156)
            ConDeclGADT { con_names = names, con_args = args }
-             -> (map (cL loc . unLoc) names ++ ns, flds ++ fs)
+             -> (map (L loc . unLoc) names ++ ns, flds ++ fs)
              where
                 (remSeen', flds) = get_flds remSeen args
                 (ns, fs) = go remSeen' rs
 
            ConDeclH98 { con_name = name, con_args = args }
-             -> ([cL loc (unLoc name)] ++ ns, flds ++ fs)
+             -> ([L loc (unLoc name)] ++ ns, flds ++ fs)
              where
                 (remSeen', flds) = get_flds remSeen args
                 (ns, fs) = go remSeen' rs
index 1467ef0..86a9717 100644 (file)
@@ -282,7 +282,7 @@ checkSingle' locn var p = do
     (Covered   , _          ) -> plain                              -- useful
     (NotCovered, NotDiverged) -> plain { pmresultRedundant = m    } -- redundant
     (NotCovered, Diverged   ) -> plain { pmresultInaccessible = m } -- inaccessible rhs
-  where m = [cL locn [cL locn p]]
+  where m = [L locn [L locn p]]
 
 -- | Exhaustive for guard matches, is used for guards in pattern bindings and
 -- in @MultiIf@ expressions.
@@ -293,7 +293,7 @@ checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do
     dflags <- getDynFlags
     let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss)
         dsMatchContext = DsMatchContext hs_ctx combinedLoc
-        match = cL combinedLoc $
+        match = L combinedLoc $
                   Match { m_ext = noExtField
                         , m_ctxt = hs_ctx
                         , m_pats = []
@@ -360,8 +360,8 @@ checkMatches' vars matches = do
         (NotCovered, Diverged )   -> (rs, final_u, m:is, pc1 Semi.<> pc2)
 
     hsLMatchToLPats :: LMatch id body -> Located [LPat id]
-    hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats
-    hsLMatchToLPats _                                   = panic "checkMatches'"
+    hsLMatchToLPats (L l (Match { m_pats = pats })) = L l pats
+    hsLMatchToLPats _                               = panic "checkMatches'"
 
 getNFirstUncovered :: [Id] -> Int -> [Delta] -> DsM [Delta]
 getNFirstUncovered _    0 _              = pure []
@@ -465,7 +465,7 @@ translatePat fam_insts x pat = case pat of
 
   -- (x@pat)   ==>   Translate pat with x as match var and handle impedance
   --                 mismatch with incoming match var
-  AsPat _ (dL->L _ y) p -> (mkPmLetVar y x ++) <$> translateLPat fam_insts y p
+  AsPat _ (L _ y) p -> (mkPmLetVar y x ++) <$> translateLPat fam_insts y p
 
   SigPat _ p _ty -> translateLPat fam_insts x p
 
@@ -481,7 +481,7 @@ translatePat fam_insts x pat = case pat of
         pure (PmLet y (wrap_rhs_y (Var x)) : grds)
 
   -- (n + k)  ===>   let b = x >= k, True <- b, let n = x-k
-  NPlusKPat _pat_ty (dL->L _ n) k1 k2 ge minus -> do
+  NPlusKPat _pat_ty (L _ n) k1 k2 ge minus -> do
     b <- mkPmId boolTy
     let grd_b = vanillaConGrd b trueDataCon []
     [ke1, ke2] <- traverse dsOverLit [unLoc k1, k2]
@@ -527,14 +527,14 @@ translatePat fam_insts x pat = case pat of
     --
     -- See #14547, especially comment#9 and comment#10.
 
-  ConPatOut { pat_con     = (dL->L _ con)
+  ConPatOut { pat_con     = L _ con
             , pat_arg_tys = arg_tys
             , pat_tvs     = ex_tvs
             , pat_dicts   = dicts
             , pat_args    = ps } -> do
     translateConPatOut fam_insts x con arg_tys ex_tvs dicts ps
 
-  NPat ty (dL->L _ olit) mb_neg _ -> do
+  NPat ty (L _ olit) mb_neg _ -> do
     -- See Note [Literal short cut] in MatchLit.hs
     -- We inline the Literal short cut for @ty@ here, because @ty@ is more
     -- precise than the field of OverLitTc, which is all that dsOverLit (which
@@ -657,7 +657,7 @@ translateConPatOut fam_insts x con univ_tys ex_tvs dicts = \case
 -- Translate a single match
 translateMatch :: FamInstEnvs -> [Id] -> LMatch GhcTc (LHsExpr GhcTc)
                -> DsM (GrdVec, [GrdVec])
-translateMatch fam_insts vars (dL->L _ (Match { m_pats = pats, m_grhss = grhss }))
+translateMatch fam_insts vars (L _ (Match { m_pats = pats, m_grhss = grhss }))
   = do
       pats'   <- concat <$> zipWithM (translateLPat fam_insts) vars pats
       guards' <- mapM (translateGuards fam_insts) guards
@@ -665,8 +665,8 @@ translateMatch fam_insts vars (dL->L _ (Match { m_pats = pats, m_grhss = grhss }
       return (pats', guards')
       where
         extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc]
-        extractGuards (dL->L _ (GRHS _ gs _)) = map unLoc gs
-        extractGuards _                       = panic "translateMatch"
+        extractGuards (L _ (GRHS _ gs _)) = map unLoc gs
+        extractGuards _                   = panic "translateMatch"
 
         guards = map extractGuards (grhssGRHSs grhss)
 translateMatch _ _ _ = panic "translateMatch"
@@ -1247,10 +1247,10 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) vars pm_result
       when (approx && (exists_u || exists_i)) $
         putSrcSpanDs loc (warnDs NoReason approx_msg)
 
-      when exists_r $ forM_ redundant $ \(dL->L l q) -> do
+      when exists_r $ forM_ redundant $ \(L l q) -> do
         putSrcSpanDs l (warnDs (Reason Opt_WarnOverlappingPatterns)
                                (pprEqn q "is redundant"))
-      when exists_i $ forM_ inaccessible $ \(dL->L l q) -> do
+      when exists_i $ forM_ inaccessible $ \(L l q) -> do
         putSrcSpanDs l (warnDs (Reason Opt_WarnOverlappingPatterns)
                                (pprEqn q "has inaccessible right hand side"))
       when exists_u $ putSrcSpanDs loc $ warnDs flag_u_reason $
@@ -1366,7 +1366,7 @@ pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun
 
     (ppr_match, pref)
         = case kind of
-             FunRhs { mc_fun = (dL->L _ fun) }
+             FunRhs { mc_fun = L _ fun }
                   -> (pprMatchContext kind, \ pp -> ppr fun <+> pp)
              _    -> (pprMatchContext kind, \ pp -> pp)
 
index eb38d36..2a81334 100644 (file)
@@ -118,15 +118,14 @@ getL = CvtM (\_ loc -> Right (loc,loc))
 setL :: SrcSpan -> CvtM ()
 setL loc = CvtM (\_ _ -> Right (loc, ()))
 
-returnL :: HasSrcSpan a => SrcSpanLess a -> CvtM a
-returnL x = CvtM (\_ loc -> Right (loc, cL loc x))
+returnL :: a -> CvtM (Located a)
+returnL x = CvtM (\_ loc -> Right (loc, L loc x))
 
-returnJustL :: HasSrcSpan a => SrcSpanLess a -> CvtM (Maybe a)
+returnJustL :: a -> CvtM (Maybe (Located a))
 returnJustL = fmap Just . returnL
 
-wrapParL :: HasSrcSpan a =>
-            (a -> SrcSpanLess a) -> SrcSpanLess a -> CvtM (SrcSpanLess  a)
-wrapParL add_par x = CvtM (\_ loc -> Right (loc, add_par (cL loc x)))
+wrapParL :: (Located a -> a) -> a -> CvtM a
+wrapParL add_par x = CvtM (\_ loc -> Right (loc, add_par (L loc x)))
 
 wrapMsg :: (Show a, TH.Ppr a) => String -> a -> CvtM b -> CvtM b
 -- E.g  wrapMsg "declaration" dec thing
@@ -142,10 +141,10 @@ wrapMsg what item (CvtM m)
                     then text (show item)
                     else text (pprint item))
 
-wrapL :: HasSrcSpan a => CvtM (SrcSpanLess a) -> CvtM a
+wrapL :: CvtM a -> CvtM (Located a)
 wrapL (CvtM m) = CvtM $ \origin loc -> case m origin loc of
   Left err -> Left err
-  Right (loc',v) -> Right (loc',cL loc v)
+  Right (loc', v) -> Right (loc', L loc v)
 
 -------------------------------------------------------------------
 cvtDecs :: [TH.Dec] -> CvtM [LHsDecl GhcPs]
@@ -279,14 +278,14 @@ cvtDec (InstanceD o ctxt ty decs)
         ; (binds', sigs', fams', ats', adts') <- cvt_ci_decs doc decs
         ; unless (null fams') (failWith (mkBadDecMsg doc fams'))
         ; ctxt' <- cvtContext funPrec ctxt
-        ; (dL->L loc ty') <- cvtType ty
-        ; let inst_ty' = mkHsQualTy ctxt loc ctxt' $ cL loc ty'
+        ; (L loc ty') <- cvtType ty
+        ; let inst_ty' = mkHsQualTy ctxt loc ctxt' $ L loc ty'
         ; returnJustL $ InstD noExtField $ ClsInstD noExtField $
           ClsInstDecl { cid_ext = noExtField, cid_poly_ty = mkLHsSigType inst_ty'
                       , cid_binds = binds'
                       , cid_sigs = Hs.mkClassOpSigs sigs'
                       , cid_tyfam_insts = ats', cid_datafam_insts = adts'
-                      , cid_overlap_mode = fmap (cL loc . overlap) o } }
+                      , cid_overlap_mode = fmap (L loc . overlap) o } }
   where
   overlap pragma =
     case pragma of
@@ -350,7 +349,7 @@ cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs)
                                   , feqn_fixity = Prefix } }}}
 
 cvtDec (TySynInstD eqn)
-  = do  { (dL->L _ eqn') <- cvtTySynEqn eqn
+  = do  { (L _ eqn') <- cvtTySynEqn eqn
         ; returnJustL $ InstD noExtField $ TyFamInstD
             { tfid_ext = noExtField
             , tfid_inst = TyFamInstDecl { tfid_eqn = eqn' } } }
@@ -376,8 +375,8 @@ cvtDec (TH.RoleAnnotD tc roles)
 cvtDec (TH.StandaloneDerivD ds cxt ty)
   = do { cxt' <- cvtContext funPrec cxt
        ; ds'  <- traverse cvtDerivStrategy ds
-       ; (dL->L loc ty') <- cvtType ty
-       ; let inst_ty' = mkHsQualTy cxt loc cxt' $ cL loc ty'
+       ; (L loc ty') <- cvtType ty
+       ; let inst_ty' = mkHsQualTy cxt loc cxt' $ L loc ty'
        ; returnJustL $ DerivD noExtField $
          DerivDecl { deriv_ext =noExtField
                    , deriv_strategy = ds'
@@ -523,29 +522,29 @@ cvt_tyfam_head (TypeFamilyHead tc tyvars result injectivity)
 -------------------------------------------------------------------
 
 is_fam_decl :: LHsDecl GhcPs -> Either (LFamilyDecl GhcPs) (LHsDecl GhcPs)
-is_fam_decl (dL->L loc (TyClD _ (FamDecl { tcdFam = d }))) = Left (cL loc d)
+is_fam_decl (L loc (TyClD _ (FamDecl { tcdFam = d }))) = Left (L loc d)
 is_fam_decl decl = Right decl
 
 is_tyfam_inst :: LHsDecl GhcPs -> Either (LTyFamInstDecl GhcPs) (LHsDecl GhcPs)
-is_tyfam_inst (dL->L loc (Hs.InstD _ (TyFamInstD { tfid_inst = d })))
-  = Left (cL loc d)
+is_tyfam_inst (L loc (Hs.InstD _ (TyFamInstD { tfid_inst = d })))
+  = Left (L loc d)
 is_tyfam_inst decl
   = Right decl
 
 is_datafam_inst :: LHsDecl GhcPs
                 -> Either (LDataFamInstDecl GhcPs) (LHsDecl GhcPs)
-is_datafam_inst (dL->L loc (Hs.InstD  _ (DataFamInstD { dfid_inst = d })))
-  = Left (cL loc d)
+is_datafam_inst (L loc (Hs.InstD  _ (DataFamInstD { dfid_inst = d })))
+  = Left (L loc d)
 is_datafam_inst decl
   = Right decl
 
 is_sig :: LHsDecl GhcPs -> Either (LSig GhcPs) (LHsDecl GhcPs)
-is_sig (dL->L loc (Hs.SigD _ sig)) = Left (cL loc sig)
-is_sig decl                        = Right decl
+is_sig (L loc (Hs.SigD _ sig)) = Left (L loc sig)
+is_sig decl                    = Right decl
 
 is_bind :: LHsDecl GhcPs -> Either (LHsBind GhcPs) (LHsDecl GhcPs)
-is_bind (dL->L loc (Hs.ValD _ bind)) = Left (cL loc bind)
-is_bind decl                         = Right decl
+is_bind (L loc (Hs.ValD _ bind)) = Left (L loc bind)
+is_bind decl                     = Right decl
 
 is_ip_bind :: TH.Dec -> Either (String, TH.Exp) TH.Dec
 is_ip_bind (TH.ImplicitParamBindD n e) = Left (n, e)
@@ -582,12 +581,12 @@ cvtConstr (InfixC st1 c st2)
 cvtConstr (ForallC tvs ctxt con)
   = do  { tvs'      <- cvtTvs tvs
         ; ctxt'     <- cvtContext funPrec ctxt
-        ; (dL->L _ con')  <- cvtConstr con
+        ; L _ con'  <- cvtConstr con
         ; returnL $ add_forall tvs' ctxt' con' }
   where
     add_cxt lcxt         Nothing           = Just lcxt
-    add_cxt (dL->L loc cxt1) (Just (dL->L _ cxt2))
-      = Just (cL loc (cxt1 ++ cxt2))
+    add_cxt (L loc cxt1) (Just (L _ cxt2))
+      = Just (L loc (cxt1 ++ cxt2))
 
     add_forall tvs' cxt' con@(ConDeclGADT { con_qvars = qvars, con_mb_cxt = cxt })
       = con { con_forall = noLoc $ not (null all_tvs)
@@ -611,7 +610,7 @@ cvtConstr (GadtC [] _strtys _ty)
 cvtConstr (GadtC c strtys ty)
   = do  { c'      <- mapM cNameL c
         ; args    <- mapM cvt_arg strtys
-        ; (dL->L _ ty') <- cvtType ty
+        ; L _ ty' <- cvtType ty
         ; c_ty    <- mk_arr_apps args ty'
         ; returnL $ fst $ mkGadtDecl c' c_ty}
 
@@ -646,12 +645,12 @@ cvt_arg (Bang su ss, ty)
 
 cvt_id_arg :: (TH.Name, TH.Bang, TH.Type) -> CvtM (LConDeclField GhcPs)
 cvt_id_arg (i, str, ty)
-  = do  { (dL->L li i') <- vNameL i
+  = do  { L li i' <- vNameL i
         ; ty' <- cvt_arg (str,ty)
         ; return $ noLoc (ConDeclField
                           { cd_fld_ext = noExtField
                           , cd_fld_names
-                              = [cL li $ FieldOcc noExtField (cL li i')]
+                              = [L li $ FieldOcc noExtField (L li i')]
                           , cd_fld_type =  ty'
                           , cd_fld_doc = Nothing}) }
 
@@ -1132,8 +1131,8 @@ cvtHsDo do_or_lc stmts
         ; let Just (stmts'', last') = snocView stmts'
 
         ; last'' <- case last' of
-                    (dL->L loc (BodyStmt _ body _ _))
-                      -> return (cL loc (mkLastStmt body))
+                    (L loc (BodyStmt _ body _ _))
+                      -> return (L loc (mkLastStmt body))
                     _ -> failWith (bad_last last')
 
         ; return $ HsDo noExtField do_or_lc (noLoc (stmts'' ++ [last''])) }
@@ -1162,8 +1161,8 @@ cvtMatch :: HsMatchContext RdrName
 cvtMatch ctxt (TH.Match p body decs)
   = do  { p' <- cvtPat p
         ; let lp = case p' of
-                     (dL->L loc SigPat{}) -> cL loc (ParPat noExtField p') -- #14875
-                     _                    -> p'
+                     (L loc SigPat{}) -> L loc (ParPat noExtField p') -- #14875
+                     _                -> p'
         ; g' <- cvtGuard body
         ; decs' <- cvtLocalDecs (text "a where clause") decs
         ; returnL $ Hs.Match noExtField ctxt [lp] (GRHSs noExtField g' (noLoc decs')) }
@@ -1298,10 +1297,10 @@ cvtp (ViewP e p)       = do { e' <- cvtl e; p' <- cvtPat p
 
 cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField GhcPs (LPat GhcPs))
 cvtPatFld (s,p)
-  = do  { (dL->L ls s') <- vNameL s
+  = do  { L ls s' <- vNameL s
         ; p' <- cvtPat p
         ; return (noLoc $ HsRecField { hsRecFieldLbl
-                                         = cL ls $ mkFieldOcc (cL ls s')
+                                         = L ls $ mkFieldOcc (L ls s')
                                      , hsRecFieldArg = p'
                                      , hsRecPun      = False}) }
 
@@ -1503,7 +1502,7 @@ cvtTypeKind ty_str ty
            PromotedConsT  -- See Note [Representing concrete syntax in types]
                           -- in Language.Haskell.TH.Syntax
               | Just normals <- m_normals
-              , [ty1, dL->L _ (HsExplicitListTy _ ip tys2)] <- normals
+              , [ty1, L _ (HsExplicitListTy _ ip tys2)] <- normals
               -> do
                   returnL (HsExplicitListTy noExtField ip (ty1:tys2))
               | otherwise
@@ -1576,7 +1575,7 @@ mk_apps head_ty type_args = do
   go type_args
    where
     -- See Note [Adding parens for splices]
-    add_parens lt@(dL->L _ t)
+    add_parens lt@(L _ t)
       | hsTypeNeedsParens appPrec t = returnL (HsParTy noExtField lt)
       | otherwise                   = return lt
 
@@ -1680,9 +1679,9 @@ cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty))
   | null exis, null provs = cvtType (ForallT univs reqs ty)
   | null univs, null reqs = do { l   <- getL
                                ; ty' <- cvtType (ForallT exis provs ty)
-                               ; return $ cL l (HsQualTy { hst_ctxt = cL l []
-                                                         , hst_xqual = noExtField
-                                                         , hst_body = ty' }) }
+                               ; return $ L l (HsQualTy { hst_ctxt = L l []
+                                                        , hst_xqual = noExtField
+                                                        , hst_body = ty' }) }
   | null reqs             = do { l      <- getL
                                ; univs' <- hsQTvExplicit <$> cvtTvs univs
                                ; ty'    <- cvtType (ForallT exis provs ty)
@@ -1690,11 +1689,11 @@ cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty))
                                               { hst_fvf = ForallInvis
                                               , hst_bndrs = univs'
                                               , hst_xforall = noExtField
-                                              , hst_body = cL l cxtTy }
-                                     cxtTy = HsQualTy { hst_ctxt = cL l []
+                                              , hst_body = L l cxtTy }
+                                     cxtTy = HsQualTy { hst_ctxt = L l []
                                                       , hst_xqual = noExtField
                                                       , hst_body = ty' }
-                               ; return $ cL l forTy }
+                               ; return $ L l forTy }
   | otherwise             = cvtType (ForallT univs reqs (ForallT exis provs ty))
 cvtPatSynSigTy ty         = cvtType ty
 
@@ -1753,10 +1752,10 @@ mkHsForAllTy :: [TH.TyVarBndr]
              -- ^ The complete type, quantified with a forall if necessary
 mkHsForAllTy tvs loc fvf tvs' rho_ty
   | null tvs  = rho_ty
-  | otherwise = cL loc $ HsForAllTy { hst_fvf = fvf
-                                    , hst_bndrs = hsQTvExplicit tvs'
-                                    , hst_xforall = noExtField
-                                    , hst_body = rho_ty }
+  | otherwise = L loc $ HsForAllTy { hst_fvf = fvf
+                                   , hst_bndrs = hsQTvExplicit tvs'
+                                   , hst_xforall = noExtField
+                                   , hst_body = rho_ty }
 
 -- | If passed an empty 'TH.Cxt', this simply returns the third argument
 -- (an 'LHsType'). Otherwise, return an 'HsQualTy' using the provided
@@ -1778,9 +1777,9 @@ mkHsQualTy :: TH.Cxt
            -- ^ The complete type, qualified with a context if necessary
 mkHsQualTy ctxt loc ctxt' ty
   | null ctxt = ty
-  | otherwise = cL loc $ HsQualTy { hst_xqual = noExtField
-                                  , hst_ctxt  = ctxt'
-                                  , hst_body  = ty }
+  | otherwise = L loc $ HsQualTy { hst_xqual = noExtField
+                                 , hst_ctxt  = ctxt'
+                                 , hst_body  = ty }
 
 --------------------------------------------------------------------
 --      Turning Name back into RdrName
index 445606d..221c763 100644 (file)
@@ -205,12 +205,6 @@ nameOccName name = n_occ  name
 nameSrcLoc  name = srcSpanStart (n_loc name)
 nameSrcSpan name = n_loc  name
 
-type instance SrcSpanLess Name = Name
-instance HasSrcSpan Name where
-  composeSrcSpan   (L sp  n) = n {n_loc = sp}
-  decomposeSrcSpan n         = L (n_loc n) n
-
-
 {-
 ************************************************************************
 *                                                                      *
index bcf2fcb..57915fd 100644 (file)
@@ -85,9 +85,7 @@ module SrcLoc (
         leftmost_smallest, leftmost_largest, rightmost,
         spans, isSubspanOf, sortLocated,
 
-        -- ** HasSrcSpan
-        HasSrcSpan(..), SrcSpanLess, dL, cL,
-        pattern LL, onHasSrcSpan, liftL
+        liftL
     ) where
 
 import GhcPrelude
@@ -182,7 +180,7 @@ advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)
 ************************************************************************
 -}
 
-sortLocated :: HasSrcSpan a => [a] -> [a]
+sortLocated :: [Located a] -> [Located a]
 sortLocated things = sortBy (comparing getLoc) things
 
 instance Outputable RealSrcLoc where
@@ -533,36 +531,35 @@ type RealLocated = GenLocated RealSrcSpan
 mapLoc :: (a -> b) -> GenLocated l a -> GenLocated l b
 mapLoc = fmap
 
-unLoc :: HasSrcSpan a => a -> SrcSpanLess a
-unLoc (dL->L _ e) = e
+unLoc :: GenLocated l e -> e
+unLoc (L _ e) = e
 
-getLoc :: HasSrcSpan a => a -> SrcSpan
-getLoc (dL->L l _) = l
+getLoc :: GenLocated l e -> l
+getLoc (L l _) = l
 
-noLoc :: HasSrcSpan a => SrcSpanLess a -> a
-noLoc e = cL noSrcSpan e
+noLoc :: e -> Located e
+noLoc e = L noSrcSpan e
 
-mkGeneralLocated :: HasSrcSpan e => String -> SrcSpanLess e -> e
-mkGeneralLocated s e = cL (mkGeneralSrcSpan (fsLit s)) e
+mkGeneralLocated :: String -> e -> Located e
+mkGeneralLocated s e = L (mkGeneralSrcSpan (fsLit s)) e
 
-combineLocs :: (HasSrcSpan a , HasSrcSpan b) => a -> b -> SrcSpan
+combineLocs :: Located a -> Located b -> SrcSpan
 combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)
 
 -- | Combine locations from two 'Located' things and add them to a third thing
-addCLoc :: (HasSrcSpan a , HasSrcSpan b , HasSrcSpan c) =>
-           a -> b -> SrcSpanLess c -> c
-addCLoc a b c = cL (combineSrcSpans (getLoc a) (getLoc b)) c
+addCLoc :: Located a -> Located b -> c -> Located c
+addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c
 
 -- not clear whether to add a general Eq instance, but this is useful sometimes:
 
 -- | Tests whether the two located things are equal
-eqLocated :: (HasSrcSpan a , Eq (SrcSpanLess a)) => a -> a -> Bool
+eqLocated :: Eq a => GenLocated l a -> GenLocated l a -> Bool
 eqLocated a b = unLoc a == unLoc b
 
 -- not clear whether to add a general Ord instance, but this is useful sometimes:
 
 -- | Tests the ordering of the two located things
-cmpLocated :: (HasSrcSpan a , Ord (SrcSpanLess a)) => a -> a -> Ordering
+cmpLocated :: Ord a => GenLocated l a -> GenLocated l a -> Ordering
 cmpLocated a b = unLoc a `compare` unLoc b
 
 instance (Outputable l, Outputable e) => Outputable (GenLocated l e) where
@@ -604,90 +601,10 @@ isSubspanOf src parent
     | otherwise = srcSpanStart parent <= srcSpanStart src &&
                   srcSpanEnd parent   >= srcSpanEnd src
 
-
-{-
-************************************************************************
-*                                                                      *
-\subsection{HasSrcSpan Typeclass to Set/Get Source Location Spans}
-*                                                                      *
-************************************************************************
--}
-
-{-
-Note [HasSrcSpan Typeclass]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-To be able to uniformly set/get source location spans (of `SrcSpan`) in
-syntactic entities (`HsSyn`), we use the typeclass `HasSrcSpan`.
-More details can be found at the following wiki page
-  ImplementingTreesThatGrow/HandlingSourceLocations
-
-For most syntactic entities, the source location spans are stored in
-a syntactic entity by a wapper constuctor (introduced by TTG's
-new constructor extension), e.g., by `NewPat (WrapperPat sp pat)`
-for a source location span `sp` and a pattern `pat`.
--}
-
--- | Determines the type of undecorated syntactic entities
--- For most syntactic entities `E`, where source location spans are
--- introduced by a wrapper construtor of the same syntactic entity,
--- we have `SrcSpanLess E = E`.
--- However, some syntactic entities have a different type compared to
--- a syntactic entity `e :: E` may have the type `Located E` when
--- decorated by wrapping it with `L sp e` for a source span `sp`.
-type family SrcSpanLess a
-
--- | A typeclass to set/get SrcSpans
-class HasSrcSpan a where
-  -- | Composes a `SrcSpan` decoration with an undecorated syntactic
-  --   entity to form its decorated variant
-  composeSrcSpan   :: Located (SrcSpanLess a) -> a
-
-  -- | Decomposes a decorated syntactic entity into its `SrcSpan`
-  --   decoration and its undecorated variant
-  decomposeSrcSpan :: a -> Located (SrcSpanLess a)
-  {- laws:
-       composeSrcSpan . decomposeSrcSpan = id
-       decomposeSrcSpan . composeSrcSpan = id
-
-     in other words, `HasSrcSpan` defines an iso relation between
-     a `SrcSpan`-decorated syntactic entity and its undecorated variant
-     (together with the `SrcSpan`).
-  -}
-
-type instance SrcSpanLess (GenLocated l e) = e
-instance HasSrcSpan (Located a) where
-  composeSrcSpan   = id
-  decomposeSrcSpan = id
-
-
--- | An abbreviated form of decomposeSrcSpan,
---   mainly to be used in ViewPatterns
-dL :: HasSrcSpan a => a -> Located (SrcSpanLess a)
-dL = decomposeSrcSpan
-
--- | An abbreviated form of composeSrcSpan,
---   mainly to replace the hardcoded `L`
-cL :: HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
-cL sp e = composeSrcSpan (L sp e)
-
--- | A Pattern Synonym to Set/Get SrcSpans
-pattern LL :: HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
-pattern LL sp e <- (dL->L sp e)
-  where
-        LL sp e = cL sp e
-
--- | Lifts a function of undecorated entities to one of decorated ones
-onHasSrcSpan :: (HasSrcSpan a , HasSrcSpan b) =>
-                (SrcSpanLess a -> SrcSpanLess b) -> a -> b
-onHasSrcSpan f (dL->L l e) = cL l (f e)
-
-liftL :: (HasSrcSpan a, HasSrcSpan b, Monad m) =>
-         (SrcSpanLess a -> m (SrcSpanLess b)) -> a -> m b
-liftL f (dL->L loc a) = do
+liftL :: Monad m => (a -> m b) -> GenLocated l a -> m (GenLocated l b)
+liftL f (L loc a) = do
   a' <- f a
-  return $ cL loc a'
-
+  return $ L loc a'
 
 getRealSrcSpan :: RealLocated a -> RealSrcSpan
 getRealSrcSpan (L l _) = l
index cfff423..8a82390 100644 (file)
@@ -121,7 +121,7 @@ guessSourceFile :: LHsBinds GhcTc -> FilePath -> FilePath
 guessSourceFile binds orig_file =
      -- Try look for a file generated from a .hsc file to a
      -- .hs file, by peeking ahead.
-     let top_pos = catMaybes $ foldr (\ (dL->L pos _) rest ->
+     let top_pos = catMaybes $ foldr (\ (L pos _) rest ->
                                  srcSpanFileName_maybe pos : rest) [] binds
      in
      case top_pos of
@@ -255,12 +255,12 @@ addTickLHsBinds :: LHsBinds GhcTc -> TM (LHsBinds GhcTc)
 addTickLHsBinds = mapBagM addTickLHsBind
 
 addTickLHsBind :: LHsBind GhcTc -> TM (LHsBind GhcTc)
-addTickLHsBind (dL->L pos bind@(AbsBinds { abs_binds   = binds,
+addTickLHsBind (L pos bind@(AbsBinds { abs_binds   = binds,
                                        abs_exports = abs_exports })) = do
   withEnv add_exports $ do
   withEnv add_inlines $ do
   binds' <- addTickLHsBinds binds
-  return $ cL pos $ bind { abs_binds = binds' }
+  return $ L pos $ bind { abs_binds = binds' }
  where
    -- in AbsBinds, the Id on each binding is not the actual top-level
    -- Id that we are defining, they are related by the abs_exports
@@ -280,7 +280,7 @@ addTickLHsBind (dL->L pos bind@(AbsBinds { abs_binds   = binds,
                       | ABE{ abe_poly = pid, abe_mono = mid } <- abs_exports
                       , isInlinePragma (idInlinePragma pid) ] }
 
-addTickLHsBind (dL->L pos (funBind@(FunBind { fun_id = (dL->L _ id)  }))) = do
+addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id }))) = do
   let name = getOccString id
   decl_path <- getPathEntry
   density <- getDensity
@@ -292,7 +292,7 @@ addTickLHsBind (dL->L pos (funBind@(FunBind { fun_id = (dL->L _ id)  }))) = do
 
   -- See Note [inline sccs]
   tickish <- tickishType `liftM` getEnv
-  if inline && tickish == ProfNotes then return (cL pos funBind) else do
+  if inline && tickish == ProfNotes then return (L pos funBind) else do
 
   (fvs, mg) <-
         getFreeVars $
@@ -321,8 +321,8 @@ addTickLHsBind (dL->L pos (funBind@(FunBind { fun_id = (dL->L _ id)  }))) = do
                 return Nothing
 
   let mbCons = maybe Prelude.id (:)
-  return $ cL pos $ funBind { fun_matches = mg
-                            , fun_tick = tick `mbCons` fun_tick funBind }
+  return $ L pos $ funBind { fun_matches = mg
+                           , fun_tick = tick `mbCons` fun_tick funBind }
 
    where
    -- a binding is a simple pattern binding if it is a funbind with
@@ -331,8 +331,8 @@ addTickLHsBind (dL->L pos (funBind@(FunBind { fun_id = (dL->L _ id)  }))) = do
    isSimplePatBind funBind = matchGroupArity (fun_matches funBind) == 0
 
 -- TODO: Revisit this
-addTickLHsBind (dL->L pos (pat@(PatBind { pat_lhs = lhs
-                                        , pat_rhs = rhs }))) = do
+addTickLHsBind (L pos (pat@(PatBind { pat_lhs = lhs
+                                    , pat_rhs = rhs }))) = do
   let name = "(...)"
   (fvs, rhs') <- getFreeVars $ addPathEntry name $ addTickGRHSs False False rhs
   let pat' = pat { pat_rhs = rhs'}
@@ -342,7 +342,7 @@ addTickLHsBind (dL->L pos (pat@(PatBind { pat_lhs = lhs
   decl_path <- getPathEntry
   let top_lev = null decl_path
   if not (shouldTickPatBind density top_lev)
-    then return (cL pos pat')
+    then return (L pos pat')
     else do
 
     -- Allocate the ticks
@@ -355,14 +355,12 @@ addTickLHsBind (dL->L pos (pat@(PatBind { pat_lhs = lhs
         rhs_ticks = rhs_tick `mbCons` fst (pat_ticks pat')
         patvar_tickss = zipWith mbCons patvar_ticks
                         (snd (pat_ticks pat') ++ repeat [])
-    return $ cL pos $ pat' { pat_ticks = (rhs_ticks, patvar_tickss) }
+    return $ L pos $ pat' { pat_ticks = (rhs_ticks, patvar_tickss) }
 
 -- Only internal stuff, not from source, uses VarBind, so we ignore it.
-addTickLHsBind var_bind@(dL->L _ (VarBind {})) = return var_bind
-addTickLHsBind patsyn_bind@(dL->L _ (PatSynBind {})) = return patsyn_bind
-addTickLHsBind bind@(dL->L _ (XHsBindsLR {})) = return bind
-addTickLHsBind _  = panic "addTickLHsBind: Impossible Match" -- due to #15884
-
+addTickLHsBind var_bind@(L _ (VarBind {})) = return var_bind
+addTickLHsBind patsyn_bind@(L _ (PatSynBind {})) = return patsyn_bind
+addTickLHsBind bind@(L _ (XHsBindsLR {})) = return bind
 
 
 bindTick
@@ -397,7 +395,7 @@ bindTick density name pos fvs = do
 
 -- selectively add ticks to interesting expressions
 addTickLHsExpr :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
-addTickLHsExpr e@(dL->L pos e0) = do
+addTickLHsExpr e@(L pos e0) = do
   d <- getDensity
   case d of
     TickForBreakPoints | isGoodBreakExpr e0 -> tick_it
@@ -413,7 +411,7 @@ addTickLHsExpr e@(dL->L pos e0) = do
 -- (because the body will definitely have a tick somewhere).  ToDo: perhaps
 -- we should treat 'case' and 'if' the same way?
 addTickLHsExprRHS :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
-addTickLHsExprRHS e@(dL->L pos e0) = do
+addTickLHsExprRHS e@(L pos e0) = do
   d <- getDensity
   case d of
      TickForBreakPoints | HsLet{} <- e0 -> dont_tick_it
@@ -442,7 +440,7 @@ addTickLHsExprEvalInner e = do
 -- break012.  This gives the user the opportunity to inspect the
 -- values of the let-bound variables.
 addTickLHsExprLetBody :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
-addTickLHsExprLetBody e@(dL->L pos e0) = do
+addTickLHsExprLetBody e@(L pos e0) = do
   d <- getDensity
   case d of
      TickForBreakPoints | HsLet{} <- e0 -> dont_tick_it
@@ -456,9 +454,9 @@ addTickLHsExprLetBody e@(dL->L pos e0) = do
 -- because the scope of this tick is completely subsumed by
 -- another.
 addTickLHsExprNever :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
-addTickLHsExprNever (dL->L pos e0) = do
+addTickLHsExprNever (L pos e0) = do
     e1 <- addTickHsExpr e0
-    return $ cL pos e1
+    return $ L pos e1
 
 -- general heuristic: expressions which do not denote values are good
 -- break points
@@ -475,16 +473,16 @@ isCallSite OpApp{}     = True
 isCallSite _ = False
 
 addTickLHsExprOptAlt :: Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
-addTickLHsExprOptAlt oneOfMany (dL->L pos e0)
+addTickLHsExprOptAlt oneOfMany (L pos e0)
   = ifDensity TickForCoverage
         (allocTickBox (ExpBox oneOfMany) False False pos $ addTickHsExpr e0)
-        (addTickLHsExpr (cL pos e0))
+        (addTickLHsExpr (L pos e0))
 
 addBinTickLHsExpr :: (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
-addBinTickLHsExpr boxLabel (dL->L pos e0)
+addBinTickLHsExpr boxLabel (L pos e0)
   = ifDensity TickForCoverage
         (allocBinTickBox boxLabel pos $ addTickHsExpr e0)
-        (addTickLHsExpr (cL pos e0))
+        (addTickLHsExpr (L pos e0))
 
 
 -- -----------------------------------------------------------------------------
@@ -493,7 +491,7 @@ addBinTickLHsExpr boxLabel (dL->L pos e0)
 -- in the addTickLHsExpr family of functions.)
 
 addTickHsExpr :: HsExpr GhcTc -> TM (HsExpr GhcTc)
-addTickHsExpr e@(HsVar _ (dL->L _ id)) = do freeVar id; return e
+addTickHsExpr e@(HsVar _ (L _ id)) = do freeVar id; return e
 addTickHsExpr (HsUnboundVar {})    = panic "addTickHsExpr.HsUnboundVar"
 addTickHsExpr e@(HsConLikeOut _ con)
   | Just id <- conLikeWrapId_maybe con = do freeVar id; return e
@@ -552,14 +550,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 x (dL->L l binds) e) =
+addTickHsExpr (HsLet x (L l binds) e) =
         bindLocals (collectLocalBinders binds) $
-          liftM2 (HsLet x . cL l)
+          liftM2 (HsLet x . L l)
                   (addTickHsLocalBinds binds) -- to think about: !patterns.
                   (addTickLHsExprLetBody e)
-addTickHsExpr (HsDo srcloc cxt (dL->L l stmts))
+addTickHsExpr (HsDo srcloc cxt (L l stmts))
   = do { (stmts', _) <- addTickLStmts' forQual stmts (return ())
-       ; return (HsDo srcloc cxt (cL l stmts')) }
+       ; return (HsDo srcloc cxt (L l stmts')) }
   where
         forQual = case cxt of
                     ListComp -> Just $ BinBox QualBinBox
@@ -606,7 +604,7 @@ addTickHsExpr (HsTick x t e) =
 addTickHsExpr (HsBinTick x t0 t1 e) =
         liftM (HsBinTick x t0 t1) (addTickLHsExprNever e)
 
-addTickHsExpr (HsPragE _ HsPragTick{} (dL->L pos e0)) = do
+addTickHsExpr (HsPragE _ HsPragTick{} (L pos e0)) = do
     e2 <- allocTickBox (ExpBox False) False False pos $
                 addTickHsExpr e0
     return $ unLoc e2
@@ -629,19 +627,18 @@ addTickHsExpr (HsWrap x w e) =
 addTickHsExpr e  = pprPanic "addTickHsExpr" (ppr e)
 
 addTickTupArg :: LHsTupArg GhcTc -> TM (LHsTupArg GhcTc)
-addTickTupArg (dL->L l (Present x e))  = do { e' <- addTickLHsExpr e
-                                            ; return (cL l (Present x e')) }
-addTickTupArg (dL->L l (Missing ty)) = return (cL l (Missing ty))
-addTickTupArg (dL->L _ (XTupArg nec)) = noExtCon nec
-addTickTupArg _  = panic "addTickTupArg: Impossible Match" -- due to #15884
+addTickTupArg (L l (Present x e))  = do { e' <- addTickLHsExpr e
+                                        ; return (L l (Present x e')) }
+addTickTupArg (L l (Missing ty)) = return (L l (Missing ty))
+addTickTupArg (L _ (XTupArg nec)) = noExtCon nec
 
 
 addTickMatchGroup :: Bool{-is lambda-} -> MatchGroup GhcTc (LHsExpr GhcTc)
                   -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
-addTickMatchGroup is_lam mg@(MG { mg_alts = dL->L l 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 = cL l matches' }
+  return $ mg { mg_alts = L l matches' }
 addTickMatchGroup _ (XMatchGroup nec) = noExtCon nec
 
 addTickMatch :: Bool -> Bool -> Match GhcTc (LHsExpr GhcTc)
@@ -655,11 +652,11 @@ addTickMatch _ _ (XMatch nec) = noExtCon nec
 
 addTickGRHSs :: Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc)
              -> TM (GRHSs GhcTc (LHsExpr GhcTc))
-addTickGRHSs isOneOfMany isLambda (GRHSs x guarded (dL->L l local_binds)) = do
+addTickGRHSs isOneOfMany isLambda (GRHSs x guarded (L l local_binds)) = do
   bindLocals binders $ do
     local_binds' <- addTickHsLocalBinds local_binds
     guarded' <- mapM (liftL (addTickGRHS isOneOfMany isLambda)) guarded
-    return $ GRHSs x guarded' (cL l local_binds')
+    return $ GRHSs x guarded' (L l local_binds')
   where
     binders = collectLocalBinders local_binds
 addTickGRHSs _ _ (XGRHSs nec) = noExtCon nec
@@ -673,7 +670,7 @@ addTickGRHS isOneOfMany isLambda (GRHS x stmts expr) = do
 addTickGRHS _ _ (XGRHS nec) = noExtCon nec
 
 addTickGRHSBody :: Bool -> Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
-addTickGRHSBody isOneOfMany isLambda expr@(dL->L pos e0) = do
+addTickGRHSBody isOneOfMany isLambda expr@(L pos e0) = do
   d <- getDensity
   case d of
     TickForCoverage  -> addTickLHsExprOptAlt isOneOfMany expr
@@ -716,13 +713,13 @@ addTickStmt isGuard (BodyStmt x e bind' guard') = do
                 (addTick isGuard e)
                 (addTickSyntaxExpr hpcSrcSpan bind')
                 (addTickSyntaxExpr hpcSrcSpan guard')
-addTickStmt _isGuard (LetStmt x (dL->L l binds)) = do
-        liftM (LetStmt x . cL l)
+addTickStmt _isGuard (LetStmt x (L l binds)) = do
+        liftM (LetStmt x . L l)
                 (addTickHsLocalBinds binds)
 addTickStmt isGuard (ParStmt x pairs mzipExpr bindExpr) = do
     liftM3 (ParStmt x)
         (mapM (addTickStmtAndBinders isGuard) pairs)
-        (unLoc <$> addTickLHsExpr (cL hpcSrcSpan mzipExpr))
+        (unLoc <$> addTickLHsExpr (L hpcSrcSpan mzipExpr))
         (addTickSyntaxExpr hpcSrcSpan bindExpr)
 addTickStmt isGuard (ApplicativeStmt body_ty args mb_join) = do
     args' <- mapM (addTickApplicativeArg isGuard) args
@@ -737,7 +734,7 @@ addTickStmt isGuard stmt@(TransStmt { trS_stmts = stmts
     t_u <- addTickLHsExprRHS using
     t_f <- addTickSyntaxExpr hpcSrcSpan returnExpr
     t_b <- addTickSyntaxExpr hpcSrcSpan bindExpr
-    t_m <- fmap unLoc (addTickLHsExpr (cL hpcSrcSpan liftMExpr))
+    t_m <- fmap unLoc (addTickLHsExpr (L hpcSrcSpan liftMExpr))
     return $ stmt { trS_stmts = t_s, trS_by = t_y, trS_using = t_u
                   , trS_ret = t_f, trS_bind = t_b, trS_fmap = t_m }
 
@@ -770,7 +767,7 @@ addTickApplicativeArg isGuard (op, arg) =
   addTickArg (ApplicativeArgMany x stmts ret pat) =
     (ApplicativeArgMany x)
       <$> addTickLStmts isGuard stmts
-      <*> (unLoc <$> addTickLHsExpr (cL hpcSrcSpan ret))
+      <*> (unLoc <$> addTickLHsExpr (L hpcSrcSpan ret))
       <*> addTickLPat pat
   addTickArg (XApplicativeArg nec) = noExtCon nec
 
@@ -823,7 +820,7 @@ addTickIPBind (XIPBind x) = return (XIPBind x)
 -- There is no location here, so we might need to use a context location??
 addTickSyntaxExpr :: SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
 addTickSyntaxExpr pos syn@(SyntaxExpr { syn_expr = x }) = do
-        x' <- fmap unLoc (addTickLHsExpr (cL pos x))
+        x' <- fmap unLoc (addTickLHsExpr (L pos x))
         return $ syn { syn_expr = x' }
 -- we do not walk into patterns.
 addTickLPat :: LPat GhcTc -> TM (LPat GhcTc)
@@ -837,9 +834,9 @@ addTickHsCmdTop (HsCmdTop x cmd) =
 addTickHsCmdTop (XCmdTop nec) = noExtCon nec
 
 addTickLHsCmd ::  LHsCmd GhcTc -> TM (LHsCmd GhcTc)
-addTickLHsCmd (dL->L pos c0) = do
+addTickLHsCmd (L pos c0) = do
         c1 <- addTickHsCmd c0
-        return $ cL pos c1
+        return $ L pos c1
 
 addTickHsCmd :: HsCmd GhcTc -> TM (HsCmd GhcTc)
 addTickHsCmd (HsCmdLam x matchgroup) =
@@ -864,14 +861,14 @@ addTickHsCmd (HsCmdIf x cnd e1 c2 c3) =
                 (addBinTickLHsExpr (BinBox CondBinBox) e1)
                 (addTickLHsCmd c2)
                 (addTickLHsCmd c3)
-addTickHsCmd (HsCmdLet x (dL->L l binds) c) =
+addTickHsCmd (HsCmdLet x (L l binds) c) =
         bindLocals (collectLocalBinders binds) $
-          liftM2 (HsCmdLet x . cL l)
+          liftM2 (HsCmdLet x . L l)
                    (addTickHsLocalBinds binds) -- to think about: !patterns.
                    (addTickLHsCmd c)
-addTickHsCmd (HsCmdDo srcloc (dL->L l stmts))
+addTickHsCmd (HsCmdDo srcloc (L l stmts))
   = do { (stmts', _) <- addTickLCmdStmts' stmts (return ())
-       ; return (HsCmdDo srcloc (cL l stmts')) }
+       ; return (HsCmdDo srcloc (L l stmts')) }
 
 addTickHsCmd (HsCmdArrApp  arr_ty e1 e2 ty1 lr) =
         liftM5 HsCmdArrApp
@@ -897,9 +894,9 @@ addTickHsCmd (XCmd nec) = noExtCon nec
 
 addTickCmdMatchGroup :: MatchGroup GhcTc (LHsCmd GhcTc)
                      -> TM (MatchGroup GhcTc (LHsCmd GhcTc))
-addTickCmdMatchGroup mg@(MG { mg_alts = (dL->L l matches) }) = do
+addTickCmdMatchGroup mg@(MG { mg_alts = (L l matches) }) = do
   matches' <- mapM (liftL addTickCmdMatch) matches
-  return $ mg { mg_alts = cL l matches' }
+  return $ mg { mg_alts = L l matches' }
 addTickCmdMatchGroup (XMatchGroup nec) = noExtCon nec
 
 addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
@@ -910,11 +907,11 @@ addTickCmdMatch match@(Match { m_pats = pats, m_grhss = gRHSs }) =
 addTickCmdMatch (XMatch nec) = noExtCon nec
 
 addTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
-addTickCmdGRHSs (GRHSs x guarded (dL->L l local_binds)) = do
+addTickCmdGRHSs (GRHSs x guarded (L l local_binds)) = do
   bindLocals binders $ do
     local_binds' <- addTickHsLocalBinds local_binds
     guarded' <- mapM (liftL addTickCmdGRHS) guarded
-    return $ GRHSs x guarded' (cL l local_binds')
+    return $ GRHSs x guarded' (L l local_binds')
   where
     binders = collectLocalBinders local_binds
 addTickCmdGRHSs (XGRHSs nec) = noExtCon nec
@@ -961,8 +958,8 @@ addTickCmdStmt (BodyStmt x c bind' guard') = do
                 (addTickLHsCmd c)
                 (addTickSyntaxExpr hpcSrcSpan bind')
                 (addTickSyntaxExpr hpcSrcSpan guard')
-addTickCmdStmt (LetStmt x (dL->L l binds)) = do
-        liftM (LetStmt x . cL l)
+addTickCmdStmt (LetStmt x (L l binds)) = do
+        liftM (LetStmt x . L l)
                 (addTickHsLocalBinds binds)
 addTickCmdStmt stmt@(RecStmt {})
   = do { stmts' <- addTickLCmdStmts (recS_stmts stmt)
@@ -986,9 +983,9 @@ addTickHsRecordBinds (HsRecFields fields dd)
 
 addTickHsRecField :: LHsRecField' id (LHsExpr GhcTc)
                   -> TM (LHsRecField' id (LHsExpr GhcTc))
-addTickHsRecField (dL->L l (HsRecField id expr pun))
+addTickHsRecField (L l (HsRecField id expr pun))
         = do { expr' <- addTickLHsExpr expr
-             ; return (cL l (HsRecField id expr' pun)) }
+             ; return (L l (HsRecField id expr' pun)) }
 
 
 addTickArithSeqInfo :: ArithSeqInfo GhcTc -> TM (ArithSeqInfo GhcTc)
@@ -1168,10 +1165,10 @@ allocTickBox boxLabel countEntries topOnly pos m =
     (fvs, e) <- getFreeVars m
     env <- getEnv
     tickish <- mkTickish boxLabel countEntries topOnly pos fvs (declPath env)
-    return (cL pos (HsTick noExtField tickish (cL pos e)))
+    return (L pos (HsTick noExtField tickish (L pos e)))
   ) (do
     e <- m
-    return (cL pos e)
+    return (L pos e)
   )
 
 -- the tick application inherits the source position of its
@@ -1239,7 +1236,7 @@ allocBinTickBox :: (Bool -> BoxLabel) -> SrcSpan -> TM (HsExpr GhcTc)
 allocBinTickBox boxLabel pos m = do
   env <- getEnv
   case tickishType env of
-    HpcTicks -> do e <- liftM (cL pos) m
+    HpcTicks -> do e <- liftM (L pos) m
                    ifGoodTickSrcSpan pos
                      (mkBinTickBoxHpc boxLabel pos e)
                      (return e)
@@ -1255,8 +1252,8 @@ mkBinTickBoxHpc boxLabel pos e =
       c = tickBoxCount st
       mes = mixEntries st
   in
-     ( cL pos $ HsTick noExtField (HpcTick (this_mod env) c)
-          $ cL pos $ HsBinTick noExtField (c+1) (c+2) e
+     ( L pos $ HsTick noExtField (HpcTick (this_mod env) c)
+          $ L pos $ HsBinTick noExtField (c+1) (c+2) e
    -- notice that F and T are reversed,
    -- because we are building the list in
    -- reverse...
@@ -1283,12 +1280,11 @@ hpcSrcSpan = mkGeneralSrcSpan (fsLit "Haskell Program Coverage internals")
 matchesOneOfMany :: [LMatch GhcTc body] -> Bool
 matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1
   where
-        matchCount (dL->L _ (Match { m_grhss = GRHSs _ grhss _ }))
+        matchCount (L _ (Match { m_grhss = GRHSs _ grhss _ }))
           = length grhss
-        matchCount (dL->L _ (Match { m_grhss = XGRHSs nec }))
+        matchCount (L _ (Match { m_grhss = XGRHSs nec }))
           = noExtCon nec
-        matchCount (dL->L _ (XMatch nec)) = noExtCon nec
-        matchCount _ = panic "matchCount: Impossible Match" -- due to #15884
+        matchCount (L _ (XMatch nec)) = noExtCon nec
 
 type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel)
 
index c2978d8..f5aa6f0 100644 (file)
@@ -369,13 +369,13 @@ Reason
 -}
 
 dsRule :: LRuleDecl GhcTc -> DsM (Maybe CoreRule)
-dsRule (dL->L loc (HsRule { rd_name = name
-                          , rd_act  = rule_act
-                          , rd_tmvs = vars
-                          , rd_lhs  = lhs
-                          , rd_rhs  = rhs }))
+dsRule (L loc (HsRule { rd_name = name
+                      , rd_act  = rule_act
+                      , rd_tmvs = vars
+                      , rd_lhs  = lhs
+                      , rd_rhs  = rhs }))
   = putSrcSpanDs loc $
-    do  { let bndrs' = [var | (dL->L _ (RuleBndr _ (dL->L _ var))) <- vars]
+    do  { let bndrs' = [var | L _ (RuleBndr _ (L _ var)) <- vars]
 
         ; lhs' <- unsetGOptM Opt_EnableRewriteRules $
                   unsetWOptM Opt_WarnIdentities $
@@ -412,8 +412,7 @@ dsRule (dL->L loc (HsRule { rd_name = name
 
         ; return (Just rule)
         } } }
-dsRule (dL->L _ (XRuleDecl nec)) = noExtCon nec
-dsRule _ = panic "dsRule: Impossible Match" -- due to #15884
+dsRule (L _ (XRuleDecl nec)) = noExtCon nec
 
 warnRuleShadowing :: RuleName -> Activation -> Id -> [Id] -> DsM ()
 -- See Note [Rules and inlining/other rules]
index ade0172..0cbf3da 100644 (file)
@@ -316,7 +316,7 @@ dsProcExpr
         :: LPat GhcTc
         -> LHsCmdTop GhcTc
         -> DsM CoreExpr
-dsProcExpr pat (dL->L _ (HsCmdTop (CmdTopTc _unitTy cmd_ty ids) cmd)) = do
+dsProcExpr pat (L _ (HsCmdTop (CmdTopTc _unitTy cmd_ty ids) cmd)) = do
     (meth_binds, meth_ids) <- mkCmdEnv ids
     let locals = mkVarSet (collectPatBinders pat)
     (core_cmd, _free_vars, env_ids)
@@ -455,8 +455,8 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdApp _ cmd arg) env_ids = do
 
 dsCmd ids local_vars stack_ty res_ty
         (HsCmdLam _ (MG { mg_alts
-          = (dL->L _ [dL->L _ (Match { m_pats  = pats
-                       , m_grhss = GRHSs _ [dL->L _ (GRHS _ [] body)] _ })]) }))
+          = (L _ [L _ (Match { m_pats  = pats
+                             , m_grhss = GRHSs _ [L _ (GRHS _ [] body)] _ })]) }))
         env_ids = do
     let pat_vars = mkVarSet (collectPatsBinders pats)
     let
@@ -567,7 +567,7 @@ case bodies, containing the following fields:
 -}
 
 dsCmd ids local_vars stack_ty res_ty
-      (HsCmdCase _ exp (MG { mg_alts = (dL->L l matches)
+      (HsCmdCase _ exp (MG { mg_alts = L l matches
                            , mg_ext = MatchGroupTc arg_tys _
                            , mg_origin = origin }))
       env_ids = do
@@ -616,7 +616,7 @@ dsCmd ids local_vars stack_ty res_ty
         in_ty = envStackType env_ids stack_ty
 
     core_body <- dsExpr (HsCase noExtField exp
-                         (MG { mg_alts = cL l matches'
+                         (MG { mg_alts = L l matches'
                              , mg_ext = MatchGroupTc arg_tys sum_ty
                              , mg_origin = origin }))
         -- Note that we replace the HsCase result type by sum_ty,
@@ -632,7 +632,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 _ lbinds@(dL->L _ binds) body)
+dsCmd ids local_vars stack_ty res_ty (HsCmdLet _ lbinds@(L _ binds) body)
                                                                     env_ids = do
     let
         defined_vars = mkVarSet (collectLocalBinders binds)
@@ -660,7 +660,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdLet _ lbinds@(dL->L _ binds) body)
 --              ---> premap (\ (env,stk) -> env) c
 
 dsCmd ids local_vars stack_ty res_ty do_block@(HsCmdDo stmts_ty
-                                               (dL->L loc stmts))
+                                               (L loc stmts))
                                                                    env_ids = do
     putSrcSpanDs loc $
       dsNoLevPoly stmts_ty
@@ -706,7 +706,7 @@ dsTrimCmdArg
         -> DsM (CoreExpr,       -- desugared expression
                 DIdSet)         -- subset of local vars that occur free
 dsTrimCmdArg local_vars env_ids
-                       (dL->L _ (HsCmdTop
+                       (L _ (HsCmdTop
                                  (CmdTopTc stack_ty cmd_ty ids) cmd )) = do
     (meth_binds, meth_ids) <- mkCmdEnv ids
     (core_cmd, free_vars, env_ids')
@@ -778,7 +778,7 @@ dsCmdDo _ _ _ [] _ = panic "dsCmdDo"
 --
 --              ---> premap (\ (xs) -> ((xs), ())) c
 
-dsCmdDo ids local_vars res_ty [dL->L loc (LastStmt _ body _ _)] env_ids = do
+dsCmdDo ids local_vars res_ty [L loc (LastStmt _ body _ _)] env_ids = do
     putSrcSpanDs loc $ dsNoLevPoly res_ty
                          (text "In the command:" <+> ppr body)
     (core_body, env_ids') <- dsLCmd ids local_vars unitTy res_ty body env_ids
@@ -1139,8 +1139,8 @@ matchSimplys _ _ _ _ _ = panic "matchSimplys"
 
 leavesMatch :: LMatch GhcTc (Located (body GhcTc))
             -> [(Located (body GhcTc), IdSet)]
-leavesMatch (dL->L _ (Match { m_pats = pats
-                            , m_grhss = GRHSs _ grhss (dL->L _ binds) }))
+leavesMatch (L _ (Match { m_pats = pats
+                        , m_grhss = GRHSs _ grhss (L _ binds) }))
   = let
         defined_vars = mkVarSet (collectPatsBinders pats)
                         `unionVarSet`
@@ -1149,7 +1149,7 @@ leavesMatch (dL->L _ (Match { m_pats = pats
     [(body,
       mkVarSet (collectLStmtsBinders stmts)
         `unionVarSet` defined_vars)
-    | (dL->L _ (GRHS _ stmts body)) <- grhss]
+    | L _ (GRHS _ stmts body) <- grhss]
 leavesMatch _ = panic "leavesMatch"
 
 -- Replace the leaf commands in a match
@@ -1161,12 +1161,12 @@ replaceLeavesMatch
         -> ([Located (body' GhcTc)],            -- remaining leaf expressions
             LMatch GhcTc (Located (body' GhcTc))) -- updated match
 replaceLeavesMatch _res_ty leaves
-                        (dL->L loc
+                        (L loc
                           match@(Match { m_grhss = GRHSs x grhss binds }))
   = let
         (leaves', grhss') = mapAccumL replaceLeavesGRHS leaves grhss
     in
-    (leaves', cL loc (match { m_ext = noExtField, m_grhss = GRHSs x grhss' binds }))
+    (leaves', L loc (match { m_ext = noExtField, m_grhss = GRHSs x grhss' binds }))
 replaceLeavesMatch _ _ _ = panic "replaceLeavesMatch"
 
 replaceLeavesGRHS
@@ -1174,8 +1174,8 @@ replaceLeavesGRHS
         -> LGRHS GhcTc (Located (body GhcTc))     -- rhss of a case command
         -> ([Located (body' GhcTc)],              -- remaining leaf expressions
             LGRHS GhcTc (Located (body' GhcTc)))  -- updated GRHS
-replaceLeavesGRHS (leaf:leaves) (dL->L loc (GRHS x stmts _))
-  = (leaves, cL loc (GRHS x stmts leaf))
+replaceLeavesGRHS (leaf:leaves) (L loc (GRHS x stmts _))
+  = (leaves, L loc (GRHS x stmts leaf))
 replaceLeavesGRHS [] _ = panic "replaceLeavesGRHS []"
 replaceLeavesGRHS _ _ = panic "replaceLeavesGRHS"
 
@@ -1221,14 +1221,14 @@ collectPatsBinders pats = foldr collectl [] pats
 ---------------------
 collectl :: LPat GhcTc -> [Id] -> [Id]
 -- See Note [Dictionary binders in ConPatOut]
-collectl (dL->L _ pat) bndrs
+collectl (L _ pat) bndrs
   = go pat
   where
-    go (VarPat _ (dL->L _ var))   = var : bndrs
+    go (VarPat _ (L _ var))       = var : bndrs
     go (WildPat _)                = bndrs
     go (LazyPat _ pat)            = collectl pat bndrs
     go (BangPat _ pat)            = collectl pat bndrs
-    go (AsPat _ (dL->L _ a) pat)  = a : collectl pat bndrs
+    go (AsPat _ (L _ a) pat)      = a : collectl pat bndrs
     go (ParPat _ pat)             = collectl pat bndrs
 
     go (ListPat _ pats)           = foldr collectl bndrs pats
@@ -1241,7 +1241,7 @@ collectl (dL->L _ pat) bndrs
                                     ++ foldr collectl bndrs (hsConPatArgs ps)
     go (LitPat _ _)               = bndrs
     go (NPat {})                  = bndrs
-    go (NPlusKPat _ (dL->L _ n) _ _ _ _) = n : bndrs
+    go (NPlusKPat _ (L _ n) _ _ _ _) = n : bndrs
 
     go (SigPat _ pat _)           = collectl pat bndrs
     go (CoPat _ _ pat _)          = collectl (noLoc pat) bndrs
index 20a3b23..dbfc6f5 100644 (file)
@@ -101,7 +101,7 @@ dsTopLHsBinds binds
     unlifted_binds = filterBag (isUnliftedHsBind . unLoc) binds
     bang_binds     = filterBag (isBangedHsBind   . unLoc) binds
 
-    top_level_err desc (dL->L loc bind)
+    top_level_err desc (L loc bind)
       = putSrcSpanDs loc $
         errDs (hang (text "Top-level" <+> text desc <+> text "aren't allowed:")
                   2 (ppr bind))
@@ -118,8 +118,8 @@ dsLHsBinds binds
 ------------------------
 dsLHsBind :: LHsBind GhcTc
           -> DsM ([Id], [(Id,CoreExpr)])
-dsLHsBind (dL->L loc bind) = do dflags <- getDynFlags
-                                putSrcSpanDs loc $ dsHsBind dflags bind
+dsLHsBind (L loc bind) = do dflags <- getDynFlags
+                            putSrcSpanDs loc $ dsHsBind dflags bind
 
 -- | Desugar a single binding (or group of recursive binds).
 dsHsBind :: DynFlags
@@ -143,7 +143,7 @@ dsHsBind dflags (VarBind { var_id = var
                           else []
         ; return (force_var, [core_bind]) }
 
-dsHsBind dflags b@(FunBind { fun_id = (dL->L _ fun)
+dsHsBind dflags b@(FunBind { fun_id = L _ fun
                            , fun_matches = matches
                            , fun_co_fn = co_fn
                            , fun_tick = tick })
@@ -657,7 +657,7 @@ dsSpec :: Maybe CoreExpr        -- Just rhs => RULE is for a local binding
                                 --            rhs is in the Id's unfolding
        -> Located TcSpecPrag
        -> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule))
-dsSpec mb_poly_rhs (dL->L loc (SpecPrag poly_id spec_co spec_inl))
+dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
   | isJust (isClassOpId_maybe poly_id)
   = putSrcSpanDs loc $
     do { warnDs NoReason (text "Ignoring useless SPECIALISE pragma for class method selector"
index e0bb58b..e58bb34 100644 (file)
@@ -72,11 +72,11 @@ import Control.Monad
 -}
 
 dsLocalBinds :: LHsLocalBinds GhcTc -> CoreExpr -> DsM CoreExpr
-dsLocalBinds (dL->L _   (EmptyLocalBinds _))  body = return body
-dsLocalBinds (dL->L loc (HsValBinds _ binds)) body = putSrcSpanDs loc $
-                                                   dsValBinds binds body
-dsLocalBinds (dL->L _ (HsIPBinds _ binds))    body = dsIPBinds  binds body
-dsLocalBinds _                                _    = panic "dsLocalBinds"
+dsLocalBinds (L _   (EmptyLocalBinds _))  body = return body
+dsLocalBinds (L loc (HsValBinds _ binds)) body = putSrcSpanDs loc $
+                                                 dsValBinds binds body
+dsLocalBinds (L _ (HsIPBinds _ binds))    body = dsIPBinds  binds body
+dsLocalBinds _                            _    = panic "dsLocalBinds"
 
 -------------------------
 -- caller sets location
@@ -94,7 +94,7 @@ dsIPBinds (IPBinds ev_binds ip_binds) body
                 -- dependency order; hence Rec
         ; foldrM ds_ip_bind inner ip_binds }
   where
-    ds_ip_bind (dL->L _ (IPBind _ ~(Right n) e)) body
+    ds_ip_bind (L _ (IPBind _ ~(Right n) e)) body
       = do e' <- dsLExpr e
            return (Let (NonRec n e') body)
     ds_ip_bind _ _ = panic "dsIPBinds"
@@ -108,7 +108,7 @@ ds_val_bind :: (RecFlag, LHsBinds GhcTc) -> CoreExpr -> DsM CoreExpr
 -- a tuple and doing selections.
 -- Silently ignore INLINE and SPECIALISE pragmas...
 ds_val_bind (NonRecursive, hsbinds) body
-  | [dL->L loc bind] <- bagToList hsbinds
+  | [L loc bind] <- bagToList hsbinds
         -- Non-recursive, non-overloaded bindings only come in ones
         -- ToDo: in some bizarre case it's conceivable that there
         --       could be dict binds in the 'binds'.  (See the notes
@@ -192,13 +192,13 @@ dsUnliftedBind (AbsBinds { abs_tvs = [], abs_ev_vars = []
        ; ds_binds <- dsTcEvBinds_s ev_binds
        ; return (mkCoreLets ds_binds body2) }
 
-dsUnliftedBind (FunBind { fun_id = (dL->L l fun)
+dsUnliftedBind (FunBind { fun_id = L l fun
                         , fun_matches = matches
                         , fun_co_fn = co_fn
                         , fun_tick = tick }) body
                -- Can't be a bang pattern (that looks like a PatBind)
                -- so must be simply unboxed
-  = do { (args, rhs) <- matchWrapper (mkPrefixFunRhs (cL l $ idName fun))
+  = do { (args, rhs) <- matchWrapper (mkPrefixFunRhs (L l $ idName fun))
                                      Nothing matches
        ; MASSERT( null args ) -- Functions aren't lifted
        ; MASSERT( isIdHsWrapper co_fn )
@@ -231,7 +231,7 @@ dsUnliftedBind bind body = pprPanic "dsLet: unlifted" (ppr bind $$ ppr body)
 
 dsLExpr :: LHsExpr GhcTc -> DsM CoreExpr
 
-dsLExpr (dL->L loc e)
+dsLExpr (L loc e)
   = putSrcSpanDs loc $
     do { core_expr <- dsExpr e
    -- uncomment this check to test the hsExprType function in TcHsSyn
@@ -246,7 +246,7 @@ dsLExpr (dL->L loc e)
 -- See Note [Levity polymorphism checking] in DsMonad
 -- See Note [Levity polymorphism invariants] in CoreSyn
 dsLExprNoLP :: LHsExpr GhcTc -> DsM CoreExpr
-dsLExprNoLP (dL->L loc e)
+dsLExprNoLP (L loc e)
   = putSrcSpanDs loc $
     do { e' <- dsExpr e
        ; dsNoLevPolyExpr e' (text "In the type of expression:" <+> ppr e)
@@ -260,7 +260,7 @@ ds_expr :: Bool   -- are we directly inside an HsWrap?
         -> HsExpr GhcTc -> DsM CoreExpr
 ds_expr _ (HsPar _ e)            = dsLExpr e
 ds_expr _ (ExprWithTySig _ e _)  = dsLExpr e
-ds_expr w (HsVar _ (dL->L _ var)) = dsHsVar w var
+ds_expr w (HsVar _ (L _ var))    = dsHsVar w var
 ds_expr _ (HsUnboundVar {})      = panic "dsExpr: HsUnboundVar" -- Typechecker eliminates them
 ds_expr w (HsConLikeOut _ con)   = dsConLike w con
 ds_expr _ (HsIPVar {})           = panic "dsExpr: HsIPVar"
@@ -285,7 +285,7 @@ ds_expr _ (HsWrap _ co_fn e)
        ; warnAboutIdentities dflags e' wrapped_ty
        ; return wrapped_e }
 
-ds_expr _ (NegApp _ (dL->L loc
+ds_expr _ (NegApp _ (L loc
                       (HsOverLit _ lit@(OverLit { ol_val = HsIntegral i})))
                   neg_expr)
   = do { expr' <- putSrcSpanDs loc $ do
@@ -377,12 +377,12 @@ ds_expr _ e@(SectionR _ op expr) = do
                                                           core_op [Var x_id, Var y_id]))
 
 ds_expr _ (ExplicitTuple _ tup_args boxity)
-  = do { let go (lam_vars, args) (dL->L _ (Missing ty))
+  = do { let go (lam_vars, args) (L _ (Missing ty))
                     -- For every missing expression, we need
                     -- another lambda in the desugaring.
                = do { lam_var <- newSysLocalDsNoLP ty
                     ; return (lam_var : lam_vars, Var lam_var : args) }
-             go (lam_vars, args) (dL->L _ (Present _ expr))
+             go (lam_vars, args) (L _ (Present _ expr))
                     -- Expressions that are present don't generate
                     -- lambdas, just arguments.
                = do { core_expr <- dsLExprNoLP expr
@@ -419,11 +419,11 @@ ds_expr _ (HsLet _ binds body) = do
 -- 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.
 --
-ds_expr _ (HsDo res_ty ListComp (dL->L _ stmts)) = dsListComp stmts res_ty
-ds_expr _ (HsDo _ DoExpr        (dL->L _ stmts)) = dsDo stmts
-ds_expr _ (HsDo _ GhciStmtCtxt  (dL->L _ stmts)) = dsDo stmts
-ds_expr _ (HsDo _ MDoExpr       (dL->L _ stmts)) = dsDo stmts
-ds_expr _ (HsDo _ MonadComp     (dL->L _ stmts)) = dsMonadComp stmts
+ds_expr _ (HsDo res_ty ListComp (L _ stmts)) = dsListComp stmts res_ty
+ds_expr _ (HsDo _ DoExpr        (L _ stmts)) = dsDo stmts
+ds_expr _ (HsDo _ GhciStmtCtxt  (L _ stmts)) = dsDo stmts
+ds_expr _ (HsDo _ MDoExpr       (L _ stmts)) = dsDo stmts
+ds_expr _ (HsDo _ MonadComp     (L _ stmts)) = dsMonadComp stmts
 
 ds_expr _ (HsIf _ mb_fun guard_expr then_expr else_expr)
   = do { pred <- dsLExpr guard_expr
@@ -473,7 +473,7 @@ See Note [Grand plan for static forms] in StaticPtrTable for an overview.
     g = ... makeStatic loc f ...
 -}
 
-ds_expr _ (HsStatic _ expr@(dL->L loc _)) = do
+ds_expr _ (HsStatic _ expr@(L loc _)) = do
     expr_ds <- dsLExprNoLP expr
     let ty = exprType expr_ds
     makeStaticId <- dsLookupGlobalId makeStaticName
@@ -612,7 +612,7 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields
       -- of the record selector, and we must not make that a local binder
       -- else we shadow other uses of the record selector
       -- Hence 'lcl_id'.  Cf #2735
-    ds_field (dL->L _ rec_field)
+    ds_field (L _ rec_field)
       = do { rhs <- dsLExpr (hsRecFieldArg rec_field)
            ; let fld_id = unLoc (hsRecUpdFieldId rec_field)
            ; lcl_id <- newSysLocalDs (idType fld_id)
@@ -777,7 +777,7 @@ dsSyntaxExpr (SyntaxExpr { syn_expr      = expr
 
 findField :: [LHsRecField GhcTc arg] -> Name -> [arg]
 findField rbinds sel
-  = [hsRecFieldArg fld | (dL->L _ fld) <- rbinds
+  = [hsRecFieldArg fld | L _ fld <- rbinds
                        , sel == idName (unLoc $ hsRecFieldId fld) ]
 
 {-
@@ -896,7 +896,7 @@ dsDo stmts
   = goL stmts
   where
     goL [] = panic "dsDo"
-    goL ((dL->L loc stmt):lstmts) = putSrcSpanDs loc (go loc stmt lstmts)
+    goL ((L loc stmt):lstmts) = putSrcSpanDs loc (go loc stmt lstmts)
 
     go _ (LastStmt _ body _ _) stmts
       = ASSERT( null stmts ) dsLExpr body
@@ -961,7 +961,7 @@ dsDo stmts
                         , recS_ret_ty = body_ty} }) stmts
       = goL (new_bind_stmt : stmts)  -- rec_ids can be empty; eg  rec { print 'x' }
       where
-        new_bind_stmt = cL loc $ BindStmt bind_ty (mkBigLHsPatTupId later_pats)
+        new_bind_stmt = L loc $ BindStmt bind_ty (mkBigLHsPatTupId later_pats)
                                          mfix_app bind_op
                                          noSyntaxExpr  -- Tuple cannot fail
 
@@ -1002,7 +1002,7 @@ handle_failure pat match fail_op
   | otherwise
   = extractMatchResult match (error "It can't fail")
 
-mk_fail_msg :: HasSrcSpan e => DynFlags -> e -> String
+mk_fail_msg :: DynFlags -> Located e -> String
 mk_fail_msg dflags pat = "Pattern match failure in do expression at " ++
                          showPpr dflags (getLoc pat)
 
@@ -1142,7 +1142,7 @@ we're not directly in an HsWrap, reject.
 checkForcedEtaExpansion :: HsExpr GhcTc -> Type -> DsM ()
 checkForcedEtaExpansion expr ty
   | Just var <- case expr of
-                  HsVar _ (dL->L _ var)           -> Just var
+                  HsVar _ (L _ var)               -> Just var
                   HsConLikeOut _ (RealDataCon dc) -> Just (dataConWrapId dc)
                   _                               -> Nothing
   , let bad_tys = badUseOfLevPolyPrimop var ty
index 43ef232..49dab95 100644 (file)
@@ -97,7 +97,7 @@ dsForeigns' fos = do
              (vcat cs $$ vcat fe_init_code),
             foldr (appOL . toOL) nilOL bindss)
   where
-   do_ldecl (dL->L loc decl) = putSrcSpanDs loc (do_decl decl)
+   do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl)
 
    do_decl (ForeignImport { fd_name = id, fd_i_ext = co, fd_fi = spec }) = do
       traceIf (text "fi start" <+> ppr id)
@@ -106,10 +106,10 @@ dsForeigns' fos = do
       traceIf (text "fi end" <+> ppr id)
       return (h, c, [], bs)
 
-   do_decl (ForeignExport { fd_name = (dL->L _ id)
+   do_decl (ForeignExport { fd_name = L _ id
                           , fd_e_ext = co
                           , fd_fe = CExport
-                              (dL->L _ (CExportStatic _ ext_nm cconv)) _ }) = do
+                              (L _ (CExportStatic _ ext_nm cconv)) _ }) = do
       (h, c, _, _) <- dsFExport id co ext_nm cconv False
       return (h, c, [id], [])
    do_decl (XForeignDecl nec) = noExtCon nec
index a6ef106..fe60cb8 100644 (file)
@@ -70,10 +70,9 @@ dsGRHSs _ (XGRHSs nec) _ = noExtCon nec
 
 dsGRHS :: HsMatchContext Name -> Type -> LGRHS GhcTc (LHsExpr GhcTc)
        -> DsM MatchResult
-dsGRHS hs_ctx rhs_ty (dL->L _ (GRHS _ guards rhs))
+dsGRHS hs_ctx rhs_ty (L _ (GRHS _ guards rhs))
   = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs rhs_ty
-dsGRHS _ _ (dL->L _ (XGRHS nec)) = noExtCon nec
-dsGRHS _ _ _ = panic "dsGRHS: Impossible Match" -- due to #15884
+dsGRHS _ _ (L _ (XGRHS nec)) = noExtCon nec
 
 {-
 ************************************************************************
index e826045..084a9da 100644 (file)
@@ -484,8 +484,8 @@ dsMonadComp :: [ExprLStmt GhcTc] -> DsM CoreExpr
 dsMonadComp stmts = dsMcStmts stmts
 
 dsMcStmts :: [ExprLStmt GhcTc] -> DsM CoreExpr
-dsMcStmts []                          = panic "dsMcStmts"
-dsMcStmts ((dL->L loc stmt) : lstmts) = putSrcSpanDs loc (dsMcStmt stmt lstmts)
+dsMcStmts []                      = panic "dsMcStmts"
+dsMcStmts ((L loc stmt) : lstmts) = putSrcSpanDs loc (dsMcStmt stmt lstmts)
 
 ---------------
 dsMcStmt :: ExprStmt GhcTc -> [ExprLStmt GhcTc] -> DsM CoreExpr
@@ -639,7 +639,7 @@ dsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts
       | otherwise
         = extractMatchResult match (error "It can't fail")
 
-    mk_fail_msg :: HasSrcSpan e => DynFlags -> e -> String
+    mk_fail_msg :: DynFlags -> Located e -> String
     mk_fail_msg dflags pat
         = "Pattern match failure in monad comprehension at " ++
           showPpr dflags (getLoc pat)
index 4c38212..0b0c7ab 100644 (file)
@@ -170,15 +170,15 @@ repTopDs group@(HsGroup { hs_valds   = valds
         wrapGenSyms ss q_decs
       }
   where
-    no_splice (dL->L loc _)
+    no_splice (L loc _)
       = notHandledL loc "Splices within declaration brackets" empty
-    no_default_decl (dL->L loc decl)
+    no_default_decl (L loc decl)
       = notHandledL loc "Default declarations" (ppr decl)
-    no_warn (dL->L loc (Warning _ thing _))
+    no_warn (L loc (Warning _ thing _))
       = notHandledL loc "WARNING and DEPRECATION pragmas" $
                     text "Pragma for declaration of" <+> ppr thing
     no_warn _ = panic "repTopDs"
-    no_doc (dL->L loc _)
+    no_doc (L loc _)
       = notHandledL loc "Haddock documentation" empty
 repTopDs (XHsGroup nec) = noExtCon nec
 
@@ -192,7 +192,7 @@ hsScopedTvBinders binds
              XValBindsLR (NValBinds _ sigs) -> sigs
 
 get_scoped_tvs :: LSig GhcRn -> [Name]
-get_scoped_tvs (dL->L _ signature)
+get_scoped_tvs (L _ signature)
   | TypeSig _ _ sig <- signature
   = get_scoped_tvs_from_sig (hswc_body sig)
   | ClassOpSig _ _ _ sig <- signature
@@ -302,24 +302,24 @@ them into a `ForallT` or `ForallC`. Doing so caused #13018 and #13123.
 --
 repTyClD :: LTyClDecl GhcRn -> DsM (Maybe (SrcSpan, Core TH.DecQ))
 
-repTyClD (dL->L loc (FamDecl { tcdFam = fam })) = liftM Just $
-                                                  repFamilyDecl (L loc fam)
+repTyClD (L loc (FamDecl { tcdFam = fam })) = liftM Just $
+                                              repFamilyDecl (L loc fam)
 
-repTyClD (dL->L loc (SynDecl { tcdLName = tc, tcdTyVars = tvs, tcdRhs = rhs }))
+repTyClD (L loc (SynDecl { tcdLName = tc, tcdTyVars = tvs, tcdRhs = rhs }))
   = do { tc1 <- lookupLOcc tc           -- See note [Binders and occurrences]
        ; dec <- addTyClTyVarBinds tvs $ \bndrs ->
                 repSynDecl tc1 bndrs rhs
        ; return (Just (loc, dec)) }
 
-repTyClD (dL->L loc (DataDecl { tcdLName = tc
-                              , tcdTyVars = tvs
-                              , tcdDataDefn = defn }))
+repTyClD (L loc (DataDecl { tcdLName = tc
+                          , tcdTyVars = tvs
+                          , tcdDataDefn = defn }))
   = do { tc1 <- lookupLOcc tc           -- See note [Binders and occurrences]
        ; dec <- addTyClTyVarBinds tvs $ \bndrs ->
                 repDataDefn tc1 (Left bndrs) defn
        ; return (Just (loc, dec)) }
 
-repTyClD (dL->L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
+repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
                              tcdTyVars = tvs, tcdFDs = fds,
                              tcdSigs = sigs, tcdMeths = meth_binds,
                              tcdATs = ats, tcdATDefs = atds }))
@@ -341,7 +341,7 @@ repTyClD _ = panic "repTyClD"
 
 -------------------------
 repRoleD :: LRoleAnnotDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
-repRoleD (dL->L loc (RoleAnnotDecl _ tycon roles))
+repRoleD (L loc (RoleAnnotDecl _ tycon roles))
   = do { tycon1 <- lookupLOcc tycon
        ; roles1 <- mapM repRole roles
        ; roles2 <- coreList roleTyConName roles1
@@ -351,7 +351,7 @@ repRoleD _ = panic "repRoleD"
 
 -------------------------
 repKiSigD :: LStandaloneKindSig GhcRn -> DsM (SrcSpan, Core TH.DecQ)
-repKiSigD (dL->L loc kisig) =
+repKiSigD (L loc kisig) =
   case kisig of
     StandaloneKindSig _ v ki -> rep_ty_sig kiSigDName loc ki v
     XStandaloneKindSig nec -> noExtCon nec
@@ -393,11 +393,11 @@ repSynDecl tc bndrs ty
        ; repTySyn tc bndrs ty1 }
 
 repFamilyDecl :: LFamilyDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
-repFamilyDecl decl@(dL->L loc (FamilyDecl { fdInfo      = info
-                                          , fdLName     = tc
-                                          , fdTyVars    = tvs
-                                          , fdResultSig = dL->L _ resultSig
-                                          , fdInjectivityAnn = injectivity }))
+repFamilyDecl decl@(L loc (FamilyDecl { fdInfo      = info
+                                      , fdLName     = tc
+                                      , fdTyVars    = tvs
+                                      , fdResultSig = L _ resultSig
+                                      , fdInjectivityAnn = injectivity }))
   = do { tc1 <- lookupLOcc tc           -- See note [Binders and occurrences]
        ; let mkHsQTvs :: [LHsTyVarBndr GhcRn] -> LHsQTyVars GhcRn
              mkHsQTvs tvs = HsQTvs { hsq_ext = []
@@ -453,7 +453,7 @@ repInjectivityAnn :: Maybe (LInjectivityAnn GhcRn)
                   -> DsM (Core (Maybe TH.InjectivityAnn))
 repInjectivityAnn Nothing =
     do { coreNothing injAnnTyConName }
-repInjectivityAnn (Just (dL->L _ (InjectivityAnn lhs rhs))) =
+repInjectivityAnn (Just (L _ (InjectivityAnn lhs rhs))) =
     do { lhs'   <- lookupBinder (unLoc lhs)
        ; rhs1   <- mapM (lookupBinder . unLoc) rhs
        ; rhs2   <- coreList nameTyConName rhs1
@@ -473,7 +473,7 @@ repLFunDeps :: [LHsFunDep GhcRn] -> DsM (Core [TH.FunDep])
 repLFunDeps fds = repList funDepTyConName repLFunDep fds
 
 repLFunDep :: LHsFunDep GhcRn -> DsM (Core TH.FunDep)
-repLFunDep (dL->L _ (xs, ys))
+repLFunDep (L _ (xs, ys))
    = do xs' <- repList nameTyConName (lookupBinder . unLoc) xs
         ys' <- repList nameTyConName (lookupBinder . unLoc) ys
         repFunDep xs' ys'
@@ -481,13 +481,13 @@ repLFunDep (dL->L _ (xs, ys))
 -- Represent instance declarations
 --
 repInstD :: LInstDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
-repInstD (dL->L loc (TyFamInstD { tfid_inst = fi_decl }))
+repInstD (L loc (TyFamInstD { tfid_inst = fi_decl }))
   = do { dec <- repTyFamInstD fi_decl
        ; return (loc, dec) }
-repInstD (dL->L loc (DataFamInstD { dfid_inst = fi_decl }))
+repInstD (L loc (DataFamInstD { dfid_inst = fi_decl }))
   = do { dec <- repDataFamInstD fi_decl
        ; return (loc, dec) }
-repInstD (dL->L loc (ClsInstD { cid_inst = cls_decl }))
+repInstD (L loc (ClsInstD { cid_inst = cls_decl }))
   = do { dec <- repClsInstD cls_decl
        ; return (loc, dec) }
 repInstD _ = panic "repInstD"
@@ -523,8 +523,8 @@ repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds
 repClsInstD (XClsInstDecl nec) = noExtCon nec
 
 repStandaloneDerivD :: LDerivDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
-repStandaloneDerivD (dL->L loc (DerivDecl { deriv_strategy = strat
-                                          , deriv_type     = ty }))
+repStandaloneDerivD (L loc (DerivDecl { deriv_strategy = strat
+                                      , deriv_type     = ty }))
   = do { dec <- addSimpleTyVarBinds tvs $
                 do { cxt'     <- repLContext cxt
                    ; strat'   <- repDerivStrategy strat
@@ -611,9 +611,8 @@ repDataFamInstD (DataFamInstDecl (HsIB _ (XFamEqn nec)))
   = noExtCon nec
 
 repForD :: Located (ForeignDecl GhcRn) -> DsM (SrcSpan, Core TH.DecQ)
-repForD (dL->L loc (ForeignImport { fd_name = name, fd_sig_ty = typ
-                                  , fd_fi = CImport (dL->L _ cc)
-                                                    (dL->L _ s) mch cis _ }))
+repForD (L loc (ForeignImport { fd_name = name, fd_sig_ty = typ
+                              , fd_fi = CImport (L _ cc) (L _ s) mch cis _ }))
  = do MkC name' <- lookupLOcc name
       MkC typ' <- repHsSigType typ
       MkC cc' <- repCCallConv cc
@@ -654,7 +653,7 @@ repSafety PlayInterruptible = rep2 interruptibleName []
 repSafety PlaySafe = rep2 safeName []
 
 repFixD :: LFixitySig GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]
-repFixD (dL->L loc (FixitySig _ names (Fixity _ prec dir)))
+repFixD (L loc (FixitySig _ names (Fixity _ prec dir)))
   = do { MkC prec' <- coreIntLit prec
        ; let rep_fn = case dir of
                         InfixL -> infixLDName
@@ -668,12 +667,12 @@ repFixD (dL->L loc (FixitySig _ names (Fixity _ prec dir)))
 repFixD _ = panic "repFixD"
 
 repRuleD :: LRuleDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
-repRuleD (dL->L loc (HsRule { rd_name = n
-                            , rd_act = act
-                            , rd_tyvs = ty_bndrs
-                            , rd_tmvs = tm_bndrs
-                            , rd_lhs = lhs
-                            , rd_rhs = rhs }))
+repRuleD (L loc (HsRule { rd_name = n
+                        , rd_act = act
+                        , rd_tyvs = ty_bndrs
+                        , rd_tmvs = tm_bndrs
+                        , rd_lhs = lhs
+                        , rd_rhs = rhs }))
   = do { rule <- addHsTyVarBinds (fromMaybe [] ty_bndrs) $ \ ex_bndrs ->
          do { let tm_bndr_names = concatMap ruleBndrNames tm_bndrs
             ; ss <- mkGenSyms tm_bndr_names
@@ -695,29 +694,28 @@ repRuleD (dL->L loc (HsRule { rd_name = n
 repRuleD _ = panic "repRuleD"
 
 ruleBndrNames :: LRuleBndr GhcRn -> [Name]
-ruleBndrNames (dL->L _ (RuleBndr _ n))      = [unLoc n]
-ruleBndrNames (dL->L _ (RuleBndrSig _ n sig))
+ruleBndrNames (L _ (RuleBndr _ n))      = [unLoc n]
+ruleBndrNames (L _ (RuleBndrSig _ n sig))
   | HsWC { hswc_body = HsIB { hsib_ext = vars }} <- sig
   = unLoc n : vars
-ruleBndrNames (dL->L _ (RuleBndrSig _ _ (HsWC _ (XHsImplicitBndrs _))))
+ruleBndrNames (L _ (RuleBndrSig _ _ (HsWC _ (XHsImplicitBndrs _))))
   = panic "ruleBndrNames"
-ruleBndrNames (dL->L _ (RuleBndrSig _ _ (XHsWildCardBndrs _)))
+ruleBndrNames (L _ (RuleBndrSig _ _ (XHsWildCardBndrs _)))
   = panic "ruleBndrNames"
-ruleBndrNames (dL->L _ (XRuleBndr nec)) = noExtCon nec
-ruleBndrNames _ = panic "ruleBndrNames: Impossible Match" -- due to #15884
+ruleBndrNames (L _ (XRuleBndr nec)) = noExtCon nec
 
 repRuleBndr :: LRuleBndr GhcRn -> DsM (Core TH.RuleBndrQ)
-repRuleBndr (dL->L _ (RuleBndr _ n))
+repRuleBndr (L _ (RuleBndr _ n))
   = do { MkC n' <- lookupLBinder n
        ; rep2 ruleVarName [n'] }
-repRuleBndr (dL->L _ (RuleBndrSig _ n sig))
+repRuleBndr (L _ (RuleBndrSig _ n sig))
   = do { MkC n'  <- lookupLBinder n
        ; MkC ty' <- repLTy (hsSigWcType sig)
        ; rep2 typedRuleVarName [n', ty'] }
 repRuleBndr _ = panic "repRuleBndr"
 
 repAnnD :: LAnnDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
-repAnnD (dL->L loc (HsAnnotation _ _ ann_prov (dL->L _ exp)))
+repAnnD (L loc (HsAnnotation _ _ ann_prov (L _ exp)))
   = do { target <- repAnnProv ann_prov
        ; exp'   <- repE exp
        ; dec    <- repPragAnn target exp'
@@ -725,10 +723,10 @@ repAnnD (dL->L loc (HsAnnotation _ _ ann_prov (dL->L _ exp)))
 repAnnD _ = panic "repAnnD"
 
 repAnnProv :: AnnProvenance Name -> DsM (Core TH.AnnTarget)
-repAnnProv (ValueAnnProvenance (dL->L _ n))
+repAnnProv (ValueAnnProvenance (L _ n))
   = do { MkC n' <- globalVar n  -- ANNs are allowed only at top-level
        ; rep2 valueAnnotationName [ n' ] }
-repAnnProv (TypeAnnProvenance (dL->L _ n))
+repAnnProv (TypeAnnProvenance (L _ n))
   = do { MkC n' <- globalVar n
        ; rep2 typeAnnotationName [ n' ] }
 repAnnProv ModuleAnnProvenance
@@ -739,17 +737,17 @@ repAnnProv ModuleAnnProvenance
 -------------------------------------------------------
 
 repC :: LConDecl GhcRn -> DsM (Core TH.ConQ)
-repC (dL->L _ (ConDeclH98 { con_name   = con
-                          , con_forall = (dL->L _ False)
-                          , con_mb_cxt = Nothing
-                          , con_args   = args }))
+repC (L _ (ConDeclH98 { con_name   = con
+                      , con_forall = L _ False
+                      , con_mb_cxt = Nothing
+                      , con_args   = args }))
   = repDataCon con args
 
-repC (dL->L _ (ConDeclH98 { con_name = con
-                          , con_forall = (dL->L _ is_existential)
-                          , con_ex_tvs = con_tvs
-                          , con_mb_cxt = mcxt
-                          , con_args = args }))
+repC (L _ (ConDeclH98 { con_name = con
+                      , con_forall = L _ is_existential
+                      , con_ex_tvs = con_tvs
+                      , con_mb_cxt = mcxt
+                      , con_args = args }))
   = do { addHsTyVarBinds con_tvs $ \ ex_bndrs ->
          do { c'    <- repDataCon con args
             ; ctxt' <- repMbContext mcxt
@@ -759,11 +757,11 @@ repC (dL->L _ (ConDeclH98 { con_name = con
             }
        }
 
-repC (dL->L _ (ConDeclGADT { con_names  = cons
-                           , con_qvars  = qtvs
-                           , con_mb_cxt = mcxt
-                           , con_args   = args
-                           , con_res_ty = res_ty }))
+repC (L _ (ConDeclGADT { con_names  = cons
+                       , con_qvars  = qtvs
+                       , con_mb_cxt = mcxt
+                       , con_args   = args
+                       , con_res_ty = res_ty }))
   | isEmptyLHsQTvs qtvs  -- No implicit or explicit variables
   , Nothing <- mcxt      -- No context
                          -- ==> no need for a forall
@@ -783,7 +781,7 @@ repC _ = panic "repC"
 
 repMbContext :: Maybe (LHsContext GhcRn) -> DsM (Core TH.CxtQ)
 repMbContext Nothing          = repContext []
-repMbContext (Just (dL->L _ cxt)) = repContext cxt
+repMbContext (Just (L _ cxt)) = repContext cxt
 
 repSrcUnpackedness :: SrcUnpackedness -> DsM (Core TH.SourceUnpackednessQ)
 repSrcUnpackedness SrcUnpack   = rep2 sourceUnpackName         []
@@ -812,14 +810,14 @@ repBangTy ty = do
 -------------------------------------------------------
 
 repDerivs :: HsDeriving GhcRn -> DsM (Core [TH.DerivClauseQ])
-repDerivs (dL->L _ clauses)
+repDerivs (L _ clauses)
   = repList derivClauseQTyConName repDerivClause clauses
 
 repDerivClause :: LHsDerivingClause GhcRn
                -> DsM (Core TH.DerivClauseQ)
-repDerivClause (dL->L _ (HsDerivingClause
+repDerivClause (L _ (HsDerivingClause
                           { deriv_clause_strategy = dcs
-                          , deriv_clause_tys      = (dL->L _ dct) }))
+                          , deriv_clause_tys      = L _ dct }))
   = do MkC dcs' <- repDerivStrategy dcs
        MkC dct' <- repList typeQTyConName (rep_deriv_ty . hsSigType) dct
        rep2 derivClauseName [dcs',dct']
@@ -853,22 +851,22 @@ rep_sigs :: [LSig GhcRn] -> DsM [(SrcSpan, Core TH.DecQ)]
 rep_sigs = concatMapM rep_sig
 
 rep_sig :: LSig GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]
-rep_sig (dL->L loc (TypeSig _ nms ty))
+rep_sig (L loc (TypeSig _ nms ty))
   = mapM (rep_wc_ty_sig sigDName loc ty) nms
-rep_sig (dL->L loc (PatSynSig _ nms ty))
+rep_sig (L loc (PatSynSig _ nms ty))
   = mapM (rep_patsyn_ty_sig loc ty) nms
-rep_sig (dL->L loc (ClassOpSig _ is_deflt nms ty))
+rep_sig (L loc (ClassOpSig _ is_deflt nms ty))
   | is_deflt     = mapM (rep_ty_sig defaultSigDName loc ty) nms
   | otherwise    = mapM (rep_ty_sig sigDName loc ty) nms
-rep_sig d@(dL->L _ (IdSig {}))           = pprPanic "rep_sig IdSig" (ppr d)
-rep_sig (dL->L _   (FixSig {}))          = return [] -- fixity sigs at top level
-rep_sig (dL->L loc (InlineSig _ nm ispec))= rep_inline nm ispec loc
-rep_sig (dL->L loc (SpecSig _ nm tys ispec))
+rep_sig d@(L _ (IdSig {}))           = pprPanic "rep_sig IdSig" (ppr d)
+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 (dL->L loc (SpecInstSig _ _ ty))  = rep_specialiseInst ty loc
-rep_sig (dL->L _   (MinimalSig {}))       = notHandled "MINIMAL pragmas" empty
-rep_sig (dL->L _   (SCCFunSig {}))        = notHandled "SCC pragmas" empty
-rep_sig (dL->L loc (CompleteMatchSig _ _st cls mty))
+rep_sig (L loc (SpecInstSig _ _ ty))  = rep_specialiseInst ty loc
+rep_sig (L _   (MinimalSig {}))       = notHandled "MINIMAL pragmas" empty
+rep_sig (L _   (SCCFunSig {}))        = notHandled "SCC pragmas" empty
+rep_sig (L loc (CompleteMatchSig _ _st cls mty))
   = rep_complete_sig cls mty loc
 rep_sig _ = panic "rep_sig"
 
@@ -990,7 +988,7 @@ rep_complete_sig :: Located [Located Name]
                  -> Maybe (Located Name)
                  -> SrcSpan
                  -> DsM [(SrcSpan, Core TH.DecQ)]
-rep_complete_sig (dL->L _ cls) mty loc
+rep_complete_sig (L _ cls) mty loc
   = do { mty' <- repMaybe nameTyConName lookupLOcc mty
        ; cls' <- repList nameTyConName lookupLOcc cls
        ; sig <- repPragComplete cls' mty'
@@ -1066,18 +1064,18 @@ addTyClTyVarBinds tvs m
 --
 repTyVarBndrWithKind :: LHsTyVarBndr GhcRn
                      -> Core TH.Name -> DsM (Core TH.TyVarBndrQ)
-repTyVarBndrWithKind (dL->L _ (UserTyVar _ _)) nm
+repTyVarBndrWithKind (L _ (UserTyVar _ _)) nm
   = repPlainTV nm
-repTyVarBndrWithKind (dL->L _ (KindedTyVar _ _ ki)) nm
+repTyVarBndrWithKind (L _ (KindedTyVar _ _ ki)) nm
   = repLTy ki >>= repKindedTV nm
 repTyVarBndrWithKind _ _ = panic "repTyVarBndrWithKind"
 
 -- | Represent a type variable binder
 repTyVarBndr :: LHsTyVarBndr GhcRn -> DsM (Core TH.TyVarBndrQ)
-repTyVarBndr (dL->L _ (UserTyVar _ (dL->L _ nm)) )
+repTyVarBndr (L _ (UserTyVar _ (L _ nm)) )
   = do { nm' <- lookupBinder nm
        ; repPlainTV nm' }
-repTyVarBndr (dL->L _ (KindedTyVar _ (dL->L _ nm) ki))
+repTyVarBndr (L _ (KindedTyVar _ (L _ nm) ki))
   = do { nm' <- lookupBinder nm
        ; ki' <- repLTy ki
        ; repKindedTV nm' ki' }
@@ -1135,7 +1133,7 @@ repTy :: HsType GhcRn -> DsM (Core TH.TypeQ)
 repTy ty@(HsForAllTy {hst_fvf = fvf}) = repForall fvf         ty
 repTy ty@(HsQualTy {})                = repForall ForallInvis ty
 
-repTy (HsTyVar _ _ (dL->L _ n))
+repTy (HsTyVar _ _ (L _ n))
   | isLiftedTypeKindTyConName n       = repTStar
   | n `hasKey` constraintKindTyConKey = repTConstraint
   | n `hasKey` funTyConKey            = repArrowTyCon
@@ -1216,11 +1214,10 @@ repMaybeLTy :: Maybe (LHsKind GhcRn)
 repMaybeLTy = repMaybe kindQTyConName repLTy
 
 repRole :: Located (Maybe Role) -> DsM (Core TH.Role)
-repRole (dL->L _ (Just Nominal))          = rep2 nominalRName []
-repRole (dL->L _ (Just Representational)) = rep2 representationalRName []
-repRole (dL->L _ (Just Phantom))          = rep2 phantomRName []
-repRole (dL->L _ Nothing)                 = rep2 inferRName []
-repRole _ = panic "repRole: Impossible Match" -- due to #15884
+repRole (L _ (Just Nominal))          = rep2 nominalRName []
+repRole (L _ (Just Representational)) = rep2 representationalRName []
+repRole (L _ (Just Phantom))          = rep2 phantomRName []
+repRole (L _ Nothing)                 = rep2 inferRName []
 
 -----------------------------------------------------------------------------
 --              Splices
@@ -1256,10 +1253,10 @@ repLEs es = repList expQTyConName repLE es
 --        unless we can make sure that constructs, which are plainly not
 --        supported in TH already lead to error messages at an earlier stage
 repLE :: LHsExpr GhcRn -> DsM (Core TH.ExpQ)
-repLE (dL->L loc e) = putSrcSpanDs loc (repE e)
+repLE (L loc e) = putSrcSpanDs loc (repE e)
 
 repE :: HsExpr GhcRn -> DsM (Core TH.ExpQ)
-repE (HsVar _ (dL->L _ x)) =
+repE (HsVar _ (L _ x)) =
   do { mb_val <- dsLookupMetaEnv x
      ; case mb_val of
         Nothing            -> do { str <- globalVar x
@@ -1279,8 +1276,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 = (dL->L _ [m]) })) = repLambda m
-repE (HsLamCase _ (MG { mg_alts = (dL->L _ 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 }
@@ -1301,7 +1298,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 = (dL->L _ ms) }))
+repE (HsCase _ e (MG { mg_alts = (L _ ms) }))
                           = do { arg <- repLE e
                                ; ms2 <- mapM repMatchTup ms
                                ; core_ms2 <- coreList matchQTyConName ms2
@@ -1315,13 +1312,13 @@ repE (HsMultiIf _ alts)
   = do { (binds, alts') <- liftM unzip $ mapM repLGRHS alts
        ; expr' <- repMultiIf (nonEmptyCoreList alts')
        ; wrapGenSyms (concat binds) expr' }
-repE (HsLet _ (dL->L _ bs) e)       = do { (ss,ds) <- repBinds bs
+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 (dL->L _ sts))
+repE e@(HsDo _ ctxt (L _ sts))
  | case ctxt of { DoExpr -> True; GhciStmtCtxt -> True; _ -> False }
  = do { (ss,zs) <- repLSts sts;
         e'      <- repDoE (nonEmptyCoreList zs);
@@ -1343,9 +1340,9 @@ repE e@(HsDo _ ctxt (dL->L _ sts))
 repE (ExplicitList _ _ es) = do { xs <- repLEs es; repListExp xs }
 repE (ExplicitTuple _ es boxity) =
   let tupArgToCoreExp :: LHsTupArg GhcRn -> DsM (Core (Maybe TH.ExpQ))
-      tupArgToCoreExp a
-        | L _ (Present _ e) <- dL a = do { e' <- repLE e
-                                         ; coreJust expQTyConName e' }
+      tupArgToCoreExp (L _ a)
+        | Present _ e <- a = do { e' <- repLE e
+                                ; coreJust expQTyConName e' }
         | otherwise = coreNothing expQTyConName
 
   in do { args <- mapM tupArgToCoreExp es
@@ -1407,8 +1404,8 @@ repE e                     = notHandled "Expression form" (ppr e)
 -- Building representations of auxiliary structures like Match, Clause, Stmt,
 
 repMatchTup ::  LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.MatchQ)
-repMatchTup (dL->L _ (Match { m_pats = [p]
-                            , m_grhss = GRHSs _ guards (dL->L _ wheres) })) =
+repMatchTup (L _ (Match { m_pats = [p]
+                        , m_grhss = GRHSs _ guards (L _ wheres) })) =
   do { ss1 <- mkGenSyms (collectPatBinders p)
      ; addBinds ss1 $ do {
      ; p1 <- repLP p
@@ -1420,8 +1417,8 @@ repMatchTup (dL->L _ (Match { m_pats = [p]
 repMatchTup _ = panic "repMatchTup: case alt with more than one arg"
 
 repClauseTup ::  LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.ClauseQ)
-repClauseTup (dL->L _ (Match { m_pats = ps
-                             , m_grhss = GRHSs _ guards (dL->L _ wheres) })) =
+repClauseTup (L _ (Match { m_pats = ps
+                         , m_grhss = GRHSs _ guards (L _ wheres) })) =
   do { ss1 <- mkGenSyms (collectPatsBinders ps)
      ; addBinds ss1 $ do {
        ps1 <- repLPs ps
@@ -1430,11 +1427,11 @@ repClauseTup (dL->L _ (Match { m_pats = ps
        gs <- repGuards guards
      ; clause <- repClause ps1 gs ds
      ; wrapGenSyms (ss1++ss2) clause }}}
-repClauseTup (dL->L _ (Match _ _ _ (XGRHSs nec))) = noExtCon nec
+repClauseTup (L _ (Match _ _ _ (XGRHSs nec))) = noExtCon nec
 repClauseTup _ = panic "repClauseTup"
 
 repGuards ::  [LGRHS GhcRn (LHsExpr GhcRn)] ->  DsM (Core TH.BodyQ)
-repGuards [dL->L _ (GRHS _ [] e)]
+repGuards [L _ (GRHS _ [] e)]
   = do {a <- repLE e; repNormal a }
 repGuards other
   = do { zs <- mapM repLGRHS other
@@ -1444,10 +1441,10 @@ repGuards other
 
 repLGRHS :: LGRHS GhcRn (LHsExpr GhcRn)
          -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
-repLGRHS (dL->L _ (GRHS _ [dL->L _ (BodyStmt _ e1 _ _)] e2))
+repLGRHS (L _ (GRHS _ [L _ (BodyStmt _ e1 _ _)] e2))
   = do { guarded <- repLNormalGE e1 e2
        ; return ([], guarded) }
-repLGRHS (dL->L _ (GRHS _ ss rhs))
+repLGRHS (L _ (GRHS _ ss rhs))
   = do { (gs, ss') <- repLSts ss
        ; rhs' <- addBinds gs $ repLE rhs
        ; guarded <- repPatGE (nonEmptyCoreList ss') rhs'
@@ -1460,16 +1457,16 @@ repFields (HsRecFields { rec_flds = flds })
   where
     rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn)
             -> DsM (Core (TH.Q TH.FieldExp))
-    rep_fld (dL->L _ fld) = do { fn <- lookupLOcc (hsRecFieldSel fld)
-                               ; e  <- repLE (hsRecFieldArg fld)
-                               ; repFieldExp fn e }
+    rep_fld (L _ fld) = do { fn <- lookupLOcc (hsRecFieldSel fld)
+                           ; e  <- repLE (hsRecFieldArg fld)
+                           ; repFieldExp fn e }
 
 repUpdFields :: [LHsRecUpdField GhcRn] -> DsM (Core [TH.Q TH.FieldExp])
 repUpdFields = repList fieldExpQTyConName rep_fld
   where
     rep_fld :: LHsRecUpdField GhcRn -> DsM (Core (TH.Q TH.FieldExp))
-    rep_fld (dL->L l fld) = case unLoc (hsRecFieldLbl fld) of
-      Unambiguous sel_name _ -> do { fn <- lookupLOcc (cL l sel_name)
+    rep_fld (L l fld) = case unLoc (hsRecFieldLbl fld) of
+      Unambiguous sel_name _ -> do { fn <- lookupLOcc (L l sel_name)
                                    ; e  <- repLE (hsRecFieldArg fld)
                                    ; repFieldExp fn e }
       _                      -> notHandled "Ambiguous record updates" (ppr fld)
@@ -1513,7 +1510,7 @@ repSts (BindStmt _ p e _ _ : ss) =
       ; (ss2,zs) <- repSts ss
       ; z <- repBindSt p1 e2
       ; return (ss1++ss2, z : zs) }}
-repSts (LetStmt _ (dL->L _ bs) : ss) =
+repSts (LetStmt _ (L _ bs) : ss) =
    do { (ss1,ds) <- repBinds bs
       ; z <- repLetSt ds
       ; (ss2,zs) <- addBinds ss1 (repSts ss)
@@ -1590,18 +1587,16 @@ repBinds (HsValBinds _ decs)
 repBinds b@(XHsLocalBindsLR {}) = notHandled "Local binds extensions" (ppr b)
 
 rep_implicit_param_bind :: LIPBind GhcRn -> DsM (SrcSpan, Core TH.DecQ)
-rep_implicit_param_bind (dL->L loc (IPBind _ ename (dL->L _ rhs)))
+rep_implicit_param_bind (L loc (IPBind _ ename (L _ rhs)))
  = do { name <- case ename of
-                    Left (dL->L _ n) -> rep_implicit_param_name n
+                    Left (L _ n) -> rep_implicit_param_name n
                     Right _ ->
                         panic "rep_implicit_param_bind: post typechecking"
       ; rhs' <- repE rhs
       ; ipb <- repImplicitParamBind name rhs'
       ; return (loc, ipb) }
-rep_implicit_param_bind (dL->L _ b@(XIPBind _))
+rep_implicit_param_bind (L _ b@(XIPBind _))
  = notHandled "Implicit parameter bind extension" (ppr b)
-rep_implicit_param_bind _ = panic "rep_implicit_param_bind: Impossible Match"
-                            -- due to #15884
 
 rep_implicit_param_name :: HsIPName -> DsM (Core String)
 rep_implicit_param_name (HsIPName name) = coreStringLit (unpackFS name)
@@ -1624,13 +1619,12 @@ rep_bind :: LHsBind GhcRn -> 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 (dL->L loc (FunBind
+rep_bind (L loc (FunBind
                  { fun_id = fn,
                    fun_matches = MG { mg_alts
-                           = (dL->L _ [dL->L _ (Match
-                                       { m_pats = []
-                                       , m_grhss = GRHSs _ guards
-                                                     (dL->L _ wheres) }
+                           = (L _ [L _ (Match
+                                   { m_pats = []
+                                   , m_grhss = GRHSs _ guards (L _ wheres) }
                                       )]) } }))
  = do { (ss,wherecore) <- repBinds wheres
         ; guardcore <- addBinds ss (repGuards guards)
@@ -1640,26 +1634,26 @@ rep_bind (dL->L loc (FunBind
         ; ans' <- wrapGenSyms ss ans
         ; return (loc, ans') }
 
-rep_bind (dL->L loc (FunBind { fun_id = fn
-                             , fun_matches = MG { mg_alts = (dL->L _ 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 (dL->L _ (FunBind { fun_matches = XMatchGroup nec })) = noExtCon nec
+rep_bind (L _ (FunBind { fun_matches = XMatchGroup nec })) = noExtCon nec
 
-rep_bind (dL->L loc (PatBind { pat_lhs = pat
-                             , pat_rhs = GRHSs _ guards (dL->L _ 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)
         ; ans  <- repVal patcore guardcore wherecore
         ; ans' <- wrapGenSyms ss ans
         ; return (loc, ans') }
-rep_bind (dL->L _ (PatBind _ _ (XGRHSs nec) _)) = noExtCon nec
+rep_bind (L _ (PatBind _ _ (XGRHSs nec) _)) = noExtCon nec
 
-rep_bind (dL->L _ (VarBind { var_id = v, var_rhs = e}))
+rep_bind (L _ (VarBind { var_id = v, var_rhs = e}))
  =   do { v' <- lookupBinder v
         ; e2 <- repLE e
         ; x <- repNormal e2
@@ -1668,11 +1662,11 @@ rep_bind (dL->L _ (VarBind { var_id = v, var_rhs = e}))
         ; ans <- repVal patcore x empty_decls
         ; return (srcLocSpan (getSrcLoc v), ans) }
 
-rep_bind (dL->L _ (AbsBinds {}))  = panic "rep_bind: AbsBinds"
-rep_bind (dL->L loc (PatSynBind _ (PSB { psb_id   = syn
-                                       , psb_args = args
-                                       , psb_def  = pat
-                                       , psb_dir  = dir })))
+rep_bind (L _ (AbsBinds {}))  = panic "rep_bind: AbsBinds"
+rep_bind (L loc (PatSynBind _ (PSB { psb_id   = syn
+                                   , psb_args = args
+                                   , psb_def  = pat
+                                   , psb_dir  = dir })))
   = do { syn'      <- lookupLBinder syn
        ; dir'      <- repPatSynDir dir
        ; ss        <- mkGenArgSyms args
@@ -1707,11 +1701,8 @@ rep_bind (dL->L loc (PatSynBind _ (PSB { psb_id   = syn
     wrapGenArgSyms (RecCon _) _  dec = return dec
     wrapGenArgSyms _          ss dec = wrapGenSyms ss dec
 
-rep_bind (dL->L _ (PatSynBind _ (XPatSynBind nec)))
-  = noExtCon nec
-rep_bind (dL->L _ (XHsBindsLR nec)) = noExtCon nec
-rep_bind _                          = panic "rep_bind: Impossible match!"
-                                      -- due to #15884
+rep_bind (L _ (PatSynBind _ (XPatSynBind nec))) = noExtCon nec
+rep_bind (L _ (XHsBindsLR nec)) = noExtCon nec
 
 repPatSynD :: Core TH.Name
            -> Core TH.PatSynArgsQ
@@ -1747,7 +1738,7 @@ repRecordPatSynArgs (MkC sels) = rep2 recordPatSynName [sels]
 repPatSynDir :: HsPatSynDir GhcRn -> DsM (Core TH.PatSynDirQ)
 repPatSynDir Unidirectional        = rep2 unidirPatSynName []
 repPatSynDir ImplicitBidirectional = rep2 implBidirPatSynName []
-repPatSynDir (ExplicitBidirectional (MG { mg_alts = (dL->L _ clauses) }))
+repPatSynDir (ExplicitBidirectional (MG { mg_alts = (L _ clauses) }))
   = do { clauses' <- mapM repClauseTup clauses
        ; repExplBidirPatSynDir (nonEmptyCoreList clauses') }
 repPatSynDir (ExplicitBidirectional (XMatchGroup nec)) = noExtCon nec
@@ -1781,16 +1772,16 @@ repExplBidirPatSynDir (MkC cls) = rep2 explBidirPatSynName [cls]
 -- (\ p1 .. pn -> exp) by causing an error.
 
 repLambda :: LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.ExpQ)
-repLambda (dL->L _ (Match { m_pats = ps
-                          , m_grhss = GRHSs _ [dL->L _ (GRHS _ [] e)]
-                                              (dL->L _ (EmptyLocalBinds _)) } ))
+repLambda (L _ (Match { m_pats = ps
+                      , m_grhss = GRHSs _ [L _ (GRHS _ [] e)]
+                                          (L _ (EmptyLocalBinds _)) } ))
  = do { let bndrs = collectPatsBinders ps ;
       ; ss  <- mkGenSyms bndrs
       ; lam <- addBinds ss (
                 do { xs <- repLPs ps; body <- repLE e; repLam xs body })
       ; wrapGenSyms ss lam }
 
-repLambda (dL->L _ m) = notHandled "Guarded lambdas" (pprMatch m)
+repLambda (L _ m) = notHandled "Guarded lambdas" (pprMatch m)
 
 
 -----------------------------------------------------------------------------
@@ -1837,12 +1828,12 @@ repP (ConPatIn dc details)
    }
  where
    rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> DsM (Core (TH.Name,TH.PatQ))
-   rep_fld (dL->L _ fld) = do { MkC v <- lookupLOcc (hsRecFieldSel fld)
-                              ; MkC p <- repLP (hsRecFieldArg fld)
-                              ; rep2 fieldPatName [v,p] }
+   rep_fld (L _ fld) = do { MkC v <- lookupLOcc (hsRecFieldSel fld)
+                          ; MkC p <- repLP (hsRecFieldArg fld)
+                          ; rep2 fieldPatName [v,p] }
 
-repP (NPat _ (dL->L _ 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 (SigPat _ p t) = do { p' <- repLP p
index b76c4f0..c358c17 100644 (file)
@@ -674,7 +674,7 @@ mkSelectorBinds :: [[Tickish Id]] -- ^ ticks to add, possibly
                 -- and all the desugared binds
 
 mkSelectorBinds ticks pat val_expr
-  | (dL->L _ (VarPat _ (dL->L _ v))) <- pat'     -- Special case (A)
+  | L _ (VarPat _ (L _ v)) <- pat'     -- Special case (A)
   = return (v, [(v, val_expr)])
 
   | is_flat_prod_lpat pat'           -- Special case (B)
@@ -721,9 +721,9 @@ mkSelectorBinds ticks pat val_expr
 
 strip_bangs :: LPat (GhcPass p) -> LPat (GhcPass p)
 -- Remove outermost bangs and parens
-strip_bangs (dL->L _ (ParPat _ p))  = strip_bangs p
-strip_bangs (dL->L _ (BangPat _ p)) = strip_bangs p
-strip_bangs lp                      = lp
+strip_bangs (L _ (ParPat _ p))  = strip_bangs p
+strip_bangs (L _ (BangPat _ p)) = strip_bangs p
+strip_bangs lp                  = lp
 
 is_flat_prod_lpat :: LPat (GhcPass p) -> Bool
 is_flat_prod_lpat = is_flat_prod_pat . unLoc
@@ -731,7 +731,7 @@ is_flat_prod_lpat = is_flat_prod_pat . unLoc
 is_flat_prod_pat :: Pat (GhcPass p) -> Bool
 is_flat_prod_pat (ParPat _ p)          = is_flat_prod_lpat p
 is_flat_prod_pat (TuplePat _ ps Boxed) = all is_triv_lpat ps
-is_flat_prod_pat (ConPatOut { pat_con  = (dL->L _ pcon)
+is_flat_prod_pat (ConPatOut { pat_con  = L _ pcon
                             , pat_args = ps})
   | RealDataCon con <- pcon
   , isProductTyCon (dataConTyCon con)
@@ -759,7 +759,7 @@ is_triv_pat _            = False
 mkLHsPatTup :: [LPat GhcTc] -> LPat GhcTc
 mkLHsPatTup []     = noLoc $ mkVanillaTuplePat [] Boxed
 mkLHsPatTup [lpat] = lpat
-mkLHsPatTup lpats  = cL (getLoc (head lpats)) $
+mkLHsPatTup lpats  = L (getLoc (head lpats)) $
                      mkVanillaTuplePat lpats Boxed
 
 mkVanillaTuplePat :: [OutPat GhcTc] -> Boxity -> Pat GhcTc
@@ -952,25 +952,25 @@ decideBangHood dflags lpat
   | otherwise   --  -XStrict
   = go lpat
   where
-    go lp@(dL->L l p)
+    go lp@(L l p)
       = case p of
-           ParPat x p    -> cL l (ParPat x (go p))
+           ParPat x p    -> L l (ParPat x (go p))
            LazyPat _ lp' -> lp'
            BangPat _ _   -> lp
-           _             -> cL l (BangPat noExtField lp)
+           _             -> L l (BangPat noExtField lp)
 
 -- | Unconditionally make a 'Pat' strict.
 addBang :: LPat GhcTc -- ^ Original pattern
         -> LPat GhcTc -- ^ Banged pattern
 addBang = go
   where
-    go lp@(dL->L l p)
+    go lp@(L l p)
       = case p of
-           ParPat x p    -> cL l (ParPat x (go p))
-           LazyPat _ lp' -> cL l (BangPat noExtField lp')
+           ParPat x p    -> L l (ParPat x (go p))
+           LazyPat _ lp' -> L l (BangPat noExtField lp')
                                   -- Should we bring the extension value over?
            BangPat _ _   -> lp
-           _             -> cL l (BangPat noExtField lp)
+           _             -> L l (BangPat noExtField lp)
 
 isTrueLHsExpr :: LHsExpr GhcTc -> Maybe (CoreExpr -> DsM CoreExpr)
 
@@ -980,24 +980,24 @@ isTrueLHsExpr :: LHsExpr GhcTc -> Maybe (CoreExpr -> DsM CoreExpr)
 --        * Trivial wappings of these
 -- The arguments to Just are any HsTicks that we have found,
 -- because we still want to tick then, even it they are always evaluated.
-isTrueLHsExpr (dL->L _ (HsVar _ (dL->L _ v)))
+isTrueLHsExpr (L _ (HsVar _ (L _ v)))
   |  v `hasKey` otherwiseIdKey
      || v `hasKey` getUnique trueDataConId
                                               = Just return
         -- trueDataConId doesn't have the same unique as trueDataCon
-isTrueLHsExpr (dL->L _ (HsConLikeOut _ con))
+isTrueLHsExpr (L _ (HsConLikeOut _ con))
   | con `hasKey` getUnique trueDataCon = Just return
-isTrueLHsExpr (dL->L _ (HsTick _ tickish e))
+isTrueLHsExpr (L _ (HsTick _ tickish e))
     | Just ticks <- isTrueLHsExpr e
     = Just (\x -> do wrapped <- ticks x
                      return (Tick tickish wrapped))
    -- This encodes that the result is constant True for Hpc tick purposes;
    -- which is specifically what isTrueLHsExpr is trying to find out.
-isTrueLHsExpr (dL->L _ (HsBinTick _ ixT _ e))
+isTrueLHsExpr (L _ (HsBinTick _ ixT _ e))
     | Just ticks <- isTrueLHsExpr e
     = Just (\x -> do e <- ticks x
                      this_mod <- getModule
                      return (Tick (HpcTick this_mod ixT) e))
 
-isTrueLHsExpr (dL->L _ (HsPar _ e))   = isTrueLHsExpr e
-isTrueLHsExpr _                       = Nothing
+isTrueLHsExpr (L _ (HsPar _ e))   = isTrueLHsExpr e
+isTrueLHsExpr _                   = Nothing
index 33bed3b..ec5238a 100644 (file)
@@ -12,6 +12,7 @@ import GHC.Hs.Binds
 import GHC.Hs.Doc
 import GHC.Hs.Decls
 import GHC.Hs.Extension
+import GHC.Hs.Pat
 import GHC.Hs.Types
 import GHC.Hs.Utils
 import Name
@@ -114,7 +115,8 @@ user-written. This lets us relate Names (from ClsInsts) to comments
 (associated with InstDecls and DerivDecls).
 -}
 
-getMainDeclBinder :: HsDecl (GhcPass p) -> [IdP (GhcPass p)]
+getMainDeclBinder :: XRec pass Pat ~ Located (Pat pass) =>
+                     HsDecl pass -> [IdP pass]
 getMainDeclBinder (TyClD _ d) = [tcdName d]
 getMainDeclBinder (ValD _ d) =
   case collectHsBindBinders d of
@@ -141,13 +143,13 @@ getInstLoc :: InstDecl (GhcPass p) -> SrcSpan
 getInstLoc = \case
   ClsInstD _ (ClsInstDecl { cid_poly_ty = ty }) -> getLoc (hsSigType ty)
   DataFamInstD _ (DataFamInstDecl
-    { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_tycon = (dL->L l _) }}}) -> l
+    { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_tycon = L l _ }}}) -> l
   TyFamInstD _ (TyFamInstDecl
     -- Since CoAxioms' Names refer to the whole line for type family instances
     -- in particular, we need to dig a bit deeper to pull out the entire
     -- equation. This does not happen for data family instances, for some
     -- reason.
-    { tfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = (dL->L l _) }}}) -> l
+    { tfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = L l _ }}}) -> l
   ClsInstD _ (XClsInstDecl _) -> error "getInstLoc"
   DataFamInstD _ (DataFamInstDecl (HsIB _ (XFamEqn _))) -> error "getInstLoc"
   TyFamInstD _ (TyFamInstDecl (HsIB _ (XFamEqn _))) -> error "getInstLoc"
@@ -164,7 +166,7 @@ subordinates :: Map SrcSpan Name
 subordinates instMap decl = case decl of
   InstD _ (ClsInstD _ d) -> do
     DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
-      FamEqn { feqn_tycon = (dL->L l _)
+      FamEqn { feqn_tycon = L l _
              , feqn_rhs   = defn }}} <- unLoc <$> cid_datafam_insts d
     [ (n, [], M.empty) | Just n <- [M.lookup l instMap] ] ++ dataSubs defn
 
@@ -175,7 +177,7 @@ subordinates instMap decl = case decl of
   _ -> []
   where
     classSubs dd = [ (name, doc, declTypeDocs d)
-                   | (dL->L _ d, doc) <- classDecls dd
+                   | (L _ d, doc) <- classDecls dd
                    , name <- getMainDeclBinder d, not (isValD d)
                    ]
     dataSubs :: HsDataDefn GhcRn
@@ -189,8 +191,8 @@ subordinates instMap decl = case decl of
                   | c <- cons, cname <- getConNames c ]
         fields  = [ (extFieldOcc n, maybeToList $ fmap unLoc doc, M.empty)
                   | RecCon flds <- map getConArgs cons
-                  , (dL->L _ (ConDeclField _ ns _ doc)) <- (unLoc flds)
-                  , (dL->L _ n) <- ns ]
+                  , (L _ (ConDeclField _ ns _ doc)) <- (unLoc flds)
+                  , (L _ n) <- ns ]
         derivs  = [ (instName, [unLoc doc], M.empty)
                   | (l, doc) <- mapMaybe (extract_deriv_ty . hsib_body) $
                                 concatMap (unLoc . deriv_clause_tys . unLoc) $
@@ -198,15 +200,15 @@ subordinates instMap decl = case decl of
                   , Just instName <- [M.lookup l instMap] ]
 
         extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString)
-        extract_deriv_ty ty =
-          case dL ty of
+        extract_deriv_ty (L l ty) =
+          case ty of
             -- deriving (forall a. C a {- ^ Doc comment -})
-            L l (HsForAllTy{ hst_fvf = ForallInvis
-                           , hst_body = dL->L _ (HsDocTy _ _ doc) })
-                                  -> Just (l, doc)
+            HsForAllTy{ hst_fvf = ForallInvis
+                      , hst_body = L _ (HsDocTy _ _ doc) }
+                            -> Just (l, doc)
             -- deriving (C a {- ^ Doc comment -})
-            L l (HsDocTy _ _ doc) -> Just (l, doc)
-            _                     -> Nothing
+            HsDocTy _ _ doc -> Just (l, doc)
+            _               -> Nothing
 
 -- | Extract constructor argument docs from inside constructor decls.
 conArgDocs :: ConDecl GhcRn -> Map Int (HsDocString)
index 2e0aeb9..b11a2e2 100644 (file)
@@ -271,7 +271,7 @@ matchView (var:vars) ty (eqns@(eqn1:_))
   = do  { -- we could pass in the expr from the PgView,
          -- but this needs to extract the pat anyway
          -- to figure out the type of the fresh variable
-         let ViewPat _ viewExpr (dL->L _ pat) = firstPat eqn1
+         let ViewPat _ viewExpr (L _ pat) = firstPat eqn1
          -- do the rest of the compilation
         ; let pat_ty' = hsPatType pat
         ; var' <- newUniqueId var pat_ty'
@@ -407,16 +407,16 @@ tidy1 :: Id                  -- The Id being scrutinised
 tidy1 v o (ParPat _ pat)      = tidy1 v o (unLoc pat)
 tidy1 v o (SigPat _ pat _)    = tidy1 v o (unLoc pat)
 tidy1 _ _ (WildPat ty)        = return (idDsWrapper, WildPat ty)
-tidy1 v o (BangPat _ (dL->L l p)) = tidy_bang_pat v o l p
+tidy1 v o (BangPat _ (L l p)) = tidy_bang_pat v o l p
 
         -- case v of { x -> mr[] }
         -- = case v of { _ -> let x=v in mr[] }
-tidy1 v _ (VarPat _ (dL->L _ var))
+tidy1 v _ (VarPat _ (L _ var))
   = return (wrapBind var v, WildPat (idType var))
 
         -- case v of { x@p -> mr[] }
         -- = case v of { p -> let x=v in mr[] }
-tidy1 v o (AsPat _ (dL->L _ var) pat)
+tidy1 v o (AsPat _ (L _ var) pat)
   = do  { (wrap, pat') <- tidy1 v o (unLoc pat)
         ; return (wrapBind var v . wrap, pat') }
 
@@ -472,7 +472,7 @@ tidy1 _ o (LitPat _ lit)
        ; return (idDsWrapper, tidyLitPat lit) }
 
 -- NPats: we *might* be able to replace these w/ a simpler form
-tidy1 _ o (NPat ty (dL->L _ lit@OverLit { ol_val = v }) mb_neg eq)
+tidy1 _ o (NPat ty (L _ lit@OverLit { ol_val = v }) mb_neg eq)
   = do { unless (isGenerated o) $
            let lit' | Just _ <- mb_neg = lit{ ol_val = negateOverLitVal v }
                     | otherwise = lit
@@ -480,7 +480,7 @@ tidy1 _ o (NPat ty (dL->L _ lit@OverLit { ol_val = v }) mb_neg eq)
        ; return (idDsWrapper, tidyNPat lit mb_neg eq ty) }
 
 -- NPlusKPat: we may want to warn about the literals
-tidy1 _ o n@(NPlusKPat _ _ (dL->L _ lit1) lit2 _ _)
+tidy1 _ o n@(NPlusKPat _ _ (L _ lit1) lit2 _ _)
   = do { unless (isGenerated o) $ do
            warnAboutOverflowedOverLit lit1
            warnAboutOverflowedOverLit lit2
@@ -495,15 +495,15 @@ tidy_bang_pat :: Id -> Origin -> SrcSpan -> Pat GhcTc
               -> DsM (DsWrapper, Pat GhcTc)
 
 -- Discard par/sig under a bang
-tidy_bang_pat v o _ (ParPat _ (dL->L l p)) = tidy_bang_pat v o l p
-tidy_bang_pat v o _ (SigPat _ (dL->L l p) _) = tidy_bang_pat v o l p
+tidy_bang_pat v o _ (ParPat _ (L l p)) = tidy_bang_pat v o l p
+tidy_bang_pat v o _ (SigPat _ (L l p) _) = tidy_bang_pat v o l p
 
 -- Push the bang-pattern inwards, in the hope that
 -- it may disappear next time
 tidy_bang_pat v o l (AsPat x v' p)
-  = tidy1 v o (AsPat x v' (cL l (BangPat noExtField p)))
+  = tidy1 v o (AsPat x v' (L l (BangPat noExtField p)))
 tidy_bang_pat v o l (CoPat x w p t)
-  = tidy1 v o (CoPat x w (BangPat noExtField (cL l p)) t)
+  = tidy1 v o (CoPat x w (BangPat noExtField (L l p)) t)
 
 -- Discard bang around strict pattern
 tidy_bang_pat v o _ p@(LitPat {})    = tidy1 v o p
@@ -512,7 +512,7 @@ tidy_bang_pat v o _ p@(TuplePat {})  = tidy1 v o p
 tidy_bang_pat v o _ p@(SumPat {})    = tidy1 v o p
 
 -- Data/newtype constructors
-tidy_bang_pat v o l p@(ConPatOut { pat_con = (dL->L _ (RealDataCon dc))
+tidy_bang_pat v o l p@(ConPatOut { pat_con = L _ (RealDataCon dc)
                                  , pat_args = args
                                  , pat_arg_tys = arg_tys })
   -- Newtypes: push bang inwards (#9844)
@@ -538,7 +538,7 @@ tidy_bang_pat v o l p@(ConPatOut { pat_con = (dL->L _ (RealDataCon dc))
 --
 -- NB: SigPatIn, ConPatIn should not happen
 
-tidy_bang_pat _ _ l p = return (idDsWrapper, BangPat noExtField (cL l p))
+tidy_bang_pat _ _ l p = return (idDsWrapper, BangPat noExtField (L l p))
 
 -------------------
 push_bang_into_newtype_arg :: SrcSpan
@@ -549,16 +549,16 @@ push_bang_into_newtype_arg :: SrcSpan
 -- We are transforming   !(N p)   into   (N !p)
 push_bang_into_newtype_arg l _ty (PrefixCon (arg:args))
   = ASSERT( null args)
-    PrefixCon [cL l (BangPat noExtField arg)]
+    PrefixCon [L l (BangPat noExtField arg)]
 push_bang_into_newtype_arg l _ty (RecCon rf)
-  | HsRecFields { rec_flds = (dL->L lf fld) : flds } <- rf
+  | HsRecFields { rec_flds = L lf fld : flds } <- rf
   , HsRecField { hsRecFieldArg = arg } <- fld
   = ASSERT( null flds)
-    RecCon (rf { rec_flds = [cL lf (fld { hsRecFieldArg
-                                           = cL l (BangPat noExtField arg) })] })
+    RecCon (rf { rec_flds = [L lf (fld { hsRecFieldArg
+                                           = L l (BangPat noExtField arg) })] })
 push_bang_into_newtype_arg l ty (RecCon rf) -- If a user writes !(T {})
   | HsRecFields { rec_flds = [] } <- rf
-  = PrefixCon [cL l (BangPat noExtField (noLoc (WildPat ty)))]
+  = PrefixCon [L l (BangPat noExtField (noLoc (WildPat ty)))]
 push_bang_into_newtype_arg _ _ cd
   = pprPanic "push_bang_into_newtype_arg" (pprConArgs cd)
 
@@ -724,7 +724,7 @@ one pattern, and match simply only accepts one pattern.
 JJQC 30-Nov-1997
 -}
 
-matchWrapper ctxt mb_scr (MG { mg_alts = (dL->L _ matches)
+matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches
                              , mg_ext = MatchGroupTc arg_tys rhs_ty
                              , mg_origin = origin })
   = do  { dflags <- getDynFlags
@@ -747,7 +747,7 @@ matchWrapper ctxt mb_scr (MG { mg_alts = (dL->L _ matches)
         ; return (new_vars, result_expr) }
   where
     -- Called once per equation in the match, or alternative in the case
-    mk_eqn_info vars (dL->L _ (Match { m_pats = pats, m_grhss = grhss }))
+    mk_eqn_info vars (L _ (Match { m_pats = pats, m_grhss = grhss }))
       = do { dflags <- getDynFlags
            ; let upats = map (unLoc . decideBangHood dflags) pats
                  dicts = collectEvVarsPats upats
@@ -763,8 +763,7 @@ matchWrapper ctxt mb_scr (MG { mg_alts = (dL->L _ matches)
            ; return (EqnInfo { eqn_pats = upats
                              , eqn_orig = FromSource
                              , eqn_rhs = match_result }) }
-    mk_eqn_info _ (dL->L _ (XMatch nec)) = noExtCon nec
-    mk_eqn_info _ _  = panic "mk_eqn_info: Impossible Match" -- due to #15884
+    mk_eqn_info _ (L _ (XMatch nec)) = noExtCon nec
 
     handleWarnings = if isGenerated origin
                      then discardWarningsDs
@@ -1004,8 +1003,8 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
     exp :: HsExpr GhcTc -> HsExpr GhcTc -> Bool
     -- real comparison is on HsExpr's
     -- strip parens
-    exp (HsPar _ (dL->L _ e)) e'   = exp e e'
-    exp e (HsPar _ (dL->L _ e'))   = exp e e'
+    exp (HsPar _ (L _ e)) e'   = exp e e'
+    exp e (HsPar _ (L _ e'))   = exp e e'
     -- because the expressions do not necessarily have the same type,
     -- we have to compare the wrappers
     exp (HsWrap _ h e) (HsWrap _ h' e') = wrap h h' && exp e e'
@@ -1058,8 +1057,8 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
         wrap res_wrap1 res_wrap2
 
     ---------
-    tup_arg (dL->L _ (Present _ e1)) (dL->L _ (Present _ e2)) = lexp e1 e2
-    tup_arg (dL->L _ (Missing t1))   (dL->L _ (Missing t2))   = eqType t1 t2
+    tup_arg (L _ (Present _ e1)) (L _ (Present _ e2)) = lexp e1 e2
+    tup_arg (L _ (Missing t1))   (L _ (Missing t2))   = eqType t1 t2
     tup_arg _ _ = False
 
     ---------
@@ -1094,13 +1093,13 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
     eq_list eq (x:xs) (y:ys) = eq x y && eq_list eq xs ys
 
 patGroup :: DynFlags -> Pat GhcTc -> PatGroup
-patGroup _ (ConPatOut { pat_con = (dL->L _ con)
+patGroup _ (ConPatOut { pat_con = L _ con
                       , pat_arg_tys = tys })
  | RealDataCon dcon <- con              = PgCon dcon
  | PatSynCon psyn <- con                = PgSyn psyn tys
 patGroup _ (WildPat {})                 = PgAny
 patGroup _ (BangPat {})                 = PgBang
-patGroup _ (NPat _ (dL->L _ (OverLit {ol_val=oval})) mb_neg _) =
+patGroup _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) =
   case (oval, isJust mb_neg) of
    (HsIntegral   i, False) -> PgN (fromInteger (il_value i))
    (HsIntegral   i, True ) -> PgN (-fromInteger (il_value i))
@@ -1108,7 +1107,7 @@ patGroup _ (NPat _ (dL->L _ (OverLit {ol_val=oval})) mb_neg _) =
    (HsFractional r, True ) -> PgN (-fl_value r)
    (HsIsString _ s, _) -> ASSERT(isNothing mb_neg)
                           PgOverS s
-patGroup _ (NPlusKPat _ _ (dL->L _ (OverLit {ol_val=oval})) _ _ _) =
+patGroup _ (NPlusKPat _ _ (L _ (OverLit {ol_val=oval})) _ _ _) =
   case oval of
    HsIntegral i -> PgNpK (il_value i)
    _ -> pprPanic "patGroup NPlusKPat" (ppr oval)
index be65433..43d71ac 100644 (file)
@@ -170,7 +170,7 @@ matchOneConLike vars ty (eqn1 : eqns)   -- All eqns for a single constructor
                               alt_wrapper = wrapper1,
                               alt_result = foldr1 combineMatchResults match_results } }
   where
-    ConPatOut { pat_con = (dL->L _ con1)
+    ConPatOut { pat_con = L _ con1
               , pat_arg_tys = arg_tys, pat_wrap = wrapper1,
                 pat_tvs = tvs1, pat_dicts = dicts1, pat_args = args1 }
               = firstPat eqn1
@@ -192,7 +192,7 @@ matchOneConLike vars ty (eqn1 : eqns)   -- All eqns for a single constructor
       = arg_vars
       where
         fld_var_env = mkNameEnv $ zipEqual "get_arg_vars" fields1 arg_vars
-        lookup_fld (dL->L _ rpat) = lookupNameEnv_NF fld_var_env
+        lookup_fld (L _ rpat) = lookupNameEnv_NF fld_var_env
                                             (idName (unLoc (hsRecFieldId rpat)))
     select_arg_vars _ [] = panic "matchOneCon/select_arg_vars []"
 matchOneConLike _ _ [] = panic "matchOneCon []"
@@ -209,7 +209,7 @@ compatible_pats _                 _                 = True -- Prefix or infix co
 same_fields :: HsRecFields GhcTc (LPat GhcTc) -> HsRecFields GhcTc (LPat GhcTc)
             -> Bool
 same_fields flds1 flds2
-  = all2 (\(dL->L _ f1) (dL->L _ f2)
+  = all2 (\(L _ f1) (L _ f2)
                           -> unLoc (hsRecFieldId f1) == unLoc (hsRecFieldId f2))
          (rec_flds flds1) (rec_flds flds2)
 
index 126346b..4f65362 100644 (file)
@@ -288,11 +288,11 @@ warnAboutEmptyEnumerations dflags fromExpr mThnExpr toExpr
 getLHsIntegralLit :: LHsExpr GhcTc -> Maybe (Integer, Name)
 -- ^ See if the expression is an 'Integral' literal.
 -- Remember to look through automatically-added tick-boxes! (#8384)
-getLHsIntegralLit (dL->L _ (HsPar _ e))            = getLHsIntegralLit e
-getLHsIntegralLit (dL->L _ (HsTick _ _ e))         = getLHsIntegralLit e
-getLHsIntegralLit (dL->L _ (HsBinTick _ _ _ e))    = getLHsIntegralLit e
-getLHsIntegralLit (dL->L _ (HsOverLit _ over_lit)) = getIntegralLit over_lit
-getLHsIntegralLit (dL->L _ (HsLit _ lit))          = getSimpleIntegralLit lit
+getLHsIntegralLit (L _ (HsPar _ e))            = getLHsIntegralLit e
+getLHsIntegralLit (L _ (HsTick _ _ e))         = getLHsIntegralLit e
+getLHsIntegralLit (L _ (HsBinTick _ _ _ e))    = getLHsIntegralLit e
+getLHsIntegralLit (L _ (HsOverLit _ over_lit)) = getIntegralLit over_lit
+getLHsIntegralLit (L _ (HsLit _ lit))          = getSimpleIntegralLit lit
 getLHsIntegralLit _ = Nothing
 
 -- | If 'Integral', extract the value and type name of the overloaded literal.
@@ -469,7 +469,7 @@ hsLitKey _      l                  = pprPanic "hsLitKey" (ppr l)
 
 matchNPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
 matchNPats (var:vars) ty (eqn1:eqns)    -- All for the same literal
-  = do  { let NPat _ (dL->L _ 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
@@ -500,7 +500,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 _ (dL->L _ n1) (dL->L _ lit1) lit2 ge minus
+  = do  { let NPlusKPat _ (L _ n1) (L _ lit1) lit2 ge minus
                 = firstPat eqn1
         ; lit1_expr   <- dsOverLit lit1
         ; lit2_expr   <- dsOverLit lit2
@@ -513,7 +513,7 @@ matchNPlusKPats (var:vars) ty (eqn1:eqns)
                    adjustMatchResult (foldr1 (.) wraps)         $
                    match_result) }
   where
-    shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (dL->L _ n) _ _ _ _ : pats })
+    shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (L _ n) _ _ _ _ : pats })
         = (wrapBind n n1, eqn { eqn_pats = pats })
         -- The wrapBind is a no-op for the first equation
     shift _ e = pprPanic "matchNPlusKPats/shift" (ppr e)
index 40bb914..e77dcd3 100644 (file)
@@ -374,8 +374,8 @@ patScopes
   -> [LPat (GhcPass p)]
   -> [PScoped (LPat (GhcPass p))]
 patScopes rsp useScope patScope xs =
-  map (\(RS sc a) -> PS rsp useScope sc (composeSrcSpan a)) $
-    listScopes patScope (map dL xs)
+  map (\(RS sc a) -> PS rsp useScope sc a) $
+    listScopes patScope xs
 
 -- | 'listScopes' specialised to 'TVScoped' things
 tvScopes
@@ -579,10 +579,10 @@ instance HasType (LHsBind GhcTc) where
       _ -> makeNode bind spn
 
 instance HasType (Located (Pat GhcRn)) where
-  getTypeNode (dL -> L spn pat) = makeNode pat spn
+  getTypeNode (L spn pat) = makeNode pat spn
 
 instance HasType (Located (Pat GhcTc)) where
-  getTypeNode (dL -> L spn opat) = makeTypeNode opat spn (hsPatType opat)
+  getTypeNode (L spn opat) = makeTypeNode opat spn (hsPatType opat)
 
 instance HasType (LHsExpr GhcRn) where
   getTypeNode (L spn e) = makeNode e spn
@@ -766,7 +766,7 @@ instance ( a ~ GhcPass p
          , HasType (LPat a)
          , Data (HsSplice a)
          ) => ToHie (PScoped (Located (Pat (GhcPass p)))) where
-  toHie (PS rsp scope pscope lpat@(dL -> L ospan opat)) =
+  toHie (PS rsp scope pscope lpat@(L ospan opat)) =
     concatM $ getTypeNode lpat : case opat of
       WildPat _ ->
         []
@@ -778,7 +778,7 @@ instance ( a ~ GhcPass p
         ]
       AsPat _ lname pat ->
         [ toHie $ C (PatternBind scope
-                                 (combineScopes (mkLScope (dL pat)) pscope)
+                                 (combineScopes (mkLScope pat) pscope)
                                  rsp)
                     lname
         , toHie $ PS rsp scope pscope pat
@@ -822,7 +822,7 @@ instance ( a ~ GhcPass p
         ]
       SigPat _ pat sig ->
         [ toHie $ PS rsp scope pscope pat
-        , let cscope = mkLScope (dL pat) in
+        , let cscope = mkLScope pat in
             toHie $ TS (ResolvedScopes [cscope, scope, pscope])
                        (protectSig @a cscope sig)
               -- See Note [Scoping Rules for SigPat]
index 53c7680..80131c6 100644 (file)
@@ -257,9 +257,6 @@ module GHC (
         getLoc, unLoc,
         getRealSrcSpan, unRealSrcSpan,
 
-        -- ** HasSrcSpan
-        HasSrcSpan(..), SrcSpanLess, dL, cL,
-
         -- *** Combining and comparing Located values
         eqLocated, cmpLocated, combineLocs, addCLoc,
         leftmost_smallest, leftmost_largest, rightmost,
@@ -1392,7 +1389,7 @@ getRichTokenStream mod = do
 addSourceToTokens :: RealSrcLoc -> StringBuffer -> [Located Token]
                   -> [(Located Token, String)]
 addSourceToTokens _ _ [] = []
-addSourceToTokens loc buf (t@(dL->L span _) : ts)
+addSourceToTokens loc buf (t@(L span _) : ts)
     = case span of
       UnhelpfulSpan _ -> (t,"") : addSourceToTokens loc buf ts
       RealSrcSpan s   -> (t,str) : addSourceToTokens newLoc newBuf ts
@@ -1418,7 +1415,7 @@ showRichTokenStream ts = go startLoc ts ""
           getFile (RealSrcSpan s : _) = srcSpanFile s
           startLoc = mkRealSrcLoc sourceFile 1 1
           go _ [] = id
-          go loc ((dL->L span _, str):ts)
+          go loc ((L span _, str):ts)
               = case span of
                 UnhelpfulSpan _ -> go loc ts
                 RealSrcSpan s
index bd98461..9636159 100644 (file)
@@ -85,7 +85,7 @@ getImports dflags buf filename source_filename = do
                 imps = hsmodImports hsmod
                 main_loc = srcLocSpan (mkSrcLoc (mkFastString source_filename)
                                        1 1)
-                mod = mb_mod `orElse` cL main_loc mAIN_NAME
+                mod = mb_mod `orElse` L main_loc mAIN_NAME
                 (src_idecls, ord_idecls) = partition (ideclSource.unLoc) imps
 
                -- GHC.Prim doesn't exist physically, so don't go looking for it.
@@ -96,8 +96,7 @@ getImports dflags buf filename source_filename = do
                 implicit_prelude = xopt LangExt.ImplicitPrelude dflags
                 implicit_imports = mkPrelImports (unLoc mod) main_loc
                                                  implicit_prelude imps
-                convImport (dL->L _ i) = (fmap sl_fs (ideclPkgQual i)
-                                         , ideclName i)
+                convImport (L _ i) = (fmap sl_fs (ideclPkgQual i), ideclName i)
               in
               return (map convImport src_idecls,
                       map convImport (implicit_imports ++ ordinary_imps),
@@ -120,23 +119,23 @@ mkPrelImports this_mod loc implicit_prelude import_decls
   | otherwise = [preludeImportDecl]
   where
       explicit_prelude_import
-       = notNull [ () | (dL->L _ (ImportDecl { ideclName = mod
-                                        , ideclPkgQual = Nothing }))
+       = notNull [ () | L _ (ImportDecl { ideclName = mod
+                                        , ideclPkgQual = Nothing })
                           <- import_decls
                       , unLoc mod == pRELUDE_NAME ]
 
       preludeImportDecl :: LImportDecl GhcPs
       preludeImportDecl
-        = cL loc $ ImportDecl { ideclExt       = noExtField,
-                                ideclSourceSrc = NoSourceText,
-                                ideclName      = cL loc pRELUDE_NAME,
-                                ideclPkgQual   = Nothing,
-                                ideclSource    = False,
-                                ideclSafe      = False,  -- Not a safe import
-                                ideclQualified = NotQualified,
-                                ideclImplicit  = True,   -- Implicit!
-                                ideclAs        = Nothing,
-                                ideclHiding    = Nothing  }
+        = L loc $ ImportDecl { ideclExt       = noExtField,
+                               ideclSourceSrc = NoSourceText,
+                               ideclName      = L loc pRELUDE_NAME,
+                               ideclPkgQual   = Nothing,
+                               ideclSource    = False,
+                               ideclSafe      = False,  -- Not a safe import
+                               ideclQualified = NotQualified,
+                               ideclImplicit  = True,   -- Implicit!
+                               ideclAs        = Nothing,
+                               ideclHiding    = Nothing  }
 
 --------------------------------------------------------------
 -- Get options
@@ -192,7 +191,7 @@ lazyGetToks dflags filename handle = do
                   _other -> do rest <- lazyLexBuf handle state' eof size
                                return (t : rest)
       _ | not eof   -> getMore handle state size
-        | otherwise -> return [cL (RealSrcSpan (last_loc state)) ITeof]
+        | otherwise -> return [L (RealSrcSpan (last_loc state)) ITeof]
                          -- parser assumes an ITeof sentinel at the end
 
   getMore :: Handle -> PState -> Int -> IO [Located Token]
@@ -214,9 +213,9 @@ getToks dflags filename buf = lexAll (pragState dflags buf loc)
   loc  = mkRealSrcLoc (mkFastString filename) 1 1
 
   lexAll state = case unP (lexer False return) state of
-                   POk _      t@(dL->L _ ITeof) -> [t]
+                   POk _      t@(L _ ITeof) -> [t]
                    POk state' t -> t : lexAll state'
-                   _ -> [cL (RealSrcSpan (last_loc state)) ITeof]
+                   _ -> [L (RealSrcSpan (last_loc state)) ITeof]
 
 
 -- | Parse OPTIONS and LANGUAGE pragmas of the source file.
@@ -245,16 +244,16 @@ getOptions' dflags toks
               = case toArgs str of
                   Left _err -> optionsParseError str dflags $   -- #15053
                                  combineSrcSpans (getLoc open) (getLoc close)
-                  Right args -> map (cL (getLoc open)) args ++ parseToks xs
+                  Right args -> map (L (getLoc open)) args ++ parseToks xs
           parseToks (open:close:xs)
               | ITinclude_prag str <- unLoc open
               , ITclose_prag       <- unLoc close
-              = map (cL (getLoc open)) ["-#include",removeSpaces str] ++
+              = map (L (getLoc open)) ["-#include",removeSpaces str] ++
                 parseToks xs
           parseToks (open:close:xs)
               | ITdocOptions str <- unLoc open
               , ITclose_prag     <- unLoc close
-              = map (cL (getLoc open)) ["-haddock-opts", removeSpaces str]
+              = map (L (getLoc open)) ["-haddock-opts", removeSpaces str]
                 ++ parseToks xs
           parseToks (open:xs)
               | ITlanguage_prag <- unLoc open
@@ -263,12 +262,12 @@ getOptions' dflags toks
               | isComment (unLoc comment)
               = parseToks xs
           parseToks _ = []
-          parseLanguage ((dL->L loc (ITconid fs)):rest)
-              = checkExtension dflags (cL loc fs) :
+          parseLanguage ((L loc (ITconid fs)):rest)
+              = checkExtension dflags (L loc fs) :
                 case rest of
-                  (dL->L _loc ITcomma):more -> parseLanguage more
-                  (dL->L _loc ITclose_prag):more -> parseToks more
-                  (dL->L loc _):_ -> languagePragParseError dflags loc
+                  (L _loc ITcomma):more -> parseLanguage more
+                  (L _loc ITclose_prag):more -> parseToks more
+                  (L loc _):_ -> languagePragParseError dflags loc
                   [] -> panic "getOptions'.parseLanguage(1) went past eof token"
           parseLanguage (tok:_)
               = languagePragParseError dflags (getLoc tok)
@@ -296,7 +295,7 @@ checkProcessArgsResult :: MonadIO m => DynFlags -> [Located String] -> m ()
 checkProcessArgsResult dflags flags
   = when (notNull flags) $
       liftIO $ throwIO $ mkSrcErr $ listToBag $ map mkMsg flags
-    where mkMsg (dL->L loc flag)
+    where mkMsg (L loc flag)
               = mkPlainErrMsg dflags loc $
                   (text "unknown flag in  {-# OPTIONS_GHC #-} pragma:" <+>
                    text flag)
@@ -304,11 +303,11 @@ checkProcessArgsResult dflags flags
 -----------------------------------------------------------------------------
 
 checkExtension :: DynFlags -> Located FastString -> Located String
-checkExtension dflags (dL->L l ext)
+checkExtension dflags (L l ext)
 -- Checks if a given extension is valid, and if so returns
 -- its corresponding flag. Otherwise it throws an exception.
   = if ext' `elem` supported
-    then cL l ("-X"++ext')
+    then L l ("-X"++ext')
     else unsupportedExtnError dflags l ext'
   where
     ext' = unpackFS ext
@@ -336,11 +335,11 @@ optionsErrorMsgs :: DynFlags -> [String] -> [Located String] -> FilePath -> Mess
 optionsErrorMsgs dflags unhandled_flags flags_lines _filename
   = (emptyBag, listToBag (map mkMsg unhandled_flags_lines))
   where unhandled_flags_lines :: [Located String]
-        unhandled_flags_lines = [ cL l f
+        unhandled_flags_lines = [ L l f
                                 | f <- unhandled_flags
-                                , (dL->L l f') <- flags_lines
+                                , L l f' <- flags_lines
                                 , f == f' ]
-        mkMsg (dL->L flagSpan flag) =
+        mkMsg (L flagSpan flag) =
             ErrUtils.mkPlainErrMsg dflags flagSpan $
                     text "unknown flag in  {-# OPTIONS_GHC #-} pragma:" <+> text flag
 
index 27f1922..a5072a7 100644 (file)
@@ -22,7 +22,7 @@ import Data.Char
 
 -- | Source Statistics
 ppSourceStats :: Bool -> Located (HsModule GhcPs) -> SDoc
-ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))
+ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _))
   = (if short then hcat else vcat)
         (map pp_val
             [("ExportAll        ", export_all), -- 1 if no export list
@@ -84,7 +84,7 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))
     default_ds = count (\ x -> case x of { DefD{} -> True; _ -> False}) decls
     val_decls  = [d | ValD _ d <- decls]
 
-    real_exports = case exports of { Nothing -> []; Just (dL->L _ es) -> es }
+    real_exports = case exports of { Nothing -> []; Just (L _ es) -> es }
     n_exports    = length real_exports
     export_ms    = count (\ e -> case unLoc e of { IEModuleContents{} -> True
                                                  ; _ -> False})
@@ -104,7 +104,7 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))
     (inst_method_ds, method_specs, method_inlines, inst_type_ds, inst_data_ds)
         = sum5 (map inst_info inst_decls)
 
-    count_bind (PatBind { pat_lhs = (dL->L _ (VarPat{})) }) = (1,0,0)
+    count_bind (PatBind { pat_lhs = L _ (VarPat{}) }) = (1,0,0)
     count_bind (PatBind {})                           = (0,1,0)
     count_bind (FunBind {})                           = (0,1,0)
     count_bind (PatSynBind {})                        = (0,0,1)
@@ -119,12 +119,10 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))
     sig_info (ClassOpSig {}) = (0,0,0,0,1)
     sig_info _               = (0,0,0,0,0)
 
-    import_info (dL->L _ (ImportDecl { ideclSafe = safe, ideclQualified = qual
-                                     , ideclAs = as, ideclHiding = spec }))
+    import_info (L _ (ImportDecl { ideclSafe = safe, ideclQualified = qual
+                                 , ideclAs = as, ideclHiding = spec }))
         = add7 (1, safe_info safe, qual_info qual, as_info as, 0,0,0) (spec_info spec)
-    import_info (dL->L _ (XImportDecl nec)) = noExtCon nec
-    import_info _ = panic " import_info: Impossible Match"
-                             -- due to #15884
+    import_info (L _ (XImportDecl nec)) = noExtCon nec
 
     safe_info False = 0
     safe_info True = 1
@@ -138,7 +136,7 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))
 
     data_info (DataDecl { tcdDataDefn = HsDataDefn
                                           { dd_cons = cs
-                                          , dd_derivs = (dL->L _ derivs)}})
+                                          , dd_derivs = L _ derivs}})
         = ( length cs
           , foldl' (\s dc -> length (deriv_clause_tys $ unLoc dc) + s)
                    0 derivs )
index 3a5a0bb..d1e0603 100644 (file)
@@ -386,7 +386,7 @@ handleFlagWarnings dflags warns = do
       -- It would be nicer if warns :: [Located MsgDoc], but that
       -- has circular import problems.
       bag = listToBag [ mkPlainWarnMsg dflags loc (text warn)
-                      | Warn _ (dL->L loc warn) <- warns' ]
+                      | Warn _ (L loc warn) <- warns' ]
 
   printOrThrowWarnings dflags bag
 
index 01d2424..3a6ab1b 100644 (file)
@@ -760,7 +760,7 @@ unitdecl :: { LHsUnitDecl PackageName }
 signature :: { Located (HsModule GhcPs) }
        : maybedocheader 'signature' modid maybemodwarning maybeexports 'where' body
              {% fileSrcSpan >>= \ loc ->
-                ams (cL loc (HsModule (Just $3) $5 (fst $ snd $7)
+                ams (L loc (HsModule (Just $3) $5 (fst $ snd $7)
                               (snd $ snd $7) $4 $1)
                     )
                     ([mj AnnSignature $2, mj AnnWhere $6] ++ fst $7) }
@@ -768,13 +768,13 @@ signature :: { Located (HsModule GhcPs) }
 module :: { Located (HsModule GhcPs) }
        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' body
              {% fileSrcSpan >>= \ loc ->
-                ams (cL loc (HsModule (Just $3) $5 (fst $ snd $7)
+                ams (L loc (HsModule (Just $3) $5 (fst $ snd $7)
                               (snd $ snd $7) $4 $1)
                     )
                     ([mj AnnModule $2, mj AnnWhere $6] ++ fst $7) }
         | body2
                 {% fileSrcSpan >>= \ loc ->
-                   ams (cL loc (HsModule Nothing Nothing
+                   ams (L loc (HsModule Nothing Nothing
                                (fst $ snd $1) (snd $ snd $1) Nothing Nothing))
                        (fst $1) }
 
@@ -825,15 +825,15 @@ top1    :: { ([LImportDecl GhcPs], [LHsDecl GhcPs]) }
 header  :: { Located (HsModule GhcPs) }
         : maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body
                 {% fileSrcSpan >>= \ loc ->
-                   ams (cL loc (HsModule (Just $3) $5 $7 [] $4 $1
+                   ams (L loc (HsModule (Just $3) $5 $7 [] $4 $1
                           )) [mj AnnModule $2,mj AnnWhere $6] }
         | maybedocheader 'signature' modid maybemodwarning maybeexports 'where' header_body
                 {% fileSrcSpan >>= \ loc ->
-                   ams (cL loc (HsModule (Just $3) $5 $7 [] $4 $1
+                   ams (L loc (HsModule (Just $3) $5 $7 [] $4 $1
                           )) [mj AnnModule $2,mj AnnWhere $6] }
         | header_body2
                 {% fileSrcSpan >>= \ loc ->
-                   return (cL loc (HsModule Nothing Nothing $1 [] Nothing
+                   return (L loc (HsModule Nothing Nothing $1 [] Nothing
                           Nothing)) }
 
 header_body :: { [LImportDecl GhcPs] }
@@ -905,7 +905,7 @@ qcnames :: { ([AddAnn], [Located ImpExpQcSpec]) }
 
 qcnames1 :: { ([AddAnn], [Located ImpExpQcSpec]) }     -- A reversed list
         :  qcnames1 ',' qcname_ext_w_wildcard  {% case (head (snd $1)) of
-                                                    l@(dL->L _ ImpExpQcWildcard) ->
+                                                    l@(L _ ImpExpQcWildcard) ->
                                                        return ([mj AnnComma $2, mj AnnDotdot l]
                                                                ,(snd (unLoc $3)  : snd $1))
                                                     l -> (ams (head (snd $1)) [mj AnnComma $2] >>
@@ -967,7 +967,7 @@ importdecl :: { LImportDecl GhcPs }
         : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec
                 {% do {
                   ; checkImportDecl $4 $7
-                  ; ams (cL (comb4 $1 $6 (snd $8) $9) $
+                  ; ams (L (comb4 $1 $6 (snd $8) $9) $
                       ImportDecl { ideclExt = noExtField
                                   , ideclSourceSrc = snd $ fst $2
                                   , ideclName = $6, ideclPkgQual = snd $5
@@ -1014,7 +1014,7 @@ maybeimpspec :: { Located (Maybe (Bool, Located [LIE GhcPs])) }
         : impspec                  {% let (b, ie) = unLoc $1 in
                                        checkImportSpec ie
                                         >>= \checkedIe ->
-                                          return (cL (gl $1) (Just (b, checkedIe)))  }
+                                          return (L (gl $1) (Just (b, checkedIe)))  }
         | {- empty -}              { noLoc Nothing }
 
 impspec :: { Located (Bool, Located [LIE GhcPs]) }
@@ -1163,7 +1163,7 @@ inst_decl :: { LInstDecl GhcPs }
                                      , cid_tyfam_insts = ats
                                      , cid_overlap_mode = $2
                                      , cid_datafam_insts = adts }
-             ; ams (cL (comb3 $1 (hsSigType $3) $4) (ClsInstD { cid_d_ext = noExtField, cid_inst = cid }))
+             ; ams (L (comb3 $1 (hsSigType $3) $4) (ClsInstD { cid_d_ext = noExtField, cid_inst = cid }))
                    (mj AnnInstance $1 : (fst $ unLoc $4)) } }
 
            -- type instance declarations
@@ -1250,24 +1250,24 @@ where_type_family :: { Located ([AddAnn],FamilyInfo GhcPs) }
 ty_fam_inst_eqn_list :: { Located ([AddAnn],Maybe [LTyFamInstEqn GhcPs]) }
         :     '{' ty_fam_inst_eqns '}'     { sLL $1 $> ([moc $1,mcc $3]
                                                 ,Just (unLoc $2)) }
-        | vocurly ty_fam_inst_eqns close   { let (dL->L loc _) = $2 in
-                                             cL loc ([],Just (unLoc $2)) }
+        | vocurly ty_fam_inst_eqns close   { let (L loc _) = $2 in
+                                             L loc ([],Just (unLoc $2)) }
         |     '{' '..' '}'                 { sLL $1 $> ([moc $1,mj AnnDotdot $2
                                                  ,mcc $3],Nothing) }
-        | vocurly '..' close               { let (dL->L loc _) = $2 in
-                                             cL loc ([mj AnnDotdot $2],Nothing) }
+        | vocurly '..' close               { let (L loc _) = $2 in
+                                             L loc ([mj AnnDotdot $2],Nothing) }
 
 ty_fam_inst_eqns :: { Located [LTyFamInstEqn GhcPs] }
         : ty_fam_inst_eqns ';' ty_fam_inst_eqn
-                                      {% let (dL->L loc (anns, eqn)) = $3 in
-                                         asl (unLoc $1) $2 (cL loc eqn)
+                                      {% let (L loc (anns, eqn)) = $3 in
+                                         asl (unLoc $1) $2 (L loc eqn)
                                          >> ams $3 anns
-                                         >> return (sLL $1 $> (cL loc eqn : unLoc $1)) }
+                                         >> return (sLL $1 $> (L loc eqn : unLoc $1)) }
         | ty_fam_inst_eqns ';'        {% addAnnotation (gl $1) AnnSemi (gl $2)
                                          >> return (sLL $1 $>  (unLoc $1)) }
-        | ty_fam_inst_eqn             {% let (dL->L loc (anns, eqn)) = $1 in
+        | ty_fam_inst_eqn             {% let (L loc (anns, eqn)) = $1 in
                                          ams $1 anns
-                                         >> return (sLL $1 $> [cL loc eqn]) }
+                                         >> return (sLL $1 $> [L loc eqn]) }
         | {- empty -}                 { noLoc [] }
 
 ty_fam_inst_eqn :: { Located ([AddAnn],TyFamInstEqn GhcPs) }
@@ -1504,7 +1504,7 @@ where_decls :: { Located ([AddAnn]
                          , Located (OrdList (LHsDecl GhcPs))) }
         : 'where' '{' decls '}'       { sLL $1 $> ((mj AnnWhere $1:moc $2
                                            :mcc $4:(fst $ unLoc $3)),sL1 $3 (snd $ unLoc $3)) }
-        | 'where' vocurly decls close { cL (comb2 $1 $3) ((mj AnnWhere $1:(fst $ unLoc $3))
+        | 'where' vocurly decls close { L (comb2 $1 $3) ((mj AnnWhere $1:(fst $ unLoc $3))
                                           ,sL1 $3 (snd $ unLoc $3)) }
 
 pattern_synonym_sig :: { LSig GhcPs }
@@ -1588,7 +1588,7 @@ decllist_inst
         :: { Located ([AddAnn]
                      , OrdList (LHsDecl GhcPs)) }      -- Reversed
         : '{'         decls_inst '}'    { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2),snd $ unLoc $2) }
-        |     vocurly decls_inst close  { cL (gl $2) (unLoc $2) }
+        |     vocurly decls_inst close  { L (gl $2) (unLoc $2) }
 
 -- Instance body
 --
@@ -1624,7 +1624,7 @@ decls   :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) }
 decllist :: { Located ([AddAnn],Located (OrdList (LHsDecl GhcPs))) }
         : '{'            decls '}'     { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
                                                    ,sL1 $2 $ snd $ unLoc $2) }
-        |     vocurly    decls close   { cL (gl $2) (fst $ 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
 --
@@ -1638,7 +1638,7 @@ binds   ::  { Located ([AddAnn],Located (HsLocalBinds GhcPs)) }
         | '{'            dbinds '}'     { sLL $1 $> ([moc $1,mcc $3]
                                              ,sL1 $2 $ HsIPBinds noExtField (IPBinds noExtField (reverse $ unLoc $2))) }
 
-        |     vocurly    dbinds close   { cL (getLoc $2) ([]
+        |     vocurly    dbinds close   { L (getLoc $2) ([]
                                             ,sL1 $2 $ HsIPBinds noExtField (IPBinds noExtField (reverse $ unLoc $2))) }
 
 
@@ -1666,7 +1666,7 @@ rule    :: { LRuleDecl GhcPs }
          {%runECP_P $4 >>= \ $4 ->
            runECP_P $6 >>= \ $6 ->
            ams (sLL $1 $> $ HsRule { rd_ext = noExtField
-                                   , rd_name = cL (gl $1) (getSTRINGs $1, getSTRING $1)
+                                   , rd_name = L (gl $1) (getSTRINGs $1, getSTRING $1)
                                    , rd_act = (snd $2) `orElse` AlwaysActive
                                    , rd_tyvs = sndOf3 $3, rd_tmvs = thdOf3 $3
                                    , rd_lhs = $4, rd_rhs = $6 })
@@ -1778,14 +1778,14 @@ deprecation :: { OrdList (LWarnDecl GhcPs) }
                      (fst $ unLoc $2) }
 
 strings :: { Located ([AddAnn],[Located StringLiteral]) }
-    : STRING { sL1 $1 ([],[cL (gl $1) (getStringLiteral $1)]) }
+    : STRING { sL1 $1 ([],[L (gl $1) (getStringLiteral $1)]) }
     | '[' stringlist ']' { sLL $1 $> $ ([mos $1,mcs $3],fromOL (unLoc $2)) }
 
 stringlist :: { Located (OrdList (Located StringLiteral)) }
     : stringlist ',' STRING {% addAnnotation (oll $ unLoc $1) AnnComma (gl $2) >>
                                return (sLL $1 $> (unLoc $1 `snocOL`
-                                                  (cL (gl $3) (getStringLiteral $3)))) }
-    | STRING                { sLL $1 $> (unitOL (cL (gl $1) (getStringLiteral $1))) }
+                                                  (L (gl $3) (getStringLiteral $3)))) }
+    | STRING                { sLL $1 $> (unitOL (L (gl $1) (getStringLiteral $1))) }
     | {- empty -}           { noLoc nilOL }
 
 -----------------------------------------------------------------------------
@@ -1839,7 +1839,7 @@ safety :: { Located Safety }
 fspec :: { Located ([AddAnn]
                     ,(Located StringLiteral, Located RdrName, LHsSigType GhcPs)) }
        : STRING var '::' sigtypedoc     { sLL $1 $> ([mu AnnDcolon $3]
-                                             ,(cL (getLoc $1)
+                                             ,(L (getLoc $1)
                                                     (getStringLiteral $1), $2, mkLHsSigType $4)) }
        |        var '::' sigtypedoc     { sLL $1 $> ([mu AnnDcolon $2]
                                              ,(noLoc (StringLiteral NoSourceText nilFS), $1, mkLHsSigType $3)) }
@@ -2005,13 +2005,13 @@ typedoc :: { LHsType GhcPs }
                                                 [mu AnnRarrow $2] }
         | btype docprev '->' ctypedoc    {% ams $1 [mu AnnRarrow $3] -- See note [GADT decl discards annotations]
                                          >> ams (sLL $1 $> $
-                                                 HsFunTy noExtField (cL (comb2 $1 $2)
+                                                 HsFunTy noExtField (L (comb2 $1 $2)
                                                             (HsDocTy noExtField $1 $2))
                                                          $4)
                                                 [mu AnnRarrow $3] }
         | docnext btype '->' ctypedoc    {% ams $2 [mu AnnRarrow $3] -- See note [GADT decl discards annotations]
                                          >> ams (sLL $1 $> $
-                                                 HsFunTy noExtField (cL (comb2 $1 $2)
+                                                 HsFunTy noExtField (L (comb2 $1 $2)
                                                             (HsDocTy noExtField $2 $1))
                                                          $4)
                                                 [mu AnnRarrow $3] }
@@ -2157,7 +2157,7 @@ fds1 :: { Located [Located (FunDep (Located RdrName))] }
         | fd            { sL1 $1 [$1] }
 
 fd :: { Located (FunDep (Located RdrName)) }
-        : varids0 '->' varids0  {% ams (cL (comb3 $1 $2 $3)
+        : varids0 '->' varids0  {% ams (L (comb3 $1 $2 $3)
                                        (reverse (unLoc $1), reverse (unLoc $3)))
                                        [mu AnnRarrow $2] }
 
@@ -2200,13 +2200,13 @@ gadt_constrlist :: { Located ([AddAnn]
                           ,[LConDecl GhcPs]) } -- Returned in order
 
         : 'where' '{'        gadt_constrs '}'    {% checkEmptyGADTs $
-                                                      cL (comb2 $1 $3)
+                                                      L (comb2 $1 $3)
                                                         ([mj AnnWhere $1
                                                          ,moc $2
                                                          ,mcc $4]
                                                         , unLoc $3) }
         | 'where' vocurly    gadt_constrs close  {% checkEmptyGADTs $
-                                                      cL (comb2 $1 $3)
+                                                      L (comb2 $1 $3)
                                                         ([mj AnnWhere $1]
                                                         , unLoc $3) }
         | {- empty -}                            { noLoc ([],[]) }
@@ -2214,8 +2214,8 @@ gadt_constrlist :: { Located ([AddAnn]
 gadt_constrs :: { Located [LConDecl GhcPs] }
         : gadt_constr_with_doc ';' gadt_constrs
                   {% addAnnotation (gl $1) AnnSemi (gl $2)
-                     >> return (cL (comb2 $1 $3) ($1 : unLoc $3)) }
-        | gadt_constr_with_doc          { cL (gl $1) [$1] }
+                     >> return (L (comb2 $1 $3) ($1 : unLoc $3)) }
+        | gadt_constr_with_doc          { L (gl $1) [$1] }
         | {- empty -}                   { noLoc [] }
 
 -- We allow the following forms:
@@ -2252,7 +2252,7 @@ allowed in usual data constructors, but not in GADTs).
 -}
 
 constrs :: { Located ([AddAnn],[LConDecl GhcPs]) }
-        : maybe_docnext '=' constrs1    { cL (comb2 $2 $3) ([mj AnnEqual $2]
+        : maybe_docnext '=' constrs1    { L (comb2 $2 $3) ([mj AnnEqual $2]
                                                      ,addConDocs (unLoc $3) $1)}
 
 constrs1 :: { Located [LConDecl GhcPs] }
@@ -2316,7 +2316,7 @@ They must be kept identical except for their treatment of 'docprev'.
 constr :: { LConDecl GhcPs }
         : maybe_docnext forall constr_context '=>' constr_stuff
                 {% ams (let (con,details,doc_prev) = unLoc $5 in
-                  addConDoc (cL (comb4 $2 $3 $4 $5) (mkConDeclH98 con
+                  addConDoc (L (comb4 $2 $3 $4 $5) (mkConDeclH98 con
                                                        (snd $ unLoc $2)
                                                        (Just $3)
                                                        details))
@@ -2324,7 +2324,7 @@ constr :: { LConDecl GhcPs }
                         (mu AnnDarrow $4:(fst $ unLoc $2)) }
         | maybe_docnext forall constr_stuff
                 {% ams ( let (con,details,doc_prev) = unLoc $3 in
-                  addConDoc (cL (comb2 $2 $3) (mkConDeclH98 con
+                  addConDoc (L (comb2 $2 $3) (mkConDeclH98 con
                                                       (snd $ unLoc $2)
                                                       Nothing   -- No context
                                                       details))
@@ -2352,8 +2352,8 @@ fielddecls1 :: { [LConDeclField GhcPs] }
 fielddecl :: { LConDeclField GhcPs }
                                               -- A list because of   f,g :: Int
         : maybe_docnext sig_vars '::' ctype maybe_docprev
-            {% ams (cL (comb2 $2 $4)
-                      (ConDeclField noExtField (reverse (map (\ln@(dL->L l n) -> cL l $ FieldOcc noExtField ln) (unLoc $2))) $4 ($1 `mplus` $5)))
+            {% ams (L (comb2 $2 $4)
+                      (ConDeclField noExtField (reverse (map (\ln@(L l n) -> L l $ FieldOcc noExtField ln) (unLoc $2))) $4 ($1 `mplus` $5)))
                    [mu AnnDcolon $3] }
 
 -- Reversed!
@@ -2371,17 +2371,17 @@ derivings :: { HsDeriving GhcPs }
 deriving :: { LHsDerivingClause GhcPs }
         : 'deriving' deriv_clause_types
               {% let { full_loc = comb2 $1 $> }
-                 in ams (cL full_loc $ HsDerivingClause noExtField Nothing $2)
+                 in ams (L full_loc $ HsDerivingClause noExtField Nothing $2)
                         [mj AnnDeriving $1] }
 
         | 'deriving' deriv_strategy_no_via deriv_clause_types
               {% let { full_loc = comb2 $1 $> }
-                 in ams (cL full_loc $ HsDerivingClause noExtField (Just $2) $3)
+                 in ams (L full_loc $ HsDerivingClause noExtField (Just $2) $3)
                         [mj AnnDeriving $1] }
 
         | 'deriving' deriv_clause_types deriv_strategy_via
               {% let { full_loc = comb2 $1 $> }
-                 in ams (cL full_loc $ HsDerivingClause noExtField (Just $3) $2)
+                 in ams (L full_loc $ HsDerivingClause noExtField (Just $3) $2)
                         [mj AnnDeriving $1] }
 
 deriv_clause_types :: { Located [LHsSigType GhcPs] }
@@ -2439,7 +2439,7 @@ decl_no_th :: { LHsDecl GhcPs }
                                         case r of {
                                           (FunBind _ n _ _ _) ->
                                                 amsL l (mj AnnFunId n:(fst $2)) >> return () ;
-                                          (PatBind _ (dL->L lh _lhs) _rhs _) ->
+                                          (PatBind _ (L lh _lhs) _rhs _) ->
                                                 amsL lh (fst $2) >> return () } ;
                                         _ <- amsL l (ann ++ (fst $ unLoc $3));
                                         return $! (sL l $ ValD noExtField r) } }
@@ -2764,7 +2764,7 @@ aexp    :: { ECP }
                                                (mj AnnDo $1:(fst $ unLoc $2)) }
         | 'mdo' stmtlist            {% runPV $2 >>= \ $2 ->
                                        fmap ecpFromExp $
-                                       ams (cL (comb2 $1 $2)
+                                       ams (L (comb2 $1 $2)
                                               (mkHsDo MDoExpr (snd $ unLoc $2)))
                                            (mj AnnMdo $1:(fst $ unLoc $2)) }
         | 'proc' aexp '->' exp
@@ -2812,7 +2812,7 @@ aexp2   :: { ECP }
 
         | '(#' texp '#)'                { ECP $
                                            runECP_PV $2 >>= \ $2 ->
-                                           amms (mkSumOrTuplePV (comb2 $1 $>) Unboxed (Tuple [cL (gl $2) (Just $2)]))
+                                           amms (mkSumOrTuplePV (comb2 $1 $>) Unboxed (Tuple [L (gl $2) (Just $2)]))
                                                 [mo $1,mc $3] }
         | '(#' tup_exprs '#)'           { ECP $
                                            $2 >>= \ $2 ->
@@ -2946,7 +2946,7 @@ tup_exprs :: { forall b. DisambECP b => PV ([AddAnn],SumOrTuple b) }
                  { $2 >>= \ $2 ->
                    do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1)
                       ; return
-                           ([],Tuple (map (\l -> cL l Nothing) (fst $1) ++ $2)) } }
+                           ([],Tuple (map (\l -> L l Nothing) (fst $1) ++ $2)) } }
 
            | bars texp bars0
                 { runECP_PV $2 >>= \ $2 -> return $
@@ -2959,16 +2959,16 @@ commas_tup_tail : commas tup_tail
           do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst $1)
              ; return (
             (head $ fst $1
-            ,(map (\l -> cL l Nothing) (tail $ fst $1)) ++ $2)) } }
+            ,(map (\l -> L l Nothing) (tail $ fst $1)) ++ $2)) } }
 
 -- Always follows a comma
 tup_tail :: { forall b. DisambECP b => PV [Located (Maybe (Located b))] }
           : texp commas_tup_tail { runECP_PV $1 >>= \ $1 ->
                                    $2 >>= \ $2 ->
                                    addAnnotation (gl $1) AnnComma (fst $2) >>
-                                   return ((cL (gl $1) (Just $1)) : snd $2) }
+                                   return ((L (gl $1) (Just $1)) : snd $2) }
           | texp                 { runECP_PV $1 >>= \ $1 ->
-                                   return [cL (gl $1) (Just $1)] }
+                                   return [L (gl $1) (Just $1)] }
           | {- empty -}          { return [noLoc Nothing] }
 
 -----------------------------------------------------------------------------
@@ -2983,32 +2983,32 @@ list :: { forall b. DisambECP b => SrcSpan -> PV (Located b) }
         | lexps   { \loc -> $1 >>= \ $1 ->
                             mkHsExplicitListPV loc (reverse $1) }
         | texp '..'  { \loc ->    runECP_PV $1 >>= \ $1 ->
-                                  ams (cL loc $ ArithSeq noExtField Nothing (From $1))
+                                  ams (L loc $ ArithSeq noExtField Nothing (From $1))
                                       [mj AnnDotdot $2]
                                       >>= ecpFromExp' }
         | texp ',' exp '..' { \loc ->
                                    runECP_PV $1 >>= \ $1 ->
                                    runECP_PV $3 >>= \ $3 ->
-                                   ams (cL loc $ ArithSeq noExtField Nothing (FromThen $1 $3))
+                                   ams (L loc $ ArithSeq noExtField Nothing (FromThen $1 $3))
                                        [mj AnnComma $2,mj AnnDotdot $4]
                                        >>= ecpFromExp' }
         | texp '..' exp  { \loc -> runECP_PV $1 >>= \ $1 ->
                                    runECP_PV $3 >>= \ $3 ->
-                                   ams (cL loc $ ArithSeq noExtField Nothing (FromTo $1 $3))
+                                   ams (L loc $ ArithSeq noExtField Nothing (FromTo $1 $3))
                                        [mj AnnDotdot $2]
                                        >>= ecpFromExp' }
         | texp ',' exp '..' exp { \loc ->
                                    runECP_PV $1 >>= \ $1 ->
                                    runECP_PV $3 >>= \ $3 ->
                                    runECP_PV $5 >>= \ $5 ->
-                                   ams (cL loc $ ArithSeq noExtField Nothing (FromThenTo $1 $3 $5))
+                                   ams (L loc $ ArithSeq noExtField Nothing (FromThenTo $1 $3 $5))
                                        [mj AnnComma $2,mj AnnDotdot $4]
                                        >>= ecpFromExp' }
         | texp '|' flattenedpquals
              { \loc ->
                 checkMonadComp >>= \ ctxt ->
                 runECP_PV $1 >>= \ $1 ->
-                ams (cL loc $ mkHsComp ctxt (unLoc $3) $1)
+                ams (L loc $ mkHsComp ctxt (unLoc $3) $1)
                     [mj AnnVbar $2]
                     >>= ecpFromExp' }
 
@@ -3043,7 +3043,7 @@ pquals :: { Located [[LStmt GhcPs (LHsExpr GhcPs)]] }
     : squals '|' pquals
                      {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $2) >>
                         return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) }
-    | squals         { cL (getLoc $1) [reverse (unLoc $1)] }
+    | squals         { L (getLoc $1) [reverse (unLoc $1)] }
 
 squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }   -- In reverse order, because the last
                                         -- one can "grab" the earlier ones
@@ -3056,7 +3056,7 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }   -- In reverse order, becau
                 addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
                 return (sLL $1 $> ($3 : unLoc $1)) }
     | transformqual        {% ams $1 (fst $ unLoc $1) >>
-                              return (sLL $1 $> [cL (getLoc $1) ((snd $ unLoc $1) [])]) }
+                              return (sLL $1 $> [L (getLoc $1) ((snd $ unLoc $1) [])]) }
     | qual                               {% runPV $1 >>= \ $1 ->
                                             return $ sL1 $1 [$1] }
 --  | transformquals1 ',' '{|' pquals '|}'   { sLL $1 $> ($4 : unLoc $1) }
@@ -3095,7 +3095,7 @@ transformqual :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs
 -- Guards
 
 guardquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
-    : guardquals1           { cL (getLoc $1) (reverse (unLoc $1)) }
+    : guardquals1           { L (getLoc $1) (reverse (unLoc $1)) }
 
 guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
     : guardquals1 ',' qual  {% runPV $3 >>= \ $3 ->
@@ -3113,7 +3113,7 @@ altslist :: { forall b. DisambECP b => PV (Located ([AddAnn],[LMatch GhcPs (Loca
                                      sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
                                                ,(reverse (snd $ unLoc $2))) }
         |     vocurly    alts  close { $2 >>= \ $2 -> return $
-                                       cL (getLoc $2) (fst $ unLoc $2
+                                       L (getLoc $2) (fst $ unLoc $2
                                         ,(reverse (snd $ unLoc $2))) }
         | '{'                 '}'    { return $ sLL $1 $> ([moc $1,mcc $2],[]) }
         |     vocurly          close { return $ noLoc ([],[]) }
@@ -3210,7 +3210,7 @@ stmtlist :: { forall b. DisambECP b => PV (Located ([AddAnn],[LStmt GhcPs (Locat
                                           sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
                                              ,(reverse $ snd $ unLoc $2)) } -- AZ:performance of reverse?
         |     vocurly   stmts close     { $2 >>= \ $2 -> return $
-                                          cL (gl $2) (fst $ unLoc $2
+                                          L (gl $2) (fst $ unLoc $2
                                                     ,reverse $ snd $ unLoc $2) }
 
 --      do { ;; s ; s ; ; s ;; }
@@ -3765,87 +3765,87 @@ maybe_docnext :: { Maybe LHsDocString }
 happyError :: P a
 happyError = srcParseFail
 
-getVARID        (dL->L _ (ITvarid    x)) = x
-getCONID        (dL->L _ (ITconid    x)) = x
-getVARSYM       (dL->L _ (ITvarsym   x)) = x
-getCONSYM       (dL->L _ (ITconsym   x)) = x
-getQVARID       (dL->L _ (ITqvarid   x)) = x
-getQCONID       (dL->L _ (ITqconid   x)) = x
-getQVARSYM      (dL->L _ (ITqvarsym  x)) = x
-getQCONSYM      (dL->L _ (ITqconsym  x)) = x
-getIPDUPVARID   (dL->L _ (ITdupipvarid   x)) = x
-getLABELVARID   (dL->L _ (ITlabelvarid   x)) = x
-getCHAR         (dL->L _ (ITchar   _ x)) = x
-getSTRING       (dL->L _ (ITstring _ x)) = x
-getINTEGER      (dL->L _ (ITinteger x))  = x
-getRATIONAL     (dL->L _ (ITrational x)) = x
-getPRIMCHAR     (dL->L _ (ITprimchar _ x)) = x
-getPRIMSTRING   (dL->L _ (ITprimstring _ x)) = x
-getPRIMINTEGER  (dL->L _ (ITprimint  _ x)) = x
-getPRIMWORD     (dL->L _ (ITprimword _ x)) = x
-getPRIMFLOAT    (dL->L _ (ITprimfloat x)) = x
-getPRIMDOUBLE   (dL->L _ (ITprimdouble x)) = x
-getINLINE       (dL->L _ (ITinline_prag _ inl conl)) = (inl,conl)
-getSPEC_INLINE  (dL->L _ (ITspec_inline_prag _ True))  = (Inline,  FunLike)
-getSPEC_INLINE  (dL->L _ (ITspec_inline_prag _ False)) = (NoInline,FunLike)
-getCOMPLETE_PRAGs (dL->L _ (ITcomplete_prag x)) = x
-
-getDOCNEXT (dL->L _ (ITdocCommentNext x)) = x
-getDOCPREV (dL->L _ (ITdocCommentPrev x)) = x
-getDOCNAMED (dL->L _ (ITdocCommentNamed x)) = x
-getDOCSECTION (dL->L _ (ITdocSection n x)) = (n, x)
-
-getINTEGERs     (dL->L _ (ITinteger (IL src _ _))) = src
-getCHARs        (dL->L _ (ITchar       src _)) = src
-getSTRINGs      (dL->L _ (ITstring     src _)) = src
-getPRIMCHARs    (dL->L _ (ITprimchar   src _)) = src
-getPRIMSTRINGs  (dL->L _ (ITprimstring src _)) = src
-getPRIMINTEGERs (dL->L _ (ITprimint    src _)) = src
-getPRIMWORDs    (dL->L _ (ITprimword   src _)) = src
+getVARID        (L _ (ITvarid    x)) = x
+getCONID        (L _ (ITconid    x)) = x
+getVARSYM       (L _ (ITvarsym   x)) = x
+getCONSYM       (L _ (ITconsym   x)) = x
+getQVARID       (L _ (ITqvarid   x)) = x
+getQCONID       (L _ (ITqconid   x)) = x
+getQVARSYM      (L _ (ITqvarsym  x)) = x
+getQCONSYM      (L _ (ITqconsym  x)) = x
+getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
+getLABELVARID   (L _ (ITlabelvarid   x)) = x
+getCHAR         (L _ (ITchar   _ x)) = x
+getSTRING       (L _ (ITstring _ x)) = x
+getINTEGER      (L _ (ITinteger x))  = x
+getRATIONAL     (L _ (ITrational x)) = x
+getPRIMCHAR     (L _ (ITprimchar _ x)) = x
+getPRIMSTRING   (L _ (ITprimstring _ x)) = x
+getPRIMINTEGER  (L _ (ITprimint  _ x)) = x
+getPRIMWORD     (L _ (ITprimword _ x)) = x
+getPRIMFLOAT    (L _ (ITprimfloat x)) = x
+getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
+getINLINE       (L _ (ITinline_prag _ inl conl)) = (inl,conl)
+getSPEC_INLINE  (L _ (ITspec_inline_prag _ True))  = (Inline,  FunLike)
+getSPEC_INLINE  (L _ (ITspec_inline_prag _ False)) = (NoInline,FunLike)
+getCOMPLETE_PRAGs (L _ (ITcomplete_prag x)) = x
+
+getDOCNEXT (L _ (ITdocCommentNext x)) = x
+getDOCPREV (L _ (ITdocCommentPrev x)) = x
+getDOCNAMED (L _ (ITdocCommentNamed x)) = x
+getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
+
+getINTEGERs     (L _ (ITinteger (IL src _ _))) = src
+getCHARs        (L _ (ITchar       src _)) = src
+getSTRINGs      (L _ (ITstring     src _)) = src
+getPRIMCHARs    (L _ (ITprimchar   src _)) = src
+getPRIMSTRINGs  (L _ (ITprimstring src _)) = src
+getPRIMINTEGERs (L _ (ITprimint    src _)) = src
+getPRIMWORDs    (L _ (ITprimword   src _)) = src
 
 -- See Note [Pragma source text] in BasicTypes for the following
-getINLINE_PRAGs       (dL->L _ (ITinline_prag       src _ _)) = src
-getSPEC_PRAGs         (dL->L _ (ITspec_prag         src))     = src
-getSPEC_INLINE_PRAGs  (dL->L _ (ITspec_inline_prag  src _))   = src
-getSOURCE_PRAGs       (dL->L _ (ITsource_prag       src)) = src
-getRULES_PRAGs        (dL->L _ (ITrules_prag        src)) = src
-getWARNING_PRAGs      (dL->L _ (ITwarning_prag      src)) = src
-getDEPRECATED_PRAGs   (dL->L _ (ITdeprecated_prag   src)) = src
-getSCC_PRAGs          (dL->L _ (ITscc_prag          src)) = src
-getGENERATED_PRAGs    (dL->L _ (ITgenerated_prag    src)) = src
-getCORE_PRAGs         (dL->L _ (ITcore_prag         src)) = src
-getUNPACK_PRAGs       (dL->L _ (ITunpack_prag       src)) = src
-getNOUNPACK_PRAGs     (dL->L _ (ITnounpack_prag     src)) = src
-getANN_PRAGs          (dL->L _ (ITann_prag          src)) = src
-getMINIMAL_PRAGs      (dL->L _ (ITminimal_prag      src)) = src
-getOVERLAPPABLE_PRAGs (dL->L _ (IToverlappable_prag src)) = src
-getOVERLAPPING_PRAGs  (dL->L _ (IToverlapping_prag  src)) = src
-getOVERLAPS_PRAGs     (dL->L _ (IToverlaps_prag     src)) = src
-getINCOHERENT_PRAGs   (dL->L _ (ITincoherent_prag   src)) = src
-getCTYPEs             (dL->L _ (ITctype             src)) = src
+getINLINE_PRAGs       (L _ (ITinline_prag       src _ _)) = src
+getSPEC_PRAGs         (L _ (ITspec_prag         src))     = src
+getSPEC_INLINE_PRAGs  (L _ (ITspec_inline_prag  src _))   = src
+getSOURCE_PRAGs       (L _ (ITsource_prag       src)) = src
+getRULES_PRAGs        (L _ (ITrules_prag        src)) = src
+getWARNING_PRAGs      (L _ (ITwarning_prag      src)) = src
+getDEPRECATED_PRAGs   (L _ (ITdeprecated_prag   src)) = src
+getSCC_PRAGs          (L _ (ITscc_prag          src)) = src
+getGENERATED_PRAGs    (L _ (ITgenerated_prag    src)) = src
+getCORE_PRAGs         (L _ (ITcore_prag         src)) = src
+getUNPACK_PRAGs       (L _ (ITunpack_prag       src)) = src
+getNOUNPACK_PRAGs     (L _ (ITnounpack_prag     src)) = src
+getANN_PRAGs          (L _ (ITann_prag          src)) = src
+getMINIMAL_PRAGs      (L _ (ITminimal_prag      src)) = src
+getOVERLAPPABLE_PRAGs (L _ (IToverlappable_prag src)) = src
+getOVERLAPPING_PRAGs  (L _ (IToverlapping_prag  src)) = src
+getOVERLAPS_PRAGs     (L _ (IToverlaps_prag     src)) = src
+getINCOHERENT_PRAGs   (L _ (ITincoherent_prag   src)) = src
+getCTYPEs             (L _ (ITctype             src)) = src
 
 getStringLiteral l = StringLiteral (getSTRINGs l) (getSTRING l)
 
 isUnicode :: Located Token -> Bool
-isUnicode (dL->L _ (ITforall         iu)) = iu == UnicodeSyntax
-isUnicode (dL->L _ (ITdarrow         iu)) = iu == UnicodeSyntax
-isUnicode (dL->L _ (ITdcolon         iu)) = iu == UnicodeSyntax
-isUnicode (dL->L _ (ITlarrow         iu)) = iu == UnicodeSyntax
-isUnicode (dL->L _ (ITrarrow         iu)) = iu == UnicodeSyntax
-isUnicode (dL->L _ (ITlarrowtail     iu)) = iu == UnicodeSyntax
-isUnicode (dL->L _ (ITrarrowtail     iu)) = iu == UnicodeSyntax
-isUnicode (dL->L _ (ITLarrowtail     iu)) = iu == UnicodeSyntax
-isUnicode (dL->L _ (ITRarrowtail     iu)) = iu == UnicodeSyntax
-isUnicode (dL->L _ (IToparenbar      iu)) = iu == UnicodeSyntax
-isUnicode (dL->L _ (ITcparenbar      iu)) = iu == UnicodeSyntax
-isUnicode (dL->L _ (ITopenExpQuote _ iu)) = iu == UnicodeSyntax
-isUnicode (dL->L _ (ITcloseQuote     iu)) = iu == UnicodeSyntax
-isUnicode (dL->L _ (ITstar           iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITforall         iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITdarrow         iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITdcolon         iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITlarrow         iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITrarrow         iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITlarrowtail     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITrarrowtail     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITLarrowtail     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITRarrowtail     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (IToparenbar      iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITcparenbar      iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITopenExpQuote _ iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITcloseQuote     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITstar           iu)) = iu == UnicodeSyntax
 isUnicode _                           = False
 
 hasE :: Located Token -> Bool
-hasE (dL->L _ (ITopenExpQuote HasE _)) = True
-hasE (dL->L _ (ITopenTExpQuote HasE))  = True
+hasE (L _ (ITopenExpQuote HasE _)) = True
+hasE (L _ (ITopenTExpQuote HasE))  = True
 hasE _                             = False
 
 getSCC :: Located Token -> P FastString
@@ -3857,39 +3857,36 @@ getSCC lt = do let s = getSTRING lt
                    else return s
 
 -- Utilities for combining source spans
-comb2 :: (HasSrcSpan a , HasSrcSpan b) => a -> b -> SrcSpan
+comb2 :: Located a -> Located b -> SrcSpan
 comb2 a b = a `seq` b `seq` combineLocs a b
 
-comb3 :: (HasSrcSpan a , HasSrcSpan b , HasSrcSpan c) =>
-         a -> b -> c -> SrcSpan
+comb3 :: Located a -> Located b -> Located c -> SrcSpan
 comb3 a b c = a `seq` b `seq` c `seq`
     combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
 
-comb4 :: (HasSrcSpan a , HasSrcSpan b , HasSrcSpan c , HasSrcSpan d) =>
-         a -> b -> c -> d -> SrcSpan
+comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
 comb4 a b c d = a `seq` b `seq` c `seq` d `seq`
     (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
                 combineSrcSpans (getLoc c) (getLoc d))
 
 -- strict constructor version:
 {-# INLINE sL #-}
-sL :: HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
-sL span a = span `seq` a `seq` cL span a
+sL :: SrcSpan -> a -> Located a
+sL span a = span `seq` a `seq` L span a
 
 -- See Note [Adding location info] for how these utility functions are used
 
 -- replaced last 3 CPP macros in this file
 {-# INLINE sL0 #-}
-sL0 :: HasSrcSpan a => SrcSpanLess a -> a
-sL0 = cL noSrcSpan       -- #define L0   L noSrcSpan
+sL0 :: a -> Located a
+sL0 = L noSrcSpan       -- #define L0   L noSrcSpan
 
 {-# INLINE sL1 #-}
-sL1 :: (HasSrcSpan a , HasSrcSpan b) => a -> SrcSpanLess b -> b
+sL1 :: Located a -> b -> Located b
 sL1 x = sL (getLoc x)   -- #define sL1   sL (getLoc $1)
 
 {-# INLINE sLL #-}
-sLL :: (HasSrcSpan a , HasSrcSpan b , HasSrcSpan c) =>
-       a -> b -> SrcSpanLess c -> c
+sLL :: Located a -> Located b -> c -> Located c
 sLL x y = sL (comb2 x y) -- #define LL   sL (comb2 $1 $>)
 
 {- Note [Adding location info]
@@ -3990,7 +3987,7 @@ in ApiAnnotation.hs
 
 -- |Construct an AddAnn from the annotation keyword and the location
 -- of the keyword itself
-mj :: HasSrcSpan e => AnnKeywordId -> e -> AddAnn
+mj :: AnnKeywordId -> Located e -> AddAnn
 mj a l = AddAnn a (gl l)
 
 
@@ -3998,25 +3995,25 @@ mj a l = AddAnn a (gl l)
 -- the token has a unicode equivalent and this has been used, provide the
 -- unicode variant of the annotation.
 mu :: AnnKeywordId -> Located Token -> AddAnn
-mu a lt@(dL->L l t) = AddAnn (toUnicodeAnn a lt) l
+mu a lt@(L l t) = AddAnn (toUnicodeAnn a lt) l
 
 -- | If the 'Token' is using its unicode variant return the unicode variant of
 --   the annotation
 toUnicodeAnn :: AnnKeywordId -> Located Token -> AnnKeywordId
 toUnicodeAnn a t = if isUnicode t then unicodeAnn a else a
 
-gl :: HasSrcSpan a => a -> SrcSpan
+gl :: Located a -> SrcSpan
 gl = getLoc
 
 -- |Add an annotation to the located element, and return the located
 -- element as a pass through
-aa :: (HasSrcSpan a , HasSrcSpan c) => a -> (AnnKeywordId, c) -> P a
-aa a@(dL->L l _) (b,s) = addAnnotation l b (gl s) >> return a
+aa :: Located a -> (AnnKeywordId, Located c) -> P (Located a)
+aa a@(L l _) (b,s) = addAnnotation l b (gl s) >> return a
 
 -- |Add an annotation to a located element resulting from a monadic action
-am :: (HasSrcSpan a , HasSrcSpan b) => P a -> (AnnKeywordId, b) -> P a
+am :: P (Located a) -> (AnnKeywordId, Located b) -> P (Located a)
 am a (b,s) = do
-  av@(dL->L l _) <- a
+  av@(L l _) <- a
   addAnnotation l b (gl s)
   return av
 
@@ -4033,27 +4030,27 @@ am a (b,s) = do
 -- as any annotations that may arise in the binds. This will include open
 -- and closing braces if they are used to delimit the let expressions.
 --
-ams :: (MonadP m, HasSrcSpan a) => a -> [AddAnn] -> m a
-ams a@(dL->L l _) bs = addAnnsAt l bs >> return a
+ams :: MonadP m => Located a -> [AddAnn] -> m (Located a)
+ams a@(L l _) bs = addAnnsAt l bs >> return a
 
 amsL :: SrcSpan -> [AddAnn] -> P ()
 amsL sp bs = addAnnsAt sp bs >> return ()
 
 -- |Add all [AddAnn] to an AST element, and wrap it in a 'Just'
-ajs :: (MonadP m, HasSrcSpan a) => a -> [AddAnn] -> m (Maybe a)
+ajs :: MonadP m => Located a -> [AddAnn] -> m (Maybe (Located a))
 ajs a bs = Just <$> ams a bs
 
 -- |Add a list of AddAnns to the given AST element, where the AST element is the
 --  result of a monadic action
-amms :: MonadP m => HasSrcSpan a => m a -> [AddAnn] -> m a
-amms a bs = do { av@(dL->L l _) <- a
+amms :: MonadP m => m (Located a) -> [AddAnn] -> m (Located a)
+amms a bs = do { av@(L l _) <- a
                ; addAnnsAt l bs
                ; return av }
 
 -- |Add a list of AddAnns to the AST element, and return the element as a
 --  OrdList
-amsu :: HasSrcSpan a => a -> [AddAnn] -> P (OrdList a)
-amsu a@(dL->L l _) bs = addAnnsAt l bs >> return (unitOL a)
+amsu :: Located a -> [AddAnn] -> P (OrdList (Located a))
+amsu a@(L l _) bs = addAnnsAt l bs >> return (unitOL a)
 
 -- |Synonyms for AddAnn versions of AnnOpen and AnnClose
 mo,mc :: Located Token -> AddAnn
@@ -4083,14 +4080,14 @@ mvbars :: [SrcSpan] -> [AddAnn]
 mvbars = map (AddAnn AnnVbar)
 
 -- |Get the location of the last element of a OrdList, or noSrcSpan
-oll :: HasSrcSpan a => OrdList a -> SrcSpan
+oll :: OrdList (Located a) -> SrcSpan
 oll l =
   if isNilOL l then noSrcSpan
                else getLoc (lastOL l)
 
 -- |Add a semicolon annotation in the right place in a list. If the
 -- leading list is empty, add it to the tail
-asl :: (HasSrcSpan a , HasSrcSpan b) => [a] -> b -> a -> P()
-asl [] (dL->L ls _) (dL->L l _) = addAnnotation l          AnnSemi ls
-asl (x:_xs) (dL->L ls _) _x = addAnnotation (getLoc x) AnnSemi ls
+asl :: [Located a] -> Located b -> Located a -> P ()
+asl [] (L ls _) (L l _) = addAnnotation l          AnnSemi ls
+asl (x:_xs) (L ls _) _x = addAnnotation (getLoc x) AnnSemi ls
 }
index 8963419..617f1c0 100644 (file)
@@ -160,10 +160,10 @@ import Data.Data       ( dataTypeOf, fromConstr, dataTypeConstrs )
 --         *** See Note [The Naming story] in GHC.Hs.Decls ****
 
 mkTyClD :: LTyClDecl (GhcPass p) -> LHsDecl (GhcPass p)
-mkTyClD (dL->L loc d) = cL loc (TyClD noExtField d)
+mkTyClD (L loc d) = L loc (TyClD noExtField d)
 
 mkInstD :: LInstDecl (GhcPass p) -> LHsDecl (GhcPass p)
-mkInstD (dL->L loc d) = cL loc (InstD noExtField d)
+mkInstD (L loc d) = L loc (InstD noExtField d)
 
 mkClassDecl :: SrcSpan
             -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
@@ -171,21 +171,21 @@ mkClassDecl :: SrcSpan
             -> OrdList (LHsDecl GhcPs)
             -> P (LTyClDecl GhcPs)
 
-mkClassDecl loc (dL->L _ (mcxt, tycl_hdr)) fds where_cls
+mkClassDecl loc (L _ (mcxt, tycl_hdr)) fds where_cls
   = do { (binds, sigs, ats, at_defs, _, docs) <- cvBindsAndSigs where_cls
        ; let cxt = fromMaybe (noLoc []) mcxt
        ; (cls, tparams, fixity, ann) <- checkTyClHdr True tycl_hdr
        ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
        ; (tyvars,annst) <- checkTyVars (text "class") whereDots cls tparams
        ; addAnnsAt loc annst -- Add any API Annotations to the top SrcSpan
-       ; return (cL loc (ClassDecl { tcdCExt = noExtField, tcdCtxt = cxt
-                                   , tcdLName = cls, tcdTyVars = tyvars
-                                   , tcdFixity = fixity
-                                   , tcdFDs = snd (unLoc fds)
-                                   , tcdSigs = mkClassOpSigs sigs
-                                   , tcdMeths = binds
-                                   , tcdATs = ats, tcdATDefs = at_defs
-                                   , tcdDocs  = docs })) }
+       ; return (L loc (ClassDecl { tcdCExt = noExtField, tcdCtxt = cxt
+                                  , tcdLName = cls, tcdTyVars = tyvars
+                                  , tcdFixity = fixity
+                                  , tcdFDs = snd (unLoc fds)
+                                  , tcdSigs = mkClassOpSigs sigs
+                                  , tcdMeths = binds
+                                  , tcdATs = ats, tcdATDefs = at_defs
+                                  , tcdDocs  = docs })) }
 
 mkTyData :: SrcSpan
          -> NewOrData
@@ -195,17 +195,17 @@ mkTyData :: SrcSpan
          -> [LConDecl GhcPs]
          -> HsDeriving GhcPs
          -> P (LTyClDecl GhcPs)
-mkTyData loc new_or_data cType (dL->L _ (mcxt, tycl_hdr))
+mkTyData loc new_or_data cType (L _ (mcxt, tycl_hdr))
          ksig data_cons maybe_deriv
   = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr
        ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
        ; (tyvars, anns) <- checkTyVars (ppr new_or_data) equalsDots tc tparams
        ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan
        ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
-       ; return (cL loc (DataDecl { tcdDExt = noExtField,
-                                    tcdLName = tc, tcdTyVars = tyvars,
-                                    tcdFixity = fixity,
-                                    tcdDataDefn = defn })) }
+       ; return (L loc (DataDecl { tcdDExt = noExtField,
+                                   tcdLName = tc, tcdTyVars = tyvars,
+                                   tcdFixity = fixity,
+                                   tcdDataDefn = defn })) }
 
 mkDataDefn :: NewOrData
            -> Maybe (Located CType)
@@ -234,10 +234,10 @@ mkTySynonym loc lhs rhs
        ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
        ; (tyvars, anns) <- checkTyVars (text "type") equalsDots tc tparams
        ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan
-       ; return (cL loc (SynDecl { tcdSExt = noExtField
-                                 , tcdLName = tc, tcdTyVars = tyvars
-                                 , tcdFixity = fixity
-                                 , tcdRhs = rhs })) }
+       ; return (L loc (SynDecl { tcdSExt = noExtField
+                                , tcdLName = tc, tcdTyVars = tyvars
+                                , tcdFixity = fixity
+                                , tcdRhs = rhs })) }
 
 mkStandaloneKindSig
   :: SrcSpan
@@ -247,7 +247,7 @@ mkStandaloneKindSig
 mkStandaloneKindSig loc lhs rhs =
   do { vs <- mapM check_lhs_name (unLoc lhs)
      ; v <- check_singular_lhs (reverse vs)
-     ; return $ cL loc $ StandaloneKindSig noExtField v (mkLHsSigType rhs) }
+     ; return $ L loc $ StandaloneKindSig noExtField v (mkLHsSigType rhs) }
   where
     check_lhs_name v@(unLoc->name) =
       if isUnqual name && isTcOcc (rdrNameOcc name)
@@ -292,7 +292,7 @@ mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr)
   = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr
        ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
        ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
-       ; return (cL loc (DataFamInstD noExtField (DataFamInstDecl (mkHsImplicitBndrs
+       ; return (L loc (DataFamInstD noExtField (DataFamInstDecl (mkHsImplicitBndrs
                   (FamEqn { feqn_ext    = noExtField
                           , feqn_tycon  = tc
                           , feqn_bndrs  = bndrs
@@ -304,7 +304,7 @@ mkTyFamInst :: SrcSpan
             -> TyFamInstEqn GhcPs
             -> P (LInstDecl GhcPs)
 mkTyFamInst loc eqn
-  = return (cL loc (TyFamInstD noExtField (TyFamInstDecl eqn)))
+  = return (L loc (TyFamInstD noExtField (TyFamInstDecl eqn)))
 
 mkFamDecl :: SrcSpan
           -> FamilyInfo GhcPs
@@ -317,7 +317,7 @@ mkFamDecl loc info lhs ksig injAnn
        ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
        ; (tyvars, anns) <- checkTyVars (ppr info) equals_or_where tc tparams
        ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan
-       ; return (cL loc (FamDecl noExtField (FamilyDecl
+       ; return (L loc (FamDecl noExtField (FamilyDecl
                                            { fdExt       = noExtField
                                            , fdInfo      = info, fdLName = tc
                                            , fdTyVars    = tyvars
@@ -340,15 +340,15 @@ mkSpliceDecl :: LHsExpr GhcPs -> HsDecl GhcPs
 --
 -- Typed splices are not allowed at the top level, thus we do not represent them
 -- as spliced declaration.  See #10945
-mkSpliceDecl lexpr@(dL->L loc expr)
+mkSpliceDecl lexpr@(L loc expr)
   | HsSpliceE _ splice@(HsUntypedSplice {}) <- expr
-  = SpliceD noExtField (SpliceDecl noExtField (cL loc splice) ExplicitSplice)
+  = SpliceD noExtField (SpliceDecl noExtField (L loc splice) ExplicitSplice)
 
   | HsSpliceE _ splice@(HsQuasiQuote {}) <- expr
-  = SpliceD noExtField (SpliceDecl noExtField (cL loc splice) ExplicitSplice)
+  = SpliceD noExtField (SpliceDecl noExtField (L loc splice) ExplicitSplice)
 
   | otherwise
-  = SpliceD noExtField (SpliceDecl noExtField (cL loc (mkUntypedSplice BareSplice lexpr))
+  = SpliceD noExtField (SpliceDecl noExtField (L loc (mkUntypedSplice BareSplice lexpr))
                               ImplicitSplice)
 
 mkRoleAnnotDecl :: SrcSpan
@@ -357,16 +357,16 @@ mkRoleAnnotDecl :: SrcSpan
                 -> P (LRoleAnnotDecl GhcPs)
 mkRoleAnnotDecl loc tycon roles
   = do { roles' <- mapM parse_role roles
-       ; return $ cL loc $ RoleAnnotDecl noExtField tycon roles' }
+       ; return $ L loc $ RoleAnnotDecl noExtField tycon roles' }
   where
     role_data_type = dataTypeOf (undefined :: Role)
     all_roles = map fromConstr $ dataTypeConstrs role_data_type
     possible_roles = [(fsFromRole role, role) | role <- all_roles]
 
-    parse_role (dL->L loc_role Nothing) = return $ cL loc_role Nothing
-    parse_role (dL->L loc_role (Just role))
+    parse_role (L loc_role Nothing) = return $ L loc_role Nothing
+    parse_role (L loc_role (Just role))
       = case lookup role possible_roles of
-          Just found_role -> return $ cL loc_role $ Just found_role
+          Just found_role -> return $ L loc_role $ Just found_role
           Nothing         ->
             let nearby = fuzzyLookup (unpackFS role)
                   (mapFst unpackFS possible_roles)
@@ -374,8 +374,6 @@ mkRoleAnnotDecl loc tycon roles
             addFatalError loc_role
               (text "Illegal role name" <+> quotes (ppr role) $$
                suggestions nearby)
-    parse_role _ = panic "parse_role: Impossible Match"
-                                -- due to #15884
 
     suggestions []   = empty
     suggestions [r]  = text "Perhaps you meant" <+> quotes (ppr r)
@@ -400,9 +398,9 @@ cvTopDecls decls = go (fromOL decls)
   where
     go :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
     go []                     = []
-    go ((dL->L l (ValD x b)) : ds)
-      = cL l' (ValD x b') : go ds'
-        where (dL->L l' b', ds') = getMonoBind (cL l b) ds
+    go ((L l (ValD x b)) : ds)
+      = L l' (ValD x b') : go ds'
+        where (L l' b', ds') = getMonoBind (L l b) ds
     go (d : ds)                    = d : go ds
 
 -- Declaration list may only contain value bindings and signatures.
@@ -422,24 +420,24 @@ cvBindsAndSigs :: OrdList (LHsDecl GhcPs)
 cvBindsAndSigs fb = go (fromOL fb)
   where
     go []              = return (emptyBag, [], [], [], [], [])
-    go ((dL->L l (ValD _ b)) : ds)
+    go ((L l (ValD _ b)) : ds)
       = do { (bs, ss, ts, tfis, dfis, docs) <- go ds'
            ; return (b' `consBag` bs, ss, ts, tfis, dfis, docs) }
       where
-        (b', ds') = getMonoBind (cL l b) ds
-    go ((dL->L l decl) : ds)
+        (b', ds') = getMonoBind (L l b) ds
+    go ((L l decl) : ds)
       = do { (bs, ss, ts, tfis, dfis, docs) <- go ds
            ; case decl of
                SigD _ s
-                 -> return (bs, cL l s : ss, ts, tfis, dfis, docs)
+                 -> return (bs, L l s : ss, ts, tfis, dfis, docs)
                TyClD _ (FamDecl _ t)
-                 -> return (bs, ss, cL l t : ts, tfis, dfis, docs)
+                 -> return (bs, ss, L l t : ts, tfis, dfis, docs)
                InstD _ (TyFamInstD { tfid_inst = tfi })
-                 -> return (bs, ss, ts, cL l tfi : tfis, dfis, docs)
+                 -> return (bs, ss, ts, L l tfi : tfis, dfis, docs)
                InstD _ (DataFamInstD { dfid_inst = dfi })
-                 -> return (bs, ss, ts, tfis, cL l dfi : dfis, docs)
+                 -> return (bs, ss, ts, tfis, L l dfi : dfis, docs)
                DocD _ d
-                 -> return (bs, ss, ts, tfis, dfis, cL l d : docs)
+                 -> return (bs, ss, ts, tfis, dfis, L l d : docs)
                SpliceD _ d
                  -> addFatalError l $
                     hang (text "Declaration splices are allowed only" <+>
@@ -465,25 +463,25 @@ getMonoBind :: LHsBind GhcPs -> [LHsDecl GhcPs]
 --
 -- No AndMonoBinds or EmptyMonoBinds here; just single equations
 
-getMonoBind (dL->L loc1 (FunBind { fun_id = fun_id1@(dL->L _ f1)
-                                 , fun_matches =
-                                   MG { mg_alts = (dL->L _ mtchs1) } }))
+getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1)
+                             , fun_matches =
+                               MG { mg_alts = (L _ mtchs1) } }))
             binds
   | has_args mtchs1
   = go mtchs1 loc1 binds []
   where
     go mtchs loc
-       ((dL->L loc2 (ValD _ (FunBind { fun_id = (dL->L _ f2)
-                                    , fun_matches =
-                                        MG { mg_alts = (dL->L _ mtchs2) } })))
+       ((L loc2 (ValD _ (FunBind { fun_id = (L _ f2)
+                                 , fun_matches =
+                                    MG { mg_alts = (L _ mtchs2) } })))
          : binds) _
         | f1 == f2 = go (mtchs2 ++ mtchs)
                         (combineSrcSpans loc loc2) binds []
-    go mtchs loc (doc_decl@(dL->L loc2 (DocD {})) : binds) doc_decls
+    go mtchs loc (doc_decl@(L loc2 (DocD {})) : binds) doc_decls
         = let doc_decls' = doc_decl : doc_decls
           in go mtchs (combineSrcSpans loc loc2) binds doc_decls'
     go mtchs loc binds doc_decls
-        = ( cL loc (makeFunBind fun_id1 (reverse mtchs))
+        = ( L loc (makeFunBind fun_id1 (reverse mtchs))
           , (reverse doc_decls) ++ binds)
         -- Reverse the final matches, to get it back in the right order
         -- Do the same thing with the trailing doc comments
@@ -491,14 +489,13 @@ getMonoBind (dL->L loc1 (FunBind { fun_id = fun_id1@(dL->L _ f1)
 getMonoBind bind binds = (bind, binds)
 
 has_args :: [LMatch GhcPs (LHsExpr GhcPs)] -> Bool
-has_args []                                    = panic "RdrHsSyn:has_args"
-has_args ((dL->L _ (Match { m_pats = args })) : _) = not (null args)
+has_args []                                  = panic "RdrHsSyn:has_args"
+has_args (L _ (Match { m_pats = args }) : _) = not (null args)
         -- Don't group together FunBinds if they have
         -- no arguments.  This is necessary now that variable bindings
         -- with no arguments are now treated as FunBinds rather
         -- than pattern bindings (tests/rename/should_fail/rnfail002).
-has_args ((dL->L _ (XMatch nec)) : _) = noExtCon nec
-has_args (_ : _) = panic "has_args:Impossible Match" -- due to #15884
+has_args (L _ (XMatch nec) : _) = noExtCon nec
 
 {- **********************************************************************
 
@@ -589,7 +586,7 @@ tyConToDataCon :: SrcSpan -> RdrName -> Either (SrcSpan, SDoc) (Located RdrName)
 tyConToDataCon loc tc
   | isTcOcc occ || isDataOcc occ
   , isLexCon (occNameFS occ)
-  = return (cL loc (setRdrNameSpace tc srcDataName))
+  = return (L loc (setRdrNameSpace tc srcDataName))
 
   | otherwise
   = Left (loc, msg)
@@ -600,14 +597,14 @@ tyConToDataCon loc tc
 mkPatSynMatchGroup :: Located RdrName
                    -> Located (OrdList (LHsDecl GhcPs))
                    -> P (MatchGroup GhcPs (LHsExpr GhcPs))
-mkPatSynMatchGroup (dL->L loc patsyn_name) (dL->L _ decls) =
+mkPatSynMatchGroup (L loc patsyn_name) (L _ decls) =
     do { matches <- mapM fromDecl (fromOL decls)
        ; when (null matches) (wrongNumberErr loc)
        ; return $ mkMatchGroup FromSource matches }
   where
-    fromDecl (dL->L loc decl@(ValD _ (PatBind _
-                             pat@(dL->L _ (ConPatIn ln@(dL->L _ name) details))
-                                   rhs _))) =
+    fromDecl (L loc decl@(ValD _ (PatBind _
+                         pat@(L _ (ConPatIn ln@(L _ name) details))
+                               rhs _))) =
         do { unless (name == patsyn_name) $
                wrongNameBindingErr loc decl
            ; match <- case details of
@@ -629,8 +626,8 @@ mkPatSynMatchGroup (dL->L loc patsyn_name) (dL->L _ decls) =
                                    , mc_strictness = NoSrcStrict }
 
                RecCon{} -> recordPatSynErr loc pat
-           ; return $ cL loc match }
-    fromDecl (dL->L loc decl) = extraDeclErr loc decl
+           ; return $ L loc match }
+    fromDecl (L loc decl) = extraDeclErr loc decl
 
     extraDeclErr loc decl =
         addFatalError loc $
@@ -672,7 +669,7 @@ mkGadtDecl :: [Located RdrName]
 mkGadtDecl names ty
   = (ConDeclGADT { con_g_ext  = noExtField
                  , con_names  = names
-                 , con_forall = cL l $ isLHsForAllTy ty'
+                 , con_forall = L l $ isLHsForAllTy ty'
                  , con_qvars  = mkHsQTvs tvs
                  , con_mb_cxt = mcxt
                  , con_args   = args
@@ -680,13 +677,13 @@ mkGadtDecl names ty
                  , con_doc    = Nothing }
     , anns1 ++ anns2)
   where
-    (ty'@(dL->L l _),anns1) = peel_parens ty []
+    (ty'@(L l _),anns1) = peel_parens ty []
     (tvs, rho) = splitLHsForAllTyInvis ty'
     (mcxt, tau, anns2) = split_rho rho []
 
-    split_rho (dL->L _ (HsQualTy { hst_ctxt = cxt, hst_body = tau })) ann
+    split_rho (L _ (HsQualTy { hst_ctxt = cxt, hst_body = tau })) ann
       = (Just cxt, tau, ann)
-    split_rho (dL->L l (HsParTy _ ty)) ann
+    split_rho (L l (HsParTy _ ty)) ann
       = split_rho ty (ann++mkParensApiAnn l)
     split_rho tau                  ann
       = (Nothing, tau, ann)
@@ -694,12 +691,12 @@ mkGadtDecl names ty
     (args, res_ty) = split_tau tau
 
     -- See Note [GADT abstract syntax] in GHC.Hs.Decls
-    split_tau (dL->L _ (HsFunTy _ (dL->L loc (HsRecTy _ rf)) res_ty))
-      = (RecCon (cL loc rf), res_ty)
+    split_tau (L _ (HsFunTy _ (L loc (HsRecTy _ rf)) res_ty))
+      = (RecCon (L loc rf), res_ty)
     split_tau tau
       = (PrefixCon [], tau)
 
-    peel_parens (dL->L l (HsParTy _ ty)) ann = peel_parens ty
+    peel_parens (L l (HsParTy _ ty)) ann = peel_parens ty
                                                        (ann++mkParensApiAnn l)
     peel_parens ty                   ann = (ty, ann)
 
@@ -823,19 +820,18 @@ checkTyVars pp_what equals_or_where tc tparms
         -- Keep around an action for adjusting the annotations of extra parens
     chkParens :: [AddAnn] -> LHsType GhcPs
               -> P (LHsTyVarBndr GhcPs, [AddAnn])
-    chkParens acc (dL->L l (HsParTy _ ty)) = chkParens (mkParensApiAnn l
-                                                        ++ acc) ty
+    chkParens acc (L l (HsParTy _ ty)) = chkParens (mkParensApiAnn l ++ acc) ty
     chkParens acc ty = do
       tv <- chk ty
       return (tv, reverse acc)
 
         -- Check that the name space is correct!
     chk :: LHsType GhcPs -> P (LHsTyVarBndr GhcPs)
-    chk (dL->L l (HsKindSig _ (dL->L lv (HsTyVar _ _ (dL->L _ tv))) k))
-        | isRdrTyVar tv    = return (cL l (KindedTyVar noExtField (cL lv tv) k))
-    chk (dL->L l (HsTyVar _ _ (dL->L ltv tv)))
-        | isRdrTyVar tv    = return (cL l (UserTyVar noExtField (cL ltv tv)))
-    chk t@(dL->L loc _)
+    chk (L l (HsKindSig _ (L lv (HsTyVar _ _ (L _ tv))) k))
+        | isRdrTyVar tv    = return (L l (KindedTyVar noExtField (L lv tv) k))
+    chk (L l (HsTyVar _ _ (L ltv tv)))
+        | isRdrTyVar tv    = return (L l (UserTyVar noExtField (L ltv tv)))
+    chk t@(L loc _)
         = addFatalError loc $
                 vcat [ text "Unexpected type" <+> quotes (ppr t)
                      , text "In the" <+> pp_what
@@ -893,14 +889,14 @@ mkRuleTyVarBndrs = fmap (fmap cvt_one)
 -- See note [Parsing explicit foralls in Rules] in Parser.y
 checkRuleTyVarBndrNames :: [LHsTyVarBndr GhcPs] -> P ()
 checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName)
-  where check (dL->L loc (Unqual occ)) = do
+  where check (L loc (Unqual occ)) = do
           when ((occNameString occ ==) `any` ["forall","family","role"])
                (addFatalError loc (text $ "parse error on input "
                                     ++ occNameString occ))
         check _ = panic "checkRuleTyVarBndrNames"
 
 checkRecordSyntax :: (MonadP m, Outputable a) => Located a -> m (Located a)
-checkRecordSyntax lr@(dL->L loc r)
+checkRecordSyntax lr@(L loc r)
     = do allowed <- getBit TraditionalRecordSyntaxBit
          unless allowed $ addError loc $
            text "Illegal record syntax (use TraditionalRecordSyntax):" <+> ppr r
@@ -910,7 +906,7 @@ checkRecordSyntax lr@(dL->L loc r)
 -- `data T where` to avoid affecting existing error message, see #8258.
 checkEmptyGADTs :: Located ([AddAnn], [LConDecl GhcPs])
                 -> P (Located ([AddAnn], [LConDecl GhcPs]))
-checkEmptyGADTs gadts@(dL->L span (_, []))           -- Empty GADT declaration.
+checkEmptyGADTs gadts@(L span (_, []))           -- Empty GADT declaration.
     = do gadtSyntax <- getBit GadtSyntaxBit   -- GADTs implies GADTSyntax
          unless gadtSyntax $ addError span $ vcat
            [ text "Illegal keyword 'where' in data declaration"
@@ -934,23 +930,23 @@ checkTyClHdr :: Bool               -- True  <=> class header
 checkTyClHdr is_cls ty
   = goL ty [] [] Prefix
   where
-    goL (dL->L l ty) acc ann fix = go l ty acc ann fix
+    goL (L l ty) acc ann fix = go l ty acc ann fix
 
     -- workaround to define '*' despite StarIsType
-    go lp (HsParTy _ (dL->L l (HsStarTy _ isUni))) acc ann fix
+    go lp (HsParTy _ (L l (HsStarTy _ isUni))) acc ann fix
       = do { warnStarBndr l
            ; let name = mkOccName tcClsName (starSym isUni)
-           ; return (cL l (Unqual name), acc, fix, (ann ++ mkParensApiAnn lp)) }
+           ; return (L l (Unqual name), acc, fix, (ann ++ mkParensApiAnn lp)) }
 
-    go _ (HsTyVar _ _ ltc@(dL->L _ tc)) acc ann fix
+    go _ (HsTyVar _ _ ltc@(L _ tc)) acc ann fix
       | isRdrTc tc               = return (ltc, acc, fix, ann)
-    go _ (HsOpTy _ t1 ltc@(dL->L _ tc) t2) acc ann _fix
+    go _ (HsOpTy _ t1 ltc@(L _ tc) t2) acc ann _fix
       | isRdrTc tc               = return (ltc, HsValArg t1:HsValArg t2:acc, Infix, ann)
     go l (HsParTy _ ty)    acc ann fix = goL ty acc (ann ++mkParensApiAnn l) fix
     go _ (HsAppTy _ t1 t2) acc ann fix = goL t1 (HsValArg t2:acc) ann fix
     go _ (HsAppKindTy l ty ki) acc ann fix = goL ty (HsTypeArg l ki:acc) ann fix
     go l (HsTupleTy _ HsBoxedOrConstraintTuple ts) [] ann fix
-      = return (cL l (nameRdrName tup_name), map HsValArg ts, fix, ann)
+      = return (L l (nameRdrName tup_name), map HsValArg ts, fix, ann)
       where
         arity = length ts
         tup_name | is_cls    = cTupleTyConName arity
@@ -987,7 +983,7 @@ checkCmdBlockArguments :: LHsCmd GhcPs -> PV ()
       HsCmdDo {} -> check "do command" cmd
       _ -> return ()
 
-    check :: (HasSrcSpan a, Outputable a) => String -> a -> PV ()
+    check :: Outputable a => String -> Located a -> PV ()
     check element a = do
       blockArguments <- getBit BlockArgumentsBit
       unless blockArguments $
@@ -1007,22 +1003,22 @@ checkCmdBlockArguments :: LHsCmd GhcPs -> PV ()
 --     (((Eq a)))           -->  [Eq a]
 -- @
 checkContext :: LHsType GhcPs -> P ([AddAnn],LHsContext GhcPs)
-checkContext (dL->L l orig_t)
-  = check [] (cL l orig_t)
+checkContext (L l orig_t)
+  = check [] (L l orig_t)
  where
-  check anns (dL->L lp (HsTupleTy _ HsBoxedOrConstraintTuple ts))
+  check anns (L lp (HsTupleTy _ HsBoxedOrConstraintTuple ts))
     -- (Eq a, Ord b) shows up as a tuple type. Only boxed tuples can
     -- be used as context constraints.
-    = return (anns ++ mkParensApiAnn lp,cL l ts)                -- Ditto ()
+    = return (anns ++ mkParensApiAnn lp,L l ts)                -- Ditto ()
 
-  check anns (dL->L lp1 (HsParTy _ ty))
+  check anns (L lp1 (HsParTy _ ty))
                                   -- to be sure HsParTy doesn't get into the way
        = check anns' ty
          where anns' = if l == lp1 then anns
                                    else (anns ++ mkParensApiAnn lp1)
 
   -- no need for anns, returning original
-  check _anns t = checkNoDocs msg t *> return ([],cL l [cL l orig_t])
+  check _anns t = checkNoDocs msg t *> return ([],L l [L l orig_t])
 
   msg = text "data constructor context"
 
@@ -1031,9 +1027,9 @@ checkContext (dL->L l orig_t)
 checkNoDocs :: SDoc -> LHsType GhcPs -> P ()
 checkNoDocs msg ty = go ty
   where
-    go (dL->L _ (HsAppKindTy _ ty ki)) = go ty *> go ki
-    go (dL->L _ (HsAppTy _ t1 t2)) = go t1 *> go t2
-    go (dL->L l (HsDocTy _ t ds)) = addError l $ hsep
+    go (L _ (HsAppKindTy _ ty ki)) = go ty *> go ki
+    go (L _ (HsAppTy _ t1 t2)) = go t1 *> go t2
+    go (L l (HsDocTy _ t ds)) = addError l $ hsep
                                   [ text "Unexpected haddock", quotes (ppr ds)
                                   , text "on", msg, quotes (ppr t) ]
     go _ = pure ()
@@ -1076,21 +1072,21 @@ checkPattern_msg :: SDoc -> PV (Located (PatBuilder GhcPs)) -> P (LPat GhcPs)
 checkPattern_msg msg pp = runPV_msg msg (pp >>= checkLPat)
 
 checkLPat :: Located (PatBuilder GhcPs) -> PV (LPat GhcPs)
-checkLPat e@(dL->L l _) = checkPat l e []
+checkLPat e@(L l _) = checkPat l e []
 
 checkPat :: SrcSpan -> Located (PatBuilder GhcPs) -> [LPat GhcPs]
          -> PV (LPat GhcPs)
-checkPat loc (dL->L l e@(PatBuilderVar (dL->L _ c))) args
-  | isRdrDataCon c = return (cL loc (ConPatIn (cL l c) (PrefixCon args)))
+checkPat loc (L l e@(PatBuilderVar (L _ c))) args
+  | isRdrDataCon c = return (L loc (ConPatIn (L l c) (PrefixCon args)))
   | not (null args) && patIsRec c =
       localPV_msg (\_ -> text "Perhaps you intended to use RecursiveDo") $
       patFail l (ppr e)
-checkPat loc (dL->L _ (PatBuilderApp f e)) args
+checkPat loc (L _ (PatBuilderApp f e)) args
   = do p <- checkLPat e
        checkPat loc f (p : args)
-checkPat loc (dL->L _ e) []
+checkPat loc (L _ e) []
   = do p <- checkAPat loc e
-       return (cL loc p)
+       return (L loc p)
 checkPat loc e _
   = patFail loc (ppr e)
 
@@ -1104,21 +1100,21 @@ checkAPat loc e0 = do
    -- Overloaded numeric patterns (e.g. f 0 x = x)
    -- Negation is recorded separately, so that the literal is zero or +ve
    -- NB. Negative *primitive* literals are already handled by the lexer
-   PatBuilderOverLit pos_lit -> return (mkNPat (cL loc pos_lit) Nothing)
+   PatBuilderOverLit pos_lit -> return (mkNPat (L loc pos_lit) Nothing)
 
    -- n+k patterns
    PatBuilderOpApp
-           (dL->L nloc (PatBuilderVar (dL->L _ n)))
-           (dL->L _ plus)
-           (dL->L lloc (PatBuilderOverLit lit@(OverLit {ol_val = HsIntegral {}})))
+           (L nloc (PatBuilderVar (L _ n)))
+           (L _ plus)
+           (L lloc (PatBuilderOverLit lit@(OverLit {ol_val = HsIntegral {}})))
                       | nPlusKPatterns && (plus == plus_RDR)
-                      -> return (mkNPlusKPat (cL nloc n) (cL lloc lit))
+                      -> return (mkNPlusKPat (L nloc n) (L lloc lit))
 
-   PatBuilderOpApp l (dL->L cl c) r
+   PatBuilderOpApp l (L cl c) r
      | isRdrDataCon c -> do
          l <- checkLPat l
          r <- checkLPat r
-         return (ConPatIn (cL cl c) (InfixCon l r))
+         return (ConPatIn (L cl c) (InfixCon l r))
 
    PatBuilderPar e    -> checkLPat e >>= (return . (ParPat noExtField))
    _           -> patFail loc (ppr e0)
@@ -1135,8 +1131,8 @@ pun_RDR  = mkUnqual varName (fsLit "pun-right-hand-side")
 
 checkPatField :: LHsRecField GhcPs (Located (PatBuilder GhcPs))
               -> PV (LHsRecField GhcPs (LPat GhcPs))
-checkPatField (dL->L l fld) = do p <- checkLPat (hsRecFieldArg fld)
-                                 return (cL l (fld { hsRecFieldArg = p }))
+checkPatField (L l fld) = do p <- checkLPat (hsRecFieldArg fld)
+                             return (L l (fld { hsRecFieldArg = p }))
 
 patFail :: SrcSpan -> SDoc -> PV a
 patFail loc e = addFatalError loc $ text "Parse error in pattern:" <+> ppr e
@@ -1157,12 +1153,12 @@ checkValDef lhs (Just sig) grhss
   = do lhs' <- runPV $ mkHsTySigPV (combineLocs lhs sig) lhs sig >>= checkLPat
        checkPatBind lhs' grhss
 
-checkValDef lhs Nothing g@(dL->L l (_,grhss))
+checkValDef lhs Nothing g@(L l (_,grhss))
   = do  { mb_fun <- isFunLhs lhs
         ; case mb_fun of
             Just (fun, is_infix, pats, ann) ->
               checkFunBind NoSrcStrict ann (getLoc lhs)
-                           fun is_infix pats (cL l grhss)
+                           fun is_infix pats (L l grhss)
             Nothing -> do
               lhs' <- checkPattern lhs
               checkPatBind lhs' g }
@@ -1175,19 +1171,19 @@ checkFunBind :: SrcStrictness
              -> [Located (PatBuilder GhcPs)]
              -> Located (GRHSs GhcPs (LHsExpr GhcPs))
              -> P ([AddAnn],HsBind GhcPs)
-checkFunBind strictness ann lhs_loc fun is_infix pats (dL->L rhs_span grhss)
+checkFunBind strictness ann lhs_loc fun is_infix pats (L rhs_span grhss)
   = do  ps <- mapM checkPattern pats
         let match_span = combineSrcSpans lhs_loc rhs_span
         -- Add back the annotations stripped from any HsPar values in the lhs
         -- mapM_ (\a -> a match_span) ann
         return (ann, makeFunBind fun
-                  [cL match_span (Match { m_ext = noExtField
-                                        , m_ctxt = FunRhs
-                                            { mc_fun    = fun
-                                            , mc_fixity = is_infix
-                                            , mc_strictness = strictness }
-                                        , m_pats = ps
-                                        , m_grhss = grhss })])
+                  [L match_span (Match { m_ext = noExtField
+                                       , m_ctxt = FunRhs
+                                           { mc_fun    = fun
+                                           , mc_fixity = is_infix
+                                           , mc_strictness = strictness }
+                                       , m_pats = ps
+                                       , m_grhss = grhss })])
         -- The span of the match covers the entire equation.
         -- That isn't quite right, but it'll do for now.
 
@@ -1205,28 +1201,28 @@ makeFunBind fn ms
 checkPatBind :: LPat GhcPs
              -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
              -> P ([AddAnn],HsBind GhcPs)
-checkPatBind lhs (dL->L match_span (_,grhss))
+checkPatBind lhs (L match_span (_,grhss))
     | BangPat _ p <- unLoc lhs
     , VarPat _ v <- unLoc p
-    = return ([], makeFunBind v [cL match_span (m v)])
+    = return ([], makeFunBind v [L match_span (m v)])
   where
     m v = Match { m_ext = noExtField
-                , m_ctxt = FunRhs { mc_fun    = cL (getLoc lhs) (unLoc v)
+                , m_ctxt = FunRhs { mc_fun    = L (getLoc lhs) (unLoc v)
                                   , mc_fixity = Prefix
                                   , mc_strictness = SrcStrict }
                 , m_pats = []
                 , m_grhss = grhss }
 
-checkPatBind lhs (dL->L _ (_,grhss))
+checkPatBind lhs (L _ (_,grhss))
   = return ([],PatBind noExtField lhs grhss ([],[]))
 
 checkValSigLhs :: LHsExpr GhcPs -> P (Located RdrName)
-checkValSigLhs (dL->L _ (HsVar _ lrdr@(dL->L _ v)))
+checkValSigLhs (L _ (HsVar _ lrdr@(L _ v)))
   | isUnqual v
   , not (isDataOcc (rdrNameOcc v))
   = return lrdr
 
-checkValSigLhs lhs@(dL->L l _)
+checkValSigLhs lhs@(L l _)
   = addFatalError l ((text "Invalid type signature:" <+>
                        ppr lhs <+> text ":: ...")
                       $$ text hint)
@@ -1244,8 +1240,8 @@ checkValSigLhs lhs@(dL->L l _)
     -- so check for that, and suggest.  cf #3805
     -- Sadly 'foreign import' still barfs 'parse error' because
     --  'import' is a keyword
-    looks_like s (dL->L _ (HsVar _ (dL->L _ v))) = v == s
-    looks_like s (dL->L _ (HsApp _ lhs _))   = looks_like s lhs
+    looks_like s (L _ (HsVar _ (L _ v))) = v == s
+    looks_like s (L _ (HsApp _ lhs _))   = looks_like s lhs
     looks_like _ _                       = False
 
     foreign_RDR = mkUnqual varName (fsLit "foreign")
@@ -1253,8 +1249,8 @@ checkValSigLhs lhs@(dL->L l _)
     pattern_RDR = mkUnqual varName (fsLit "pattern")
 
 checkDoAndIfThenElse
-  :: (HasSrcSpan a, Outputable a, Outputable b, HasSrcSpan c, Outputable c)
-  => a -> Bool -> b -> Bool -> c -> PV ()
+  :: (Outputable a, Outputable b, Outputable c)
+  => Located a -> Bool -> b -> Bool -> Located c -> PV ()
 checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
  | semiThen || semiElse
     = do doAndIfThenElse <- getBit DoAndIfThenElseBit
@@ -1287,21 +1283,21 @@ isFunLhs :: Located (PatBuilder GhcPs)
 
 isFunLhs e = go e [] []
  where
-   go (dL->L loc (PatBuilderVar (dL->L _ f))) es ann
-       | not (isRdrDataCon f)        = return (Just (cL loc f, Prefix, es, ann))
-   go (dL->L _ (PatBuilderApp f e)) es       ann = go f (e:es) ann
-   go (dL->L l (PatBuilderPar e))   es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)
-   go (dL->L loc (PatBuilderOpApp l (dL->L loc' op) r)) es ann
+   go (L loc (PatBuilderVar (L _ f))) es ann
+       | not (isRdrDataCon f)        = return (Just (L loc f, Prefix, es, ann))
+   go (L _ (PatBuilderApp f e)) es       ann = go f (e:es) ann
+   go (L l (PatBuilderPar e))   es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)
+   go (L loc (PatBuilderOpApp l (L loc' op) r)) es ann
         | not (isRdrDataCon op)         -- We have found the function!
-        = return (Just (cL loc' op, Infix, (l:r:es), ann))
+        = return (Just (L loc' op, Infix, (l:r:es), ann))
         | otherwise                     -- Infix data con; keep going
         = do { mb_l <- go l es ann
              ; case mb_l of
                  Just (op', Infix, j : k : es', ann')
                    -> return (Just (op', Infix, j : op_app : es', ann'))
                    where
-                     op_app = cL loc (PatBuilderOpApp k
-                               (cL loc' op) r)
+                     op_app = L loc (PatBuilderOpApp k
+                               (L loc' op) r)
                  _ -> return Nothing }
    go _ _ _ = return Nothing
 
@@ -1343,7 +1339,7 @@ pUnpackedness
            , SourceText
            , SrcUnpackedness
            , [Located TyEl] {- remaining TyEl -})
-pUnpackedness ((dL->L l x1) : xs)
+pUnpackedness (L l x1 : xs)
   | TyElUnpackedness (anns, prag, unpk) <- x1
   = Just (l, anns, prag, unpk, xs)
 pUnpackedness _ = Nothing
@@ -1355,13 +1351,13 @@ pBangTy
      , LHsType GhcPs  {- the resulting BangTy -}
      , P ()           {- add annotations -}
      , [Located TyEl] {- remaining TyEl -})
-pBangTy lt@(dL->L l1 _) xs =
+pBangTy lt@(L l1 _) xs =
   case pUnpackedness xs of
     Nothing -> (False, lt, pure (), xs)
     Just (l2, anns, prag, unpk, xs') ->
       let bl = combineSrcSpans l1 l2
           bt = addUnpackedness (prag, unpk) lt
-      in (True, cL bl bt, addAnnsAt bl anns, xs')
+      in (True, L bl bt, addAnnsAt bl anns, xs')
 
 mkBangTy :: SrcStrictness -> LHsType GhcPs -> HsType GhcPs
 mkBangTy strictness =
@@ -1387,8 +1383,8 @@ addUnpackedness (prag, unpk) t
 --
 -- See Note [Parsing data constructors is hard]
 mergeOps :: [Located TyEl] -> P (LHsType GhcPs)
-mergeOps ((dL->L l1 (TyElOpd t)) : xs)
-  | (_, t', addAnns, xs') <- pBangTy (cL l1 t) xs
+mergeOps ((L l1 (TyElOpd t)) : xs)
+  | (_, t', addAnns, xs') <- pBangTy (L l1 t) xs
   , null xs' -- We accept a BangTy only when there are no preceding TyEl.
   = addAnns >> return t'
 mergeOps all_xs = go (0 :: Int) [] id all_xs
@@ -1398,7 +1394,7 @@ mergeOps all_xs = go (0 :: Int) [] id all_xs
 
     -- clause [unpk]:
     -- handle (NO)UNPACK pragmas
-    go k acc ops_acc ((dL->L l (TyElUnpackedness (anns, unpkSrc, unpk))):xs) =
+    go k acc ops_acc ((L l (TyElUnpackedness (anns, unpkSrc, unpk))):xs) =
       if not (null acc) && null xs
       then do { acc' <- eitherToP $ mergeOpsAcc acc
               ; let a = ops_acc acc'
@@ -1406,7 +1402,7 @@ mergeOps all_xs = go (0 :: Int) [] id all_xs
                     bl = combineSrcSpans l (getLoc a)
                     bt = HsBangTy noExtField strictMark a
               ; addAnnsAt bl anns
-              ; return (cL bl bt) }
+              ; return (L bl bt) }
       else addFatalError l unpkError
       where
         unpkSDoc = case unpkSrc of
@@ -1421,38 +1417,35 @@ mergeOps all_xs = go (0 :: Int) [] id all_xs
 
     -- clause [doc]:
     -- we do not expect to encounter any docs
-    go _ _ _ ((dL->L l (TyElDocPrev _)):_) =
+    go _ _ _ ((L l (TyElDocPrev _)):_) =
       failOpDocPrev l
 
     -- clause [opr]:
     -- when we encounter an operator, we must have accumulated
     -- something for its rhs, and there must be something left
     -- to build its lhs.
-    go k acc ops_acc ((dL->L l (TyElOpr op)):xs) =
+    go k acc ops_acc ((L l (TyElOpr op)):xs) =
       if null acc || null (filter isTyElOpd xs)
-        then failOpFewArgs (cL l op)
+        then failOpFewArgs (L l op)
         else do { acc' <- eitherToP (mergeOpsAcc acc)
-                ; go (k + 1) [] (\c -> mkLHsOpTy c (cL l op) (ops_acc acc')) xs }
+                ; go (k + 1) [] (\c -> mkLHsOpTy c (L l op) (ops_acc acc')) xs }
       where
-        isTyElOpd (dL->L _ (TyElOpd _)) = True
+        isTyElOpd (L _ (TyElOpd _)) = True
         isTyElOpd _ = False
 
     -- clause [opd]:
     -- whenever an operand is encountered, it is added to the accumulator
-    go k acc ops_acc ((dL->L l (TyElOpd a)):xs) = go k (HsValArg (cL l a):acc) ops_acc xs
+    go k acc ops_acc ((L l (TyElOpd a)):xs) = go k (HsValArg (L l a):acc) ops_acc xs
 
     -- clause [tyapp]:
     -- whenever a type application is encountered, it is added to the accumulator
-    go k acc ops_acc ((dL->L _ (TyElKindApp l a)):xs) = go k (HsTypeArg l a:acc) ops_acc xs
+    go k acc ops_acc ((L _ (TyElKindApp l a)):xs) = go k (HsTypeArg l a:acc) ops_acc xs
 
     -- clause [end]
     -- See Note [Non-empty 'acc' in mergeOps clause [end]]
     go _ acc ops_acc [] = do { acc' <- eitherToP (mergeOpsAcc acc)
                              ; return (ops_acc acc') }
 
-    go _ _ _ _ = panic "mergeOps.go: Impossible Match"
-                        -- due to #15884
-
 mergeOpsAcc :: [HsArg (LHsType GhcPs) (LHsKind GhcPs)]
          -> Either (SrcSpan, SDoc) (LHsType GhcPs)
 mergeOpsAcc [] = panic "mergeOpsAcc: empty input"
@@ -1524,8 +1517,8 @@ Therefore, it is safe to omit a check for non-emptiness of 'acc' in clause
 -}
 
 pInfixSide :: [Located TyEl] -> Maybe (LHsType GhcPs, P (), [Located TyEl])
-pInfixSide ((dL->L l (TyElOpd t)):xs)
-  | (True, t', addAnns, xs') <- pBangTy (cL l t) xs
+pInfixSide ((L l (TyElOpd t)):xs)
+  | (True, t', addAnns, xs') <- pBangTy (L l t) xs
   = Just (t', addAnns, xs')
 pInfixSide (el:xs1)
   | Just t1 <- pLHsTypeArg el
@@ -1542,15 +1535,15 @@ pInfixSide (el:xs1)
 pInfixSide _ = Nothing
 
 pLHsTypeArg :: Located TyEl -> Maybe (HsArg (LHsType GhcPs) (LHsKind GhcPs))
-pLHsTypeArg (dL->L l (TyElOpd a)) = Just (HsValArg (L l a))
-pLHsTypeArg (dL->L _ (TyElKindApp l a)) = Just (HsTypeArg l a)
+pLHsTypeArg (L l (TyElOpd a)) = Just (HsValArg (L l a))
+pLHsTypeArg (L _ (TyElKindApp l a)) = Just (HsTypeArg l a)
 pLHsTypeArg _ = Nothing
 
 pDocPrev :: [Located TyEl] -> (Maybe LHsDocString, [Located TyEl])
 pDocPrev = go Nothing
   where
-    go mTrailingDoc ((dL->L l (TyElDocPrev doc)):xs) =
-      go (mTrailingDoc `mplus` Just (cL l doc)) xs
+    go mTrailingDoc ((L l (TyElDocPrev doc)):xs) =
+      go (mTrailingDoc `mplus` Just (L l doc)) xs
     go mTrailingDoc xs = (mTrailingDoc, xs)
 
 orErr :: Maybe a -> b -> Either b a
@@ -1648,7 +1641,7 @@ mergeDataCon all_xs =
     --             A -- ^ Comment on A
     --             B -- ^ Comment on B (singleDoc == False)
     singleDoc = isJust mTrailingDoc &&
-                null [ () | (dL->L _ (TyElDocPrev _)) <- all_xs' ]
+                null [ () | (L _ (TyElDocPrev _)) <- all_xs' ]
 
     -- The result of merging the list of reversed TyEl into a
     -- data constructor, along with [AddAnn].
@@ -1670,38 +1663,38 @@ mergeDataCon all_xs =
     trailingFieldDoc | singleDoc = Nothing
                      | otherwise = mTrailingDoc
 
-    goFirst [ dL->L l (TyElOpd (HsTyVar _ _ (dL->L _ tc))) ]
+    goFirst [ L l (TyElOpd (HsTyVar _ _ (L _ tc))) ]
       = do { data_con <- tyConToDataCon l tc
            ; return (pure (), (data_con, PrefixCon [], mTrailingDoc)) }
-    goFirst ((dL->L l (TyElOpd (HsRecTy _ fields))):xs)
+    goFirst ((L l (TyElOpd (HsRecTy _ fields))):xs)
       | (mConDoc, xs') <- pDocPrev xs
-      , [ dL->L l' (TyElOpd (HsTyVar _ _ (dL->L _ tc))) ] <- xs'
+      , [ L l' (TyElOpd (HsTyVar _ _ (L _ tc))) ] <- xs'
       = do { data_con <- tyConToDataCon l' tc
            ; let mDoc = mTrailingDoc `mplus` mConDoc
-           ; return (pure (), (data_con, RecCon (cL l fields), mDoc)) }
-    goFirst [dL->L l (TyElOpd (HsTupleTy _ HsBoxedOrConstraintTuple ts))]
+           ; return (pure (), (data_con, RecCon (L l fields), mDoc)) }
+    goFirst [L l (TyElOpd (HsTupleTy _ HsBoxedOrConstraintTuple ts))]
       = return ( pure ()
-               , ( cL l (getRdrName (tupleDataCon Boxed (length ts)))
+               , ( L l (getRdrName (tupleDataCon Boxed (length ts)))
                  , PrefixCon ts
                  , mTrailingDoc ) )
-    goFirst ((dL->L l (TyElOpd t)):xs)
-      | (_, t', addAnns, xs') <- pBangTy (cL l t) xs
+    goFirst ((L l (TyElOpd t)):xs)
+      | (_, t', addAnns, xs') <- pBangTy (L l t) xs
       = go addAnns Nothing [mkLHsDocTyMaybe t' trailingFieldDoc] xs'
     goFirst (L l (TyElKindApp _ _):_)
       = goInfix Monoid.<> Left (l, kindAppErr)
     goFirst xs
       = go (pure ()) mTrailingDoc [] xs
 
-    go addAnns mLastDoc ts [ dL->L l (TyElOpd (HsTyVar _ _ (dL->L _ tc))) ]
+    go addAnns mLastDoc ts [ L l (TyElOpd (HsTyVar _ _ (L _ tc))) ]
       = do { data_con <- tyConToDataCon l tc
            ; return (addAnns, (data_con, PrefixCon ts, mkConDoc mLastDoc)) }
-    go addAnns mLastDoc ts ((dL->L l (TyElDocPrev doc)):xs) =
-      go addAnns (mLastDoc `mplus` Just (cL l doc)) ts xs
-    go addAnns mLastDoc ts ((dL->L l (TyElOpd t)):xs)
-      | (_, t', addAnns', xs') <- pBangTy (cL l t) xs
+    go addAnns mLastDoc ts ((L l (TyElDocPrev doc)):xs) =
+      go addAnns (mLastDoc `mplus` Just (L l doc)) ts xs
+    go addAnns mLastDoc ts ((L l (TyElOpd t)):xs)
+      | (_, t', addAnns', xs') <- pBangTy (L l t) xs
       , t'' <- mkLHsDocTyMaybe t' mLastDoc
       = go (addAnns >> addAnns') Nothing (t'':ts) xs'
-    go _ _ _ ((dL->L _ (TyElOpr _)):_) =
+    go _ _ _ ((L _ (TyElOpr _)):_) =
       -- Encountered an operator: backtrack to the beginning and attempt
       -- to parse as an infix definition.
       goInfix
@@ -1719,7 +1712,7 @@ mergeDataCon all_xs =
          ; (rhs_t, rhs_addAnns, xs1) <- pInfixSide xs0 `orErr` malformedErr
          ; let (mOpDoc, xs2) = pDocPrev xs1
          ; (op, xs3) <- case xs2 of
-              (dL->L l (TyElOpr op)) : xs3 ->
+              (L l (TyElOpr op)) : xs3 ->
                 do { data_con <- tyConToDataCon l op
                    ; return (data_con, xs3) }
               _ -> Left malformedErr
@@ -1782,13 +1775,13 @@ class DisambInfixOp b where
   mkHsInfixHolePV :: SrcSpan -> PV (Located b)
 
 instance p ~ GhcPs => DisambInfixOp (HsExpr p) where
-  mkHsVarOpPV v = return $ cL (getLoc v) (HsVar noExtField v)
-  mkHsConOpPV v = return $ cL (getLoc v) (HsVar noExtField v)
-  mkHsInfixHolePV l = return $ cL l hsHoleExpr
+  mkHsVarOpPV v = return $ L (getLoc v) (HsVar noExtField v)
+  mkHsConOpPV v = return $ L (getLoc v) (HsVar noExtField v)
+  mkHsInfixHolePV l = return $ L l hsHoleExpr
 
 instance DisambInfixOp RdrName where
-  mkHsConOpPV (dL->L l v) = return $ cL l v
-  mkHsVarOpPV (dL->L l v) = return $ cL l v
+  mkHsConOpPV (L l v) = return $ L l v
+  mkHsVarOpPV (L l v) = return $ L l v
   mkHsInfixHolePV l =
     addFatalError l $ text "Invalid infix hole, expected an infix operator"
 
@@ -1915,34 +1908,34 @@ typechecker.
 instance p ~ GhcPs => DisambECP (HsCmd p) where
   type Body (HsCmd p) = HsCmd
   ecpFromCmd' = return
-  ecpFromExp' (dL-> L l e) = cmdFail l (ppr e)
-  mkHsLamPV l mg = return $ cL l (HsCmdLam noExtField mg)
-  mkHsLetPV l bs e = return $ cL l (HsCmdLet noExtField bs e)
+  ecpFromExp' (L l e) = cmdFail l (ppr e)
+  mkHsLamPV l mg = return $ L l (HsCmdLam noExtField mg)
+  mkHsLetPV l bs e = return $ L l (HsCmdLet noExtField bs e)
   type InfixOp (HsCmd p) = HsExpr p
   superInfixOp m = m
   mkHsOpAppPV l c1 op c2 = do
-    let cmdArg c = cL (getLoc c) $ HsCmdTop noExtField c
-    return $ cL l $ HsCmdArrForm noExtField op Infix Nothing [cmdArg c1, cmdArg c2]
-  mkHsCasePV l c mg = return $ cL l (HsCmdCase noExtField c mg)
+    let cmdArg c = L (getLoc c) $ HsCmdTop noExtField c
+    return $ L l $ HsCmdArrForm noExtField op Infix Nothing [cmdArg c1, cmdArg c2]
+  mkHsCasePV l c mg = return $ L l (HsCmdCase noExtField c mg)
   type FunArg (HsCmd p) = HsExpr p
   superFunArg m = m
   mkHsAppPV l c e = do
     checkCmdBlockArguments c
     checkExpBlockArguments e
-    return $ cL l (HsCmdApp noExtField c e)
+    return $ L l (HsCmdApp noExtField c e)
   mkHsIfPV l c semi1 a semi2 b = do
     checkDoAndIfThenElse c semi1 a semi2 b
-    return $ cL l (mkHsCmdIf c a b)
-  mkHsDoPV l stmts = return $ cL l (HsCmdDo noExtField stmts)
-  mkHsParPV l c = return $ cL l (HsCmdPar noExtField c)
-  mkHsVarPV (dL->L l v) = cmdFail l (ppr v)
-  mkHsLitPV (dL->L l a) = cmdFail l (ppr a)
-  mkHsOverLitPV (dL->L l a) = cmdFail l (ppr a)
+    return $ L l (mkHsCmdIf c a b)
+  mkHsDoPV l stmts = return $ L l (HsCmdDo noExtField stmts)
+  mkHsParPV l c = return $ L l (HsCmdPar noExtField c)
+  mkHsVarPV (L l v) = cmdFail l (ppr v)
+  mkHsLitPV (L l a) = cmdFail l (ppr a)
+  mkHsOverLitPV (L l a) = cmdFail l (ppr a)
   mkHsWildCardPV l = cmdFail l (text "_")
   mkHsTySigPV l a sig = cmdFail l (ppr a <+> text "::" <+> ppr sig)
   mkHsExplicitListPV l xs = cmdFail l $
     brackets (fsep (punctuate comma (map ppr xs)))
-  mkHsSplicePV (dL->L l sp) = cmdFail l (ppr sp)
+  mkHsSplicePV (L l sp) = cmdFail l (ppr sp)
   mkHsRecordPV l _ a (fbinds, ddLoc) = cmdFail l $
     ppr a <+> ppr (mk_rec_fields fbinds ddLoc)
   mkHsNegAppPV l a = cmdFail l (text "-" <> ppr a)
@@ -1966,42 +1959,42 @@ cmdFail loc e = addFatalError loc $
 
 instance p ~ GhcPs => DisambECP (HsExpr p) where
   type Body (HsExpr p) = HsExpr
-  ecpFromCmd' (dL -> L l c) = do
+  ecpFromCmd' (L l c) = do
     addError l $ vcat
       [ text "Arrow command found where an expression was expected:",
         nest 2 (ppr c) ]
-    return (cL l hsHoleExpr)
+    return (L l hsHoleExpr)
   ecpFromExp' = return
-  mkHsLamPV l mg = return $ cL l (HsLam noExtField mg)
-  mkHsLetPV l bs c = return $ cL l (HsLet noExtField bs c)
+  mkHsLamPV l mg = return $ L l (HsLam noExtField mg)
+  mkHsLetPV l bs c = return $ L l (HsLet noExtField bs c)
   type InfixOp (HsExpr p) = HsExpr p
   superInfixOp m = m
   mkHsOpAppPV l e1 op e2 = do
-    return $ cL l $ OpApp noExtField e1 op e2
-  mkHsCasePV l e mg = return $ cL l (HsCase noExtField e mg)
+    return $ L l $ OpApp noExtField e1 op e2
+  mkHsCasePV l e mg = return $ L l (HsCase noExtField e mg)
   type FunArg (HsExpr p) = HsExpr p
   superFunArg m = m
   mkHsAppPV l e1 e2 = do
     checkExpBlockArguments e1
     checkExpBlockArguments e2
-    return $ cL l (HsApp noExtField e1 e2)
+    return $ L l (HsApp noExtField e1 e2)
   mkHsIfPV l c semi1 a semi2 b = do
     checkDoAndIfThenElse c semi1 a semi2 b
-    return $ cL l (mkHsIf c a b)
-  mkHsDoPV l stmts = return $ cL l (HsDo noExtField DoExpr stmts)
-  mkHsParPV l e = return $ cL l (HsPar noExtField e)
-  mkHsVarPV v@(getLoc -> l) = return $ cL l (HsVar noExtField v)
-  mkHsLitPV (dL->L l a) = return $ cL l (HsLit noExtField a)
-  mkHsOverLitPV (dL->L l a) = return $ cL l (HsOverLit noExtField a)
-  mkHsWildCardPV l = return $ cL l hsHoleExpr
-  mkHsTySigPV l a sig = return $ cL l (ExprWithTySig noExtField a (mkLHsSigWcType sig))
-  mkHsExplicitListPV l xs = return $ cL l (ExplicitList noExtField Nothing xs)
+    return $ L l (mkHsIf c a b)
+  mkHsDoPV l stmts = return $ L l (HsDo noExtField DoExpr stmts)
+  mkHsParPV l e = return $ L l (HsPar noExtField e)
+  mkHsVarPV v@(getLoc -> l) = return $ L l (HsVar noExtField v)
+  mkHsLitPV (L l a) = return $ L l (HsLit noExtField a)
+  mkHsOverLitPV (L l a) = return $ L l (HsOverLit noExtField a)
+  mkHsWildCardPV l = return $ L l hsHoleExpr
+  mkHsTySigPV l a sig = return $ L l (ExprWithTySig noExtField a (mkLHsSigWcType sig))
+  mkHsExplicitListPV l xs = return $ L l (ExplicitList noExtField Nothing xs)
   mkHsSplicePV sp = return $ mapLoc (HsSpliceE noExtField) sp
   mkHsRecordPV l lrec a (fbinds, ddLoc) = do
     r <- mkRecConstrOrUpdate a lrec (fbinds, ddLoc)
-    checkRecordSyntax (cL l r)
-  mkHsNegAppPV l a = return $ cL l (NegApp noExtField a noSyntaxExpr)
-  mkHsSectionR_PV l op e = return $ cL l (SectionR noExtField op e)
+    checkRecordSyntax (L l r)
+  mkHsNegAppPV l a = return $ L l (NegApp noExtField a noSyntaxExpr)
+  mkHsSectionR_PV l op e = return $ L l (SectionR noExtField op e)
   mkHsViewPatPV l a b = patSynErr "View pattern" l (ppr a <+> text "->" <+> ppr b) empty
   mkHsAsPatPV l v e =
     patSynErr "@-pattern" l (pprPrefixOcc (unLoc v) <> text "@" <> ppr e) $
@@ -2018,7 +2011,7 @@ patSynErr item l e explanation =
         sep [text item <+> text "in expression context:",
              nest 4 (ppr e)] $$
         explanation
-     ; return (cL l hsHoleExpr) }
+     ; return (L l hsHoleExpr) }
 
 hsHoleExpr :: HsExpr (GhcPass id)
 hsHoleExpr = HsUnboundVar noExtField (mkVarOcc "_")
@@ -2042,10 +2035,10 @@ instance Outputable (PatBuilder GhcPs) where
 
 instance DisambECP (PatBuilder GhcPs) where
   type Body (PatBuilder GhcPs) = PatBuilder
-  ecpFromCmd' (dL-> L l c) =
+  ecpFromCmd' (L l c) =
     addFatalError l $
       text "Command syntax in pattern:" <+> ppr c
-  ecpFromExp' (dL-> L l e) =
+  ecpFromExp' (L l e) =
     addFatalError l $
       text "Expression syntax in pattern:" <+> ppr e
   mkHsLamPV l _ = addFatalError l $
@@ -2054,54 +2047,54 @@ instance DisambECP (PatBuilder GhcPs) where
   mkHsLetPV l _ _ = addFatalError l $ text "(let ... in ...)-syntax in pattern"
   type InfixOp (PatBuilder GhcPs) = RdrName
   superInfixOp m = m
-  mkHsOpAppPV l p1 op p2 = return $ cL l $ PatBuilderOpApp p1 op p2
+  mkHsOpAppPV l p1 op p2 = return $ L l $ PatBuilderOpApp p1 op p2
   mkHsCasePV l _ _ = addFatalError l $ text "(case ... of ...)-syntax in pattern"
   type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs
   superFunArg m = m
-  mkHsAppPV l p1 p2 = return $ cL l (PatBuilderApp p1 p2)
+  mkHsAppPV l p1 p2 = return $ L l (PatBuilderApp p1 p2)
   mkHsIfPV l _ _ _ _ _ = addFatalError l $ text "(if ... then ... else ...)-syntax in pattern"
   mkHsDoPV l _ = addFatalError l $ text "do-notation in pattern"
-  mkHsParPV l p = return $ cL l (PatBuilderPar p)
-  mkHsVarPV v@(getLoc -> l) = return $ cL l (PatBuilderVar v)
-  mkHsLitPV lit@(dL->L l a) = do
+  mkHsParPV l p = return $ L l (PatBuilderPar p)
+  mkHsVarPV v@(getLoc -> l) = return $ L l (PatBuilderVar v)
+  mkHsLitPV lit@(L l a) = do
     checkUnboxedStringLitPat lit
-    return $ cL l (PatBuilderPat (LitPat noExtField a))
-  mkHsOverLitPV (dL->L l a) = return $ cL l (PatBuilderOverLit a)
-  mkHsWildCardPV l = return $ cL l (PatBuilderPat (WildPat noExtField))
+    return $ L l (PatBuilderPat (LitPat noExtField a))
+  mkHsOverLitPV (L l a) = return $ L l (PatBuilderOverLit a)
+  mkHsWildCardPV l = return $ L l (PatBuilderPat (WildPat noExtField))
   mkHsTySigPV l b sig = do
     p <- checkLPat b
-    return $ cL l (PatBuilderPat (SigPat noExtField p (mkLHsSigWcType sig)))
+    return $ L l (PatBuilderPat (SigPat noExtField p (mkLHsSigWcType sig)))
   mkHsExplicitListPV l xs = do
     ps <- traverse checkLPat xs
-    return (cL l (PatBuilderPat (ListPat noExtField ps)))
-  mkHsSplicePV (dL->L l sp) = return $ cL l (PatBuilderPat (SplicePat noExtField sp))
+    return (L l (PatBuilderPat (ListPat noExtField ps)))
+  mkHsSplicePV (L l sp) = return $ L l (PatBuilderPat (SplicePat noExtField sp))
   mkHsRecordPV l _ a (fbinds, ddLoc) = do
     r <- mkPatRec a (mk_rec_fields fbinds ddLoc)
-    checkRecordSyntax (cL l r)
-  mkHsNegAppPV l (dL->L lp p) = do
+    checkRecordSyntax (L l r)
+  mkHsNegAppPV l (L lp p) = do
     lit <- case p of
-      PatBuilderOverLit pos_lit -> return (cL lp pos_lit)
+      PatBuilderOverLit pos_lit -> return (L lp pos_lit)
       _ -> patFail l (text "-" <> ppr p)
-    return $ cL l (PatBuilderPat (mkNPat lit (Just noSyntaxExpr)))
+    return $ L l (PatBuilderPat (mkNPat lit (Just noSyntaxExpr)))
   mkHsSectionR_PV l op p = patFail l (pprInfixOcc (unLoc op) <> ppr p)
   mkHsViewPatPV l a b = do
     p <- checkLPat b
-    return $ cL l (PatBuilderPat (ViewPat noExtField a p))
+    return $ L l (PatBuilderPat (ViewPat noExtField a p))
   mkHsAsPatPV l v e = do
     p <- checkLPat e
-    return $ cL l (PatBuilderPat (AsPat noExtField v p))
+    return $ L l (PatBuilderPat (AsPat noExtField v p))
   mkHsLazyPatPV l e = do
     p <- checkLPat e
-    return $ cL l (PatBuilderPat (LazyPat noExtField p))
+    return $ L l (PatBuilderPat (LazyPat noExtField p))
   mkHsBangPatPV l e = do
     p <- checkLPat e
     let pb = BangPat noExtField p
     hintBangPat l pb
-    return $ cL l (PatBuilderPat pb)
+    return $ L l (PatBuilderPat pb)
   mkSumOrTuplePV = mkSumOrTuplePat
 
 checkUnboxedStringLitPat :: Located (HsLit GhcPs) -> PV ()
-checkUnboxedStringLitPat (dL->L loc lit) =
+checkUnboxedStringLitPat (L loc lit) =
   case lit of
     HsStringPrim _ _  -- Trac #13260
       -> addFatalError loc (text "Illegal unboxed string literal in pattern:" $$ ppr lit)
@@ -2573,7 +2566,7 @@ checkPrecP
         :: Located (SourceText,Int)             -- ^ precedence
         -> Located (OrdList (Located RdrName))  -- ^ operators
         -> P ()
-checkPrecP (dL->L l (_,i)) (dL->L _ ol)
+checkPrecP (L l (_,i)) (L _ ol)
  | 0 <= i, i <= maxPrecedence = pure ()
  | all specialOp ol = pure ()
  | otherwise = addFatalError l (text ("Precedence out of range: " ++ show i))
@@ -2587,9 +2580,9 @@ mkRecConstrOrUpdate
         -> ([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)
         -> PV (HsExpr GhcPs)
 
-mkRecConstrOrUpdate (dL->L l (HsVar _ (dL->L _ c))) _ (fs,dd)
+mkRecConstrOrUpdate (L l (HsVar _ (L _ c))) _ (fs,dd)
   | isRdrDataCon c
-  = return (mkRdrRecordCon (cL l c) (mk_rec_fields fs dd))
+  = return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd))
 mkRecConstrOrUpdate exp _ (fs,dd)
   | Just dd_loc <- dd = addFatalError dd_loc (text "You cannot use `..' in a record update")
   | otherwise = return (mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) fs))
@@ -2607,15 +2600,13 @@ mkRdrRecordCon con flds
 mk_rec_fields :: [LHsRecField id arg] -> Maybe SrcSpan -> HsRecFields id arg
 mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
 mk_rec_fields fs (Just s)  = HsRecFields { rec_flds = fs
-                                     , rec_dotdot = Just (cL s (length fs)) }
+                                     , rec_dotdot = Just (L s (length fs)) }
 
 mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs
-mk_rec_upd_field (HsRecField (dL->L loc (FieldOcc _ rdr)) arg pun)
+mk_rec_upd_field (HsRecField (L loc (FieldOcc _ rdr)) arg pun)
   = HsRecField (L loc (Unambiguous noExtField rdr)) arg pun
-mk_rec_upd_field (HsRecField (dL->L _ (XFieldOcc nec)) _ _)
+mk_rec_upd_field (HsRecField (L _ (XFieldOcc nec)) _ _)
   = noExtCon nec
-mk_rec_upd_field (HsRecField _ _ _)
-  = panic "mk_rec_upd_field: Impossible Match" -- due to #15884
 
 mkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation
                -> InlinePragma
@@ -2658,7 +2649,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity), v, ty) =
     -- name (cf section 8.5.1 in Haskell 2010 report).
     mkCImport = do
       let e = unpackFS entity
-      case parseCImport cconv safety (mkExtName (unLoc v)) e (cL loc esrc) of
+      case parseCImport cconv safety (mkExtName (unLoc v)) e (L loc esrc) of
         Nothing         -> addFatalError loc (text "Malformed entity string")
         Just importSpec -> returnSpec importSpec
 
@@ -2670,7 +2661,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity), v, ty) =
                         then mkExtName (unLoc v)
                         else entity
         funcTarget = CFunction (StaticTarget esrc entity' Nothing True)
-        importSpec = CImport cconv safety Nothing funcTarget (cL loc esrc)
+        importSpec = CImport cconv safety Nothing funcTarget (L loc esrc)
 
     returnSpec spec = return $ ForD noExtField $ ForeignImport
           { fd_i_ext  = noExtField
@@ -2745,11 +2736,11 @@ parseCImport cconv safety nm str sourceText =
 mkExport :: Located CCallConv
          -> (Located StringLiteral, Located RdrName, LHsSigType GhcPs)
          -> P (HsDecl GhcPs)
-mkExport (dL->L lc cconv) (dL->L le (StringLiteral esrc entity), v, ty)
+mkExport (L lc cconv) (L le (StringLiteral esrc entity), v, ty)
  = return $ ForD noExtField $
    ForeignExport { fd_e_ext = noExtField, fd_name = v, fd_sig_ty = ty
-                 , fd_fe = CExport (cL lc (CExportStatic esrc entity' cconv))
-                                   (cL le esrc) }
+                 , fd_fe = CExport (L lc (CExportStatic esrc entity' cconv))
+                                   (L le esrc) }
   where
     entity' | nullFS entity = mkExtName (unLoc v)
             | otherwise     = entity
@@ -2776,15 +2767,15 @@ data ImpExpQcSpec = ImpExpQcName (Located RdrName)
                   | ImpExpQcWildcard
 
 mkModuleImpExp :: Located ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs)
-mkModuleImpExp (dL->L l specname) subs =
+mkModuleImpExp (L l specname) subs =
   case subs of
     ImpExpAbs
       | isVarNameSpace (rdrNameSpace name)
-                       -> return $ IEVar noExtField (cL l (ieNameFromSpec specname))
-      | otherwise      -> IEThingAbs noExtField . cL l <$> nameT
-    ImpExpAll          -> IEThingAll noExtField . cL l <$> nameT
+                       -> return $ IEVar noExtField (L l (ieNameFromSpec specname))
+      | otherwise      -> IEThingAbs noExtField . L l <$> nameT
+    ImpExpAll          -> IEThingAll noExtField . L l <$> nameT
     ImpExpList xs      ->
-      (\newName -> IEThingWith noExtField (cL l newName)
+      (\newName -> IEThingWith noExtField (L l newName)
         NoIEWildcard (wrapped xs) []) <$> nameT
     ImpExpAllWith xs                       ->
       do allowed <- getBit PatternSynonymsBit
@@ -2795,7 +2786,7 @@ mkModuleImpExp (dL->L l specname) subs =
                           (findIndex isImpExpQcWildcard withs)
                 ies   = wrapped $ filter (not . isImpExpQcWildcard . unLoc) xs
             in (\newName
-                        -> IEThingWith noExtField (cL l newName) pos ies [])
+                        -> IEThingWith noExtField (L l newName) pos ies [])
                <$> nameT
           else addFatalError l
             (text "Illegal export form (use PatternSynonyms to enable)")
@@ -2821,7 +2812,7 @@ mkModuleImpExp (dL->L l specname) subs =
     ieNameFromSpec (ImpExpQcType ln)  = IEType ln
     ieNameFromSpec (ImpExpQcWildcard) = panic "ieName got wildcard"
 
-    wrapped = map (onHasSrcSpan ieNameFromSpec)
+    wrapped = map (mapLoc ieNameFromSpec)
 
 mkTypeImpExp :: Located RdrName   -- TcCls or Var name space
              -> P (Located RdrName)
@@ -2832,8 +2823,8 @@ mkTypeImpExp name =
      return (fmap (`setRdrNameSpace` tcClsName) name)
 
 checkImportSpec :: Located [LIE GhcPs] -> P (Located [LIE GhcPs])
-checkImportSpec ie@(dL->L _ specs) =
-    case [l | (dL->L l (IEThingWith _ _ (IEWildcard _) _ _)) <- specs] of
+checkImportSpec ie@(L _ specs) =
+    case [l | (L l (IEThingWith _ _ (IEWildcard _) _ _)) <- specs] of
       [] -> return ie
       (l:_) -> importSpecError l
   where
@@ -2845,7 +2836,7 @@ checkImportSpec ie@(dL->L _ specs) =
 -- In the correct order
 mkImpExpSubSpec :: [Located ImpExpQcSpec] -> P ([AddAnn], ImpExpSubSpec)
 mkImpExpSubSpec [] = return ([], ImpExpList [])
-mkImpExpSubSpec [dL->L _ ImpExpQcWildcard] =
+mkImpExpSubSpec [L _ ImpExpQcWildcard] =
   return ([], ImpExpAll)
 mkImpExpSubSpec xs =
   if (any (isImpExpQcWildcard . unLoc) xs)
@@ -2901,7 +2892,7 @@ warnStarBndr span = addWarning Opt_WarnStarBinder span msg
         $$ text "    including the definition module, you must qualify it."
 
 failOpFewArgs :: Located RdrName -> P a
-failOpFewArgs (dL->L loc op) =
+failOpFewArgs (L loc op) =
   do { star_is_type <- getBit StarIsTypeBit
      ; let msg = too_few $$ starInfo star_is_type op
      ; addFatalError loc msg }
@@ -3108,14 +3099,14 @@ mkSumOrTupleExpr :: SrcSpan -> Boxity -> SumOrTuple (HsExpr GhcPs) -> PV (LHsExp
 
 -- Tuple
 mkSumOrTupleExpr l boxity (Tuple es) =
-    return $ cL l (ExplicitTuple noExtField (map toTupArg es) boxity)
+    return $ L l (ExplicitTuple noExtField (map toTupArg es) boxity)
   where
     toTupArg :: Located (Maybe (LHsExpr GhcPs)) -> LHsTupArg GhcPs
     toTupArg = mapLoc (maybe missingTupArg (Present noExtField))
 
 -- Sum
 mkSumOrTupleExpr l Unboxed (Sum alt arity e) =
-    return $ cL l (ExplicitSum noExtField alt arity e)
+    return $ L l (ExplicitSum noExtField alt arity e)
 mkSumOrTupleExpr l Boxed a@Sum{} =
     addFatalError l (hang (text "Boxed sums not supported:") 2
                       (pprSumOrTuple Boxed a))
@@ -3125,17 +3116,17 @@ mkSumOrTuplePat :: SrcSpan -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> PV (Loc
 -- Tuple
 mkSumOrTuplePat l boxity (Tuple ps) = do
   ps' <- traverse toTupPat ps
-  return $ cL l (PatBuilderPat (TuplePat noExtField ps' boxity))
+  return $ L l (PatBuilderPat (TuplePat noExtField ps' boxity))
   where
     toTupPat :: Located (Maybe (Located (PatBuilder GhcPs))) -> PV (LPat GhcPs)
-    toTupPat (dL -> L l p) = case p of
+    toTupPat (L l p) = case p of
       Nothing -> addFatalError l (text "Tuple section in pattern context")
       Just p' -> checkLPat p'
 
 -- Sum
 mkSumOrTuplePat l Unboxed (Sum alt arity p) = do
    p' <- checkLPat p
-   return $ cL l (PatBuilderPat (SumPat noExtField p' alt arity))
+   return $ L l (PatBuilderPat (SumPat noExtField p' alt arity))
 mkSumOrTuplePat l Boxed a@Sum{} =
     addFatalError l (hang (text "Boxed sums not supported:") 2
                       (pprSumOrTuple Boxed a))
@@ -3143,12 +3134,12 @@ mkSumOrTuplePat l Boxed a@Sum{} =
 mkLHsOpTy :: LHsType GhcPs -> Located RdrName -> LHsType GhcPs -> LHsType GhcPs
 mkLHsOpTy x op y =
   let loc = getLoc x `combineSrcSpans` getLoc op `combineSrcSpans` getLoc y
-  in cL loc (mkHsOpTy x op y)
+  in L loc (mkHsOpTy x op y)
 
 mkLHsDocTy :: LHsType GhcPs -> LHsDocString -> LHsType GhcPs
 mkLHsDocTy t doc =
   let loc = getLoc t `combineSrcSpans` getLoc doc
-  in cL loc (HsDocTy noExtField t doc)
+  in L loc (HsDocTy noExtField t doc)
 
 mkLHsDocTyMaybe :: LHsType GhcPs -> Maybe LHsDocString -> LHsType GhcPs
 mkLHsDocTyMaybe t = maybe t (mkLHsDocTy t)
index 59ca753..693d818 100644 (file)
@@ -1368,7 +1368,7 @@ segsToStmts empty_rec_stmt ((defs, uses, fwds, ss) : segs) fvs_later
   where
     (later_stmts, later_uses) = segsToStmts empty_rec_stmt segs fvs_later
     new_stmt | non_rec   = head ss
-             | otherwise = cL (getLoc (head ss)) rec_stmt
+             | otherwise = L (getLoc (head ss)) rec_stmt
     rec_stmt = empty_rec_stmt { recS_stmts     = ss
                               , recS_later_ids = nameSetElemsStable used_later
                               , recS_rec_ids   = nameSetElemsStable fwds }
index deaedb8..6af59a0 100644 (file)
@@ -17,9 +17,9 @@ rnMbLHsDoc mb_doc = case mb_doc of
   Nothing -> return Nothing
 
 rnLHsDoc :: LHsDocString -> RnM LHsDocString
-rnLHsDoc (dL->L pos doc) = do
+rnLHsDoc (L pos doc) = do
   doc' <- rnHsDoc doc
-  return (cL pos doc')
+  return (L pos doc')
 
 rnHsDoc :: HsDocString -> RnM HsDocString
 rnHsDoc = pure
index 61cdc14..59ab544 100644 (file)
@@ -129,13 +129,12 @@ liftCpsFV rn_thing = CpsRn (\k -> do { (v,fvs1) <- rn_thing
                                      ; (r,fvs2) <- k v
                                      ; return (r, fvs1 `plusFV` fvs2) })
 
-wrapSrcSpanCps :: (HasSrcSpan a, HasSrcSpan b) =>
-                  (SrcSpanLess a -> CpsRn (SrcSpanLess b)) -> a -> CpsRn b
+wrapSrcSpanCps :: (a -> CpsRn b) -> Located a -> CpsRn (Located b)
 -- Set the location, and also wrap it around the value returned
-wrapSrcSpanCps fn (dL->L loc a)
+wrapSrcSpanCps fn (L loc a)
   = CpsRn (\k -> setSrcSpan loc $
                  unCpsRn (fn a) $ \v ->
-                 k (cL loc v))
+                 k (L loc v))
 
 lookupConCps :: Located RdrName -> CpsRn (Located Name)
 lookupConCps con_rdr
@@ -220,9 +219,9 @@ rnHsSigCps :: LHsSigWcType GhcPs -> CpsRn (LHsSigWcType GhcRn)
 rnHsSigCps sig = CpsRn (rnHsSigWcTypeScoped AlwaysBind PatCtx sig)
 
 newPatLName :: NameMaker -> Located RdrName -> CpsRn (Located Name)
-newPatLName name_maker rdr_name@(dL->L loc _)
+newPatLName name_maker rdr_name@(L loc _)
   = do { name <- newPatName name_maker rdr_name
-       ; return (cL loc name) }
+       ; return (L loc name) }
 
 newPatName :: NameMaker -> Located RdrName -> CpsRn Name
 newPatName (LamMk report_unused) rdr_name
@@ -391,10 +390,10 @@ rnPatAndThen mk (LazyPat x pat) = do { pat' <- rnLPatAndThen mk pat
                                      ; return (LazyPat x pat') }
 rnPatAndThen mk (BangPat x pat) = do { pat' <- rnLPatAndThen mk pat
                                      ; return (BangPat x pat') }
-rnPatAndThen mk (VarPat x (dL->L l rdr))
+rnPatAndThen mk (VarPat x (L l rdr))
     = do { loc <- liftCps getSrcSpanM
-         ; name <- newPatName mk (cL loc rdr)
-         ; return (VarPat x (cL l name)) }
+         ; name <- newPatName mk (L loc rdr)
+         ; return (VarPat x (L l name)) }
      -- we need to bind pattern variables for view pattern expressions
      -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)
 
@@ -424,7 +423,7 @@ rnPatAndThen mk (LitPat x lit)
   where
     normal_lit = do { liftCps (rnLit lit); return (LitPat x (convertLit lit)) }
 
-rnPatAndThen _ (NPat x (dL->L l lit) mb_neg _eq)
+rnPatAndThen _ (NPat x (L l lit) mb_neg _eq)
   = do { (lit', mb_neg') <- liftCpsFV $ rnOverLit lit
        ; mb_neg' -- See Note [Negative zero]
            <- let negative = do { (neg, fvs) <- lookupSyntaxName negateName
@@ -436,9 +435,9 @@ rnPatAndThen _ (NPat x (dL->L l lit) mb_neg _eq)
                                   (Nothing, Nothing) -> positive
                                   (Just _ , Just _ ) -> positive
        ; eq' <- liftCpsFV $ lookupSyntaxName eqName
-       ; return (NPat x (cL l lit') mb_neg' eq') }
+       ; return (NPat x (L l lit') mb_neg' eq') }
 
-rnPatAndThen mk (NPlusKPat x rdr (dL->L l lit) _ _ _ )
+rnPatAndThen mk (NPlusKPat x rdr (L l lit) _ _ _ )
   = do { new_name <- newPatName mk rdr
        ; (lit', _) <- liftCpsFV $ rnOverLit lit -- See Note [Negative zero]
                                                 -- We skip negateName as
@@ -446,8 +445,8 @@ rnPatAndThen mk (NPlusKPat x rdr (dL->L l lit) _ _ _ )
                                                 -- sense in n + k patterns
        ; minus <- liftCpsFV $ lookupSyntaxName minusName
        ; ge    <- liftCpsFV $ lookupSyntaxName geName
-       ; return (NPlusKPat x (cL (nameSrcSpan new_name) new_name)
-                             (cL l lit') lit' ge minus) }
+       ; return (NPlusKPat x (L (nameSrcSpan new_name) new_name)
+                             (L l lit') lit' ge minus) }
                 -- The Report says that n+k patterns must be in Integral
 
 rnPatAndThen mk (AsPat x rdr pat)
@@ -540,7 +539,7 @@ rnHsRecPatsAndThen :: NameMaker
                    -> Located Name      -- Constructor
                    -> HsRecFields GhcPs (LPat GhcPs)
                    -> CpsRn (HsRecFields GhcRn (LPat GhcRn))
-rnHsRecPatsAndThen mk (dL->L _ con)
+rnHsRecPatsAndThen mk (L _ con)
      hs_rec_fields@(HsRecFields { rec_dotdot = dd })
   = do { flds <- liftCpsFV $ rnHsRecFields (HsRecFieldPat con) mkVarPat
                                             hs_rec_fields
@@ -548,10 +547,10 @@ rnHsRecPatsAndThen mk (dL->L _ con)
        ; check_unused_wildcard (implicit_binders flds' <$> dd)
        ; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }) }
   where
-    mkVarPat l n = VarPat noExtField (cL l n)
-    rn_field (dL->L l fld, n') =
+    mkVarPat l n = VarPat noExtField (L l n)
+    rn_field (L l fld, n') =
       do { arg' <- rnLPatAndThen (nested_mk dd mk n') (hsRecFieldArg fld)
-         ; return (cL l (fld { hsRecFieldArg = arg' })) }
+         ; return (L l (fld { hsRecFieldArg = arg' })) }
 
     loc = maybe noSrcSpan getLoc dd
 
@@ -585,12 +584,12 @@ data HsRecFieldContext
   | HsRecFieldUpd
 
 rnHsRecFields
-    :: forall arg. HasSrcSpan arg =>
+    :: forall arg.
        HsRecFieldContext
-    -> (SrcSpan -> RdrName -> SrcSpanLess arg)
+    -> (SrcSpan -> RdrName -> arg)
          -- When punning, use this to build a new field
-    -> HsRecFields GhcPs arg
-    -> RnM ([LHsRecField GhcRn arg], FreeVars)
+    -> HsRecFields GhcPs (Located arg)
+    -> RnM ([LHsRecField GhcRn (Located arg)], FreeVars)
 
 -- This surprisingly complicated pass
 --   a) looks up the field name (possibly using disambiguation)
@@ -616,38 +615,36 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
                 HsRecFieldPat con  -> Just con
                 _ {- update -}     -> Nothing
 
-    rn_fld :: Bool -> Maybe Name -> LHsRecField GhcPs arg
-           -> RnM (LHsRecField GhcRn arg)
-    rn_fld pun_ok parent (dL->L l
+    rn_fld :: Bool -> Maybe Name -> LHsRecField GhcPs (Located arg)
+           -> RnM (LHsRecField GhcRn (Located arg))
+    rn_fld pun_ok parent (L l
                            (HsRecField
                               { hsRecFieldLbl =
-                                  (dL->L loc (FieldOcc _ (dL->L ll lbl)))
+                                  (L loc (FieldOcc _ (L ll lbl)))
                               , hsRecFieldArg = arg
                               , hsRecPun      = pun }))
       = do { sel <- setSrcSpan loc $ lookupRecFieldOcc parent lbl
            ; arg' <- if pun
-                     then do { checkErr pun_ok (badPun (cL loc lbl))
+                     then do { checkErr pun_ok (badPun (L loc lbl))
                                -- Discard any module qualifier (#11662)
                              ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)
-                             ; return (cL loc (mk_arg loc arg_rdr)) }
+                             ; return (L loc (mk_arg loc arg_rdr)) }
                      else return arg
-           ; return (cL l (HsRecField
-                             { hsRecFieldLbl = (cL loc (FieldOcc
-                                                          sel (cL ll lbl)))
+           ; return (L l (HsRecField
+                             { hsRecFieldLbl = (L loc (FieldOcc
+                                                          sel (L ll lbl)))
                              , hsRecFieldArg = arg'
                              , hsRecPun      = pun })) }
-    rn_fld _ _ (dL->L _ (HsRecField (dL->L _ (XFieldOcc _)) _ _))
+    rn_fld _ _ (L _ (HsRecField (L _ (XFieldOcc _)) _ _))
       = panic "rnHsRecFields"
-    rn_fld _ _ _ = panic "rn_fld: Impossible Match"
-                                -- due to #15884
 
 
     rn_dotdot :: Maybe (Located Int)      -- See Note [DotDot fields] in GHC.Hs.Pat
               -> Maybe Name -- The constructor (Nothing for an
                                 --    out of scope constructor)
-              -> [LHsRecField GhcRn arg] -- Explicit fields
-              -> RnM ([LHsRecField GhcRn arg])   -- Field Labels we need to fill in
-    rn_dotdot (Just (dL -> L loc n)) (Just con) flds -- ".." on record construction / pat match
+              -> [LHsRecField GhcRn (Located arg)] -- Explicit fields
+              -> RnM ([LHsRecField GhcRn (Located arg)])   -- Field Labels we need to fill in
+    rn_dotdot (Just (L loc n)) (Just con) flds -- ".." on record construction / pat match
       | not (isUnboundName con) -- This test is because if the constructor
                                 -- isn't in scope the constructor lookup will add
                                 -- an error but still return an unbound name. We
@@ -679,9 +676,9 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
                                     _other           -> True ]
 
            ; addUsedGREs dot_dot_gres
-           ; return [ cL loc (HsRecField
-                        { hsRecFieldLbl = cL loc (FieldOcc sel (cL loc arg_rdr))
-                        , hsRecFieldArg = cL loc (mk_arg loc arg_rdr)
+           ; return [ L loc (HsRecField
+                        { hsRecFieldLbl = L loc (FieldOcc sel (L loc arg_rdr))
+                        , hsRecFieldArg = L loc (mk_arg loc arg_rdr)
                         , hsRecPun      = False })
                     | fl <- dot_dot_fields
                     , let sel     = flSelector fl
@@ -726,9 +723,9 @@ rnHsRecUpdFields flds
 
     rn_fld :: Bool -> Bool -> LHsRecUpdField GhcPs
            -> RnM (LHsRecUpdField GhcRn, FreeVars)
-    rn_fld pun_ok overload_ok (dL->L l (HsRecField { hsRecFieldLbl = dL->L loc f
-                                                   , hsRecFieldArg = arg
-                                                   , hsRecPun      = pun }))
+    rn_fld pun_ok overload_ok (L l (HsRecField { hsRecFieldLbl = L loc f
+                                               , hsRecFieldArg = arg
+                                               , hsRecPun      = pun }))
       = do { let lbl = rdrNameAmbiguousFieldOcc f
            ; sel <- setSrcSpan loc $
                       -- Defer renaming of overloaded fields to the typechecker
@@ -744,10 +741,10 @@ rnHsRecUpdFields flds
                                       Just r  -> return r }
                           else fmap Left $ lookupGlobalOccRn lbl
            ; arg' <- if pun
-                     then do { checkErr pun_ok (badPun (cL loc lbl))
+                     then do { checkErr pun_ok (badPun (L loc lbl))
                                -- Discard any module qualifier (#11662)
                              ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)
-                             ; return (cL loc (HsVar noExtField (cL loc arg_rdr))) }
+                             ; return (L loc (HsVar noExtField (L loc arg_rdr))) }
                      else return arg
            ; (arg'', fvs) <- rnLExpr arg'
 
@@ -757,14 +754,14 @@ rnHsRecUpdFields flds
                           Right _       -> fvs
                  lbl' = case sel of
                           Left sel_name ->
-                                     cL loc (Unambiguous sel_name   (cL loc lbl))
+                                     L loc (Unambiguous sel_name   (L loc lbl))
                           Right [sel_name] ->
-                                     cL loc (Unambiguous sel_name   (cL loc lbl))
-                          Right _ -> cL loc (Ambiguous   noExtField (cL loc lbl))
+