diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2019-03-19 17:47:55 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@well-typed.com> | 2019-07-09 11:52:45 -0400 |
| commit | 6a03d77b9a9915e4b37fe1ea6688c135e7b00654 (patch) | |
| tree | 4154abaa768adbfadc4eb17db620c3ed08b82c5f | |
| parent | 5af815f2e43e9f1b5ca9ec0803f9fccabb49e2fe (diff) | |
| download | haskell-6a03d77b9a9915e4b37fe1ea6688c135e7b00654.tar.gz | |
Use an empty data type in TTG extension constructors (#15247)
To avoid having to `panic` any time a TTG extension constructor is
consumed, this MR introduces an uninhabited 'NoExtCon' type and uses
that in every extension constructor's type family instance where it
is appropriate. This also introduces a 'noExtCon' function which
eliminates a 'NoExtCon', much like 'Data.Void.absurd' eliminates
a 'Void'.
I also renamed the existing `NoExt` type to `NoExtField` to better
distinguish it from `NoExtCon`. Unsurprisingly, there is a lot of
code churn resulting from this.
Bumps the Haddock submodule. Fixes #15247.
76 files changed, 2211 insertions, 2129 deletions
diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index d30cb95515..4a5d978370 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -375,12 +375,12 @@ checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) dsMatchContext = DsMatchContext hs_ctx combinedLoc match = cL combinedLoc $ - Match { m_ext = noExt + Match { m_ext = noExtField , m_ctxt = hs_ctx , m_pats = [] , m_grhss = guards } checkMatches dflags dsMatchContext [] [match] -checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" +checkGuardMatches _ (XGRHSs nec) = noExtCon nec -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext @@ -1008,7 +1008,7 @@ translatePat fam_insts pat = case pat of case res of True -> do (xp,xe) <- mkPmId2Forms arg_ty - g <- mkGuard ps (HsApp noExt lexpr xe) + g <- mkGuard ps (HsApp noExtField lexpr xe) return [xp,g] False -> mkCanFailPmPat arg_ty @@ -1066,7 +1066,7 @@ translatePat fam_insts pat = case pat of , isStringTy ty -> foldr (mkListPatVec charTy) [nilPattern charTy] <$> translatePatVec fam_insts - (map (LitPat noExt . HsChar src) (unpackFS s)) + (map (LitPat noExtField . HsChar src) (unpackFS s)) | otherwise -> return [PmLit { pm_lit_lit = PmOLit (isJust mb_neg) olit }] -- See Note [Translate Overloaded Literal for Exhaustiveness Checking] @@ -1074,7 +1074,7 @@ translatePat fam_insts pat = case pat of | HsString src s <- lit -> foldr (mkListPatVec charTy) [nilPattern charTy] <$> translatePatVec fam_insts - (map (LitPat noExt . HsChar src) (unpackFS s)) + (map (LitPat noExtField . HsChar src) (unpackFS s)) | otherwise -> return [mkLitPattern lit] TuplePat tys ps boxity -> do @@ -1312,7 +1312,7 @@ translateGuard fam_insts guard = case guard of TransStmt {} -> panic "translateGuard TransStmt" RecStmt {} -> panic "translateGuard RecStmt" ApplicativeStmt {} -> panic "translateGuard ApplicativeLastStmt" - XStmtLR {} -> panic "translateGuard RecStmt" + XStmtLR nec -> noExtCon nec -- | Translate let-bindings translateLet :: HsLocalBinds GhcTc -> DsM PatVec @@ -1713,7 +1713,7 @@ mkPmId ty = getUniqueM >>= \unique -> mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty - return (PmVar x, noLoc (HsVar noExt (noLoc x))) + return (PmVar x, noLoc (HsVar noExtField (noLoc x))) -- ---------------------------------------------------------------------------- -- * Converting between Value Abstractions, Patterns and PmExpr diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs index 59b8bcfc78..ce902f4970 100644 --- a/compiler/deSugar/Coverage.hs +++ b/compiler/deSugar/Coverage.hs @@ -327,7 +327,7 @@ addTickLHsBind (dL->L pos (funBind@(FunBind { fun_id = (dL->L _ id) }))) = do where -- a binding is a simple pattern binding if it is a funbind with -- zero patterns - isSimplePatBind :: HsBind a -> Bool + isSimplePatBind :: HsBind GhcTc -> Bool isSimplePatBind funBind = matchGroupArity (fun_matches funBind) == 0 -- TODO: Revisit this @@ -640,7 +640,7 @@ 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 _)) = panic "addTickTupArg" +addTickTupArg (dL->L _ (XTupArg nec)) = noExtCon nec addTickTupArg _ = panic "addTickTupArg: Impossible Match" -- due to #15884 @@ -650,7 +650,7 @@ addTickMatchGroup is_lam mg@(MG { mg_alts = dL->L l matches }) = do let isOneOfMany = matchesOneOfMany matches matches' <- mapM (liftL (addTickMatch isOneOfMany is_lam)) matches return $ mg { mg_alts = cL l matches' } -addTickMatchGroup _ (XMatchGroup _) = panic "addTickMatchGroup" +addTickMatchGroup _ (XMatchGroup nec) = noExtCon nec addTickMatch :: Bool -> Bool -> Match GhcTc (LHsExpr GhcTc) -> TM (Match GhcTc (LHsExpr GhcTc)) @@ -659,7 +659,7 @@ addTickMatch isOneOfMany isLambda match@(Match { m_pats = pats bindLocals (collectPatsBinders pats) $ do gRHSs' <- addTickGRHSs isOneOfMany isLambda gRHSs return $ match { m_grhss = gRHSs' } -addTickMatch _ _ (XMatch _) = panic "addTickMatch" +addTickMatch _ _ (XMatch nec) = noExtCon nec addTickGRHSs :: Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc) -> TM (GRHSs GhcTc (LHsExpr GhcTc)) @@ -670,7 +670,7 @@ addTickGRHSs isOneOfMany isLambda (GRHSs x guarded (dL->L l local_binds)) = do return $ GRHSs x guarded' (cL l local_binds') where binders = collectLocalBinders local_binds -addTickGRHSs _ _ (XGRHSs _) = panic "addTickGRHSs" +addTickGRHSs _ _ (XGRHSs nec) = noExtCon nec addTickGRHS :: Bool -> Bool -> GRHS GhcTc (LHsExpr GhcTc) -> TM (GRHS GhcTc (LHsExpr GhcTc)) @@ -678,7 +678,7 @@ addTickGRHS isOneOfMany isLambda (GRHS x stmts expr) = do (stmts',expr') <- addTickLStmts' (Just $ BinBox $ GuardBinBox) stmts (addTickGRHSBody isOneOfMany isLambda expr) return $ GRHS x stmts' expr' -addTickGRHS _ _ (XGRHS _) = panic "addTickGRHS" +addTickGRHS _ _ (XGRHS nec) = noExtCon nec addTickGRHSBody :: Bool -> Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc) addTickGRHSBody isOneOfMany isLambda expr@(dL->L pos e0) = do @@ -757,7 +757,7 @@ addTickStmt isGuard stmt@(RecStmt {}) ; return (stmt { recS_stmts = stmts', recS_ret_fn = ret' , recS_mfix_fn = mfix', recS_bind_fn = bind' }) } -addTickStmt _ (XStmtLR _) = panic "addTickStmt" +addTickStmt _ (XStmtLR nec) = noExtCon nec addTick :: Maybe (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc) addTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e @@ -779,7 +779,7 @@ addTickApplicativeArg isGuard (op, arg) = <$> addTickLStmts isGuard stmts <*> (unLoc <$> addTickLHsExpr (cL hpcSrcSpan ret)) <*> addTickLPat pat - addTickArg (XApplicativeArg _) = panic "addTickApplicativeArg" + addTickArg (XApplicativeArg nec) = noExtCon nec addTickStmtAndBinders :: Maybe (Bool -> BoxLabel) -> ParStmtBlock GhcTc GhcTc -> TM (ParStmtBlock GhcTc GhcTc) @@ -788,7 +788,7 @@ addTickStmtAndBinders isGuard (ParStmtBlock x stmts ids returnExpr) = (addTickLStmts isGuard stmts) (return ids) (addTickSyntaxExpr hpcSrcSpan returnExpr) -addTickStmtAndBinders _ (XParStmtBlock{}) = panic "addTickStmtAndBinders" +addTickStmtAndBinders _ (XParStmtBlock nec) = noExtCon nec addTickHsLocalBinds :: HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc) addTickHsLocalBinds (HsValBinds x binds) = @@ -841,7 +841,7 @@ addTickHsCmdTop (HsCmdTop x cmd) = liftM2 HsCmdTop (return x) (addTickLHsCmd cmd) -addTickHsCmdTop (XCmdTop{}) = panic "addTickHsCmdTop" +addTickHsCmdTop (XCmdTop nec) = noExtCon nec addTickLHsCmd :: LHsCmd GhcTc -> TM (LHsCmd GhcTc) addTickLHsCmd (dL->L pos c0) = do @@ -897,7 +897,7 @@ addTickHsCmd (HsCmdArrForm x e f fix cmdtop) = addTickHsCmd (HsCmdWrap x w cmd) = liftM2 (HsCmdWrap x) (return w) (addTickHsCmd cmd) -addTickHsCmd e@(XCmd {}) = pprPanic "addTickHsCmd" (ppr e) +addTickHsCmd (XCmd nec) = noExtCon nec -- Others should never happen in a command context. --addTickHsCmd e = pprPanic "addTickHsCmd" (ppr e) @@ -907,14 +907,14 @@ addTickCmdMatchGroup :: MatchGroup GhcTc (LHsCmd GhcTc) addTickCmdMatchGroup mg@(MG { mg_alts = (dL->L l matches) }) = do matches' <- mapM (liftL addTickCmdMatch) matches return $ mg { mg_alts = cL l matches' } -addTickCmdMatchGroup (XMatchGroup _) = panic "addTickCmdMatchGroup" +addTickCmdMatchGroup (XMatchGroup nec) = noExtCon nec addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc)) addTickCmdMatch match@(Match { m_pats = pats, m_grhss = gRHSs }) = bindLocals (collectPatsBinders pats) $ do gRHSs' <- addTickCmdGRHSs gRHSs return $ match { m_grhss = gRHSs' } -addTickCmdMatch (XMatch _) = panic "addTickCmdMatch" +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 @@ -924,7 +924,7 @@ addTickCmdGRHSs (GRHSs x guarded (dL->L l local_binds)) = do return $ GRHSs x guarded' (cL l local_binds') where binders = collectLocalBinders local_binds -addTickCmdGRHSs (XGRHSs _) = panic "addTickCmdGRHSs" +addTickCmdGRHSs (XGRHSs nec) = noExtCon nec addTickCmdGRHS :: GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc)) -- The *guards* are *not* Cmds, although the body is @@ -933,7 +933,7 @@ addTickCmdGRHS (GRHS x stmts cmd) = do { (stmts',expr') <- addTickLStmts' (Just $ BinBox $ GuardBinBox) stmts (addTickLHsCmd cmd) ; return $ GRHS x stmts' expr' } -addTickCmdGRHS (XGRHS _) = panic "addTickCmdGRHS" +addTickCmdGRHS (XGRHS nec) = noExtCon nec addTickLCmdStmts :: [LStmt GhcTc (LHsCmd GhcTc)] -> TM [LStmt GhcTc (LHsCmd GhcTc)] @@ -980,8 +980,8 @@ addTickCmdStmt stmt@(RecStmt {}) , recS_mfix_fn = mfix', recS_bind_fn = bind' }) } addTickCmdStmt ApplicativeStmt{} = panic "ToDo: addTickCmdStmt ApplicativeLastStmt" -addTickCmdStmt XStmtLR{} = - panic "addTickCmdStmt XStmtLR" +addTickCmdStmt (XStmtLR nec) = + noExtCon nec -- Others should never happen in a command context. addTickCmdStmt stmt = pprPanic "addTickHsCmd" (ppr stmt) @@ -1175,7 +1175,7 @@ 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 noExt tickish (cL pos e))) + return (cL pos (HsTick noExtField tickish (cL pos e))) ) (do e <- m return (cL pos e) @@ -1262,8 +1262,8 @@ mkBinTickBoxHpc boxLabel pos e = c = tickBoxCount st mes = mixEntries st in - ( cL pos $ HsTick noExt (HpcTick (this_mod env) c) - $ cL pos $ HsBinTick noExt (c+1) (c+2) e + ( cL pos $ HsTick noExtField (HpcTick (this_mod env) c) + $ cL pos $ HsBinTick noExtField (c+1) (c+2) e -- notice that F and T are reversed, -- because we are building the list in -- reverse... @@ -1292,9 +1292,9 @@ matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1 where matchCount (dL->L _ (Match { m_grhss = GRHSs _ grhss _ })) = length grhss - matchCount (dL->L _ (Match { m_grhss = XGRHSs _ })) - = panic "matchesOneOfMany" - matchCount (dL->L _ (XMatch _)) = panic "matchesOneOfMany" + matchCount (dL->L _ (Match { m_grhss = XGRHSs nec })) + = noExtCon nec + matchCount (dL->L _ (XMatch nec)) = noExtCon nec matchCount _ = panic "matchCount: Impossible Match" -- due to #15884 type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel) diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index 128722d5b5..2c0b4139a6 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -412,7 +412,7 @@ dsRule (dL->L loc (HsRule { rd_name = name ; return (Just rule) } } } -dsRule (dL->L _ (XRuleDecl _)) = panic "dsRule" +dsRule (dL->L _ (XRuleDecl nec)) = noExtCon nec dsRule _ = panic "dsRule: Impossible Match" -- due to #15884 warnRuleShadowing :: RuleName -> Activation -> Id -> [Id] -> DsM () diff --git a/compiler/deSugar/DsArrows.hs b/compiler/deSugar/DsArrows.hs index f86f364cb2..956eb1d098 100644 --- a/compiler/deSugar/DsArrows.hs +++ b/compiler/deSugar/DsArrows.hs @@ -592,11 +592,11 @@ dsCmd ids local_vars stack_ty res_ty left_con <- dsLookupDataCon leftDataConName right_con <- dsLookupDataCon rightDataConName let - left_id = HsConLikeOut noExt (RealDataCon left_con) - right_id = HsConLikeOut noExt (RealDataCon right_con) - left_expr ty1 ty2 e = noLoc $ HsApp noExt + left_id = HsConLikeOut noExtField (RealDataCon left_con) + right_id = HsConLikeOut noExtField (RealDataCon right_con) + left_expr ty1 ty2 e = noLoc $ HsApp noExtField (noLoc $ mkHsWrap (mkWpTyApps [ty1, ty2]) left_id ) e - right_expr ty1 ty2 e = noLoc $ HsApp noExt + right_expr ty1 ty2 e = noLoc $ HsApp noExtField (noLoc $ mkHsWrap (mkWpTyApps [ty1, ty2]) right_id) e -- Prefix each tuple with a distinct series of Left's and Right's, @@ -616,7 +616,7 @@ dsCmd ids local_vars stack_ty res_ty (_, matches') = mapAccumL (replaceLeavesMatch res_ty) leaves' matches in_ty = envStackType env_ids stack_ty - core_body <- dsExpr (HsCase noExt exp + core_body <- dsExpr (HsCase noExtField exp (MG { mg_alts = cL l matches' , mg_ext = MatchGroupTc arg_tys sum_ty , mg_origin = origin })) @@ -1167,7 +1167,7 @@ replaceLeavesMatch _res_ty leaves = let (leaves', grhss') = mapAccumL replaceLeavesGRHS leaves grhss in - (leaves', cL loc (match { m_ext = noExt, m_grhss = GRHSs x grhss' binds })) + (leaves', cL loc (match { m_ext = noExtField, m_grhss = GRHSs x grhss' binds })) replaceLeavesMatch _ _ _ = panic "replaceLeavesMatch" replaceLeavesGRHS diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index a87a4bbcbb..96855a61b7 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -198,7 +198,7 @@ dsHsBind dflags (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts ; dsAbsBinds dflags tyvars dicts exports ds_ev_binds ds_binds has_sig } dsHsBind _ (PatSynBind{}) = panic "dsHsBind: PatSynBind" -dsHsBind _ (XHsBindsLR{}) = panic "dsHsBind: XHsBindsLR" +dsHsBind _ (XHsBindsLR nec) = noExtCon nec ----------------------- @@ -258,7 +258,7 @@ dsAbsBinds dflags tyvars dicts exports ; return (makeCorePair dflags global (isDefaultMethod prags) 0 (core_wrap (Var local))) } - mk_bind (XABExport _) = panic "dsAbsBinds" + mk_bind (XABExport nec) = noExtCon nec ; main_binds <- mapM mk_bind exports ; return (force_vars, flattenBinds ds_ev_binds ++ bind_prs ++ main_binds) } @@ -303,7 +303,7 @@ dsAbsBinds dflags tyvars dicts exports -- the user written (local) function. The global -- Id is just the selector. Hmm. ; return ((global', rhs) : fromOL spec_binds) } - mk_bind (XABExport _) = panic "dsAbsBinds" + mk_bind (XABExport nec) = noExtCon nec ; export_binds_s <- mapM mk_bind (exports ++ extra_exports) @@ -351,7 +351,7 @@ dsAbsBinds dflags tyvars dicts exports mk_export local = do global <- newSysLocalDs (exprType (mkLams tyvars (mkLams dicts (Var local)))) - return (ABE { abe_ext = noExt + return (ABE { abe_ext = noExtField , abe_poly = global , abe_mono = local , abe_wrap = WpHole diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index 9516fbbe82..73edf8c2de 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -98,7 +98,7 @@ dsIPBinds (IPBinds ev_binds ip_binds) body = do e' <- dsLExpr e return (Let (NonRec n e') body) ds_ip_bind _ _ = panic "dsIPBinds" -dsIPBinds (XHsIPBinds _) _ = panic "dsIPBinds" +dsIPBinds (XHsIPBinds nec) _ = noExtCon nec ------------------------- -- caller sets location @@ -451,7 +451,7 @@ ds_expr _ (HsMultiIf res_ty alts) | otherwise = do { match_result <- liftM (foldr1 combineMatchResults) (mapM (dsGRHS IfAlt res_ty) alts) - ; checkGuardMatches IfAlt (GRHSs noExt alts (noLoc emptyLocalBinds)) + ; checkGuardMatches IfAlt (GRHSs noExtField alts (noLoc emptyLocalBinds)) ; error_expr <- mkErrorExpr ; extractMatchResult match_result error_expr } where @@ -663,7 +663,7 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields mk_val_arg fl pat_arg_id = nlHsVar (lookupNameEnv upd_fld_env (flSelector fl) `orElse` pat_arg_id) - inst_con = noLoc $ mkHsWrap wrap (HsConLikeOut noExt con) + inst_con = noLoc $ mkHsWrap wrap (HsConLikeOut noExtField con) -- Reconstruct with the WrapId so that unpacking happens wrap = mkWpEvVarApps theta_vars <.> dict_req_wrap <.> @@ -754,7 +754,7 @@ ds_expr _ (HsTickPragma _ _ _ _ expr) = do ds_expr _ (HsBracket {}) = panic "dsExpr:HsBracket" ds_expr _ (HsDo {}) = panic "dsExpr:HsDo" ds_expr _ (HsRecFld {}) = panic "dsExpr:HsRecFld" -ds_expr _ (XExpr {}) = panic "dsExpr: XExpr" +ds_expr _ (XExpr nec) = noExtCon nec ------------------------------ @@ -927,7 +927,7 @@ dsDo stmts (pat, dsLExpr expr) do_arg (ApplicativeArgMany _ stmts ret pat) = (pat, dsDo (stmts ++ [noLoc $ mkLastStmt (noLoc ret)])) - do_arg (XApplicativeArg _) = panic "dsDo" + do_arg (XApplicativeArg nec) = noExtCon nec arg_tys = map hsLPatType pats @@ -935,7 +935,7 @@ dsDo stmts ; let body' = noLoc $ HsDo body_ty DoExpr (noLoc stmts) - ; let fun = cL noSrcSpan $ HsLam noExt $ + ; let fun = cL noSrcSpan $ HsLam noExtField $ MG { mg_alts = noLoc [mkSimpleMatch LambdaExpr pats body'] , mg_ext = MatchGroupTc arg_tys body_ty @@ -967,13 +967,13 @@ dsDo stmts later_pats = rec_tup_pats rets = map noLoc rec_rets mfix_app = nlHsSyntaxApps mfix_op [mfix_arg] - mfix_arg = noLoc $ HsLam noExt + mfix_arg = noLoc $ HsLam noExtField (MG { mg_alts = noLoc [mkSimpleMatch LambdaExpr [mfix_pat] body] , mg_ext = MatchGroupTc [tup_ty] body_ty , mg_origin = Generated }) - mfix_pat = noLoc $ LazyPat noExt $ mkBigLHsPatTupId rec_tup_pats + mfix_pat = noLoc $ LazyPat noExtField $ mkBigLHsPatTupId rec_tup_pats body = noLoc $ HsDo body_ty DoExpr (noLoc (rec_stmts ++ [ret_stmt])) ret_app = nlHsSyntaxApps return_op [mkBigLHsTupId rets] @@ -984,7 +984,7 @@ dsDo stmts go _ (ParStmt {}) _ = panic "dsDo ParStmt" go _ (TransStmt {}) _ = panic "dsDo TransStmt" - go _ (XStmtLR {}) _ = panic "dsDo XStmtLR" + go _ (XStmtLR nec) _ = noExtCon nec handle_failure :: LPat GhcTc -> MatchResult -> SyntaxExpr GhcTc -> DsM CoreExpr -- In a do expression, pattern-match failure just calls diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs index 3ecd9bfead..545f26c3f6 100644 --- a/compiler/deSugar/DsForeign.hs +++ b/compiler/deSugar/DsForeign.hs @@ -112,7 +112,7 @@ dsForeigns' fos = do (dL->L _ (CExportStatic _ ext_nm cconv)) _ }) = do (h, c, _, _) <- dsFExport id co ext_nm cconv False return (h, c, [id], []) - do_decl (XForeignDecl _) = panic "dsForeigns'" + do_decl (XForeignDecl nec) = noExtCon nec {- ************************************************************************ diff --git a/compiler/deSugar/DsGRHSs.hs b/compiler/deSugar/DsGRHSs.hs index 277ea00044..5adc661388 100644 --- a/compiler/deSugar/DsGRHSs.hs +++ b/compiler/deSugar/DsGRHSs.hs @@ -64,13 +64,13 @@ dsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty match_result2 = adjustMatchResultDs (dsLocalBinds binds) match_result1 -- NB: nested dsLet inside matchResult ; return match_result2 } -dsGRHSs _ (XGRHSs _) _ = panic "dsGRHSs" +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)) = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs rhs_ty -dsGRHS _ _ (dL->L _ (XGRHS _)) = panic "dsGRHS" +dsGRHS _ _ (dL->L _ (XGRHS nec)) = noExtCon nec dsGRHS _ _ _ = panic "dsGRHS: Impossible Match" -- due to #15884 {- @@ -138,8 +138,8 @@ matchGuards (TransStmt {} : _) _ _ _ = panic "matchGuards TransStmt" matchGuards (RecStmt {} : _) _ _ _ = panic "matchGuards RecStmt" matchGuards (ApplicativeStmt {} : _) _ _ _ = panic "matchGuards ApplicativeLastStmt" -matchGuards (XStmtLR {} : _) _ _ _ = - panic "matchGuards XStmtLR" +matchGuards (XStmtLR nec : _) _ _ _ = + noExtCon nec {- Should {\em fail} if @e@ returns @D@ diff --git a/compiler/deSugar/DsListComp.hs b/compiler/deSugar/DsListComp.hs index f376ef0b4b..9755bf695b 100644 --- a/compiler/deSugar/DsListComp.hs +++ b/compiler/deSugar/DsListComp.hs @@ -91,7 +91,7 @@ dsInnerListComp (ParStmtBlock _ stmts bndrs _) ; expr <- dsListComp (stmts ++ [noLoc $ mkLastStmt (mkBigLHsVarTupId bndrs)]) list_ty ; return (expr, bndrs_tuple_type) } -dsInnerListComp (XParStmtBlock{}) = panic "dsInnerListComp" +dsInnerListComp (XParStmtBlock nec) = noExtCon nec -- This function factors out commonality between the desugaring strategies for GroupStmt. -- Given such a statement it gives you back an expression representing how to compute the transformed @@ -107,7 +107,7 @@ dsTransStmt (TransStmt { trS_form = form, trS_stmts = stmts, trS_bndrs = binderM to_bndrs_tup_ty = mkBigCoreTupTy to_bndrs_tys -- Desugar an inner comprehension which outputs a list of tuples of the "from" binders - (expr', from_tup_ty) <- dsInnerListComp (ParStmtBlock noExt stmts + (expr', from_tup_ty) <- dsInnerListComp (ParStmtBlock noExtField stmts from_bndrs noSyntaxExpr) -- Work out what arguments should be supplied to that expression: i.e. is an extraction @@ -267,8 +267,8 @@ deListComp (RecStmt {} : _) _ = panic "deListComp RecStmt" deListComp (ApplicativeStmt {} : _) _ = panic "deListComp ApplicativeStmt" -deListComp (XStmtLR {} : _) _ = - panic "deListComp XStmtLR" +deListComp (XStmtLR nec : _) _ = + noExtCon nec deBindComp :: OutPat GhcTc -> CoreExpr @@ -364,8 +364,8 @@ dfListComp _ _ (ParStmt {} : _) = panic "dfListComp ParStmt" dfListComp _ _ (RecStmt {} : _) = panic "dfListComp RecStmt" dfListComp _ _ (ApplicativeStmt {} : _) = panic "dfListComp ApplicativeStmt" -dfListComp _ _ (XStmtLR {} : _) = - panic "dfListComp XStmtLR" +dfListComp _ _ (XStmtLR nec : _) = + noExtCon nec dfBindComp :: Id -> Id -- 'c' and 'n' -> (LPat GhcTc, CoreExpr) @@ -596,7 +596,7 @@ dsMcStmt (ParStmt bind_ty blocks mzip_op bind_op) stmts_rest ds_inner (ParStmtBlock _ stmts bndrs return_op) = do { exp <- dsInnerMonadComp stmts bndrs return_op ; return (exp, mkBigCoreVarTupTy bndrs) } - ds_inner (XParStmtBlock{}) = panic "dsMcStmt" + ds_inner (XParStmtBlock nec) = noExtCon nec dsMcStmt stmt _ = pprPanic "dsMcStmt: unexpected stmt" (ppr stmt) @@ -655,7 +655,7 @@ dsInnerMonadComp :: [ExprLStmt GhcTc] -> DsM CoreExpr dsInnerMonadComp stmts bndrs ret_op = dsMcStmts (stmts ++ - [noLoc (LastStmt noExt (mkBigLHsVarTupId bndrs) False ret_op)]) + [noLoc (LastStmt noExtField (mkBigLHsVarTupId bndrs) False ret_op)]) -- The `unzip` function for `GroupStmt` in a monad comprehensions diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 25f5ec0ab1..a8d2b7de0f 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -84,7 +84,7 @@ dsBracket brack splices do_brack (DecBrG _ gp) = do { MkC ds1 <- repTopDs gp ; return ds1 } do_brack (DecBrL {}) = panic "dsBracket: unexpected DecBrL" do_brack (TExpBr _ e) = do { MkC e1 <- repLE e ; return e1 } - do_brack (XBracket {}) = panic "dsBracket: unexpected XBracket" + do_brack (XBracket nec) = noExtCon nec {- -------------- Examples -------------------- @@ -178,7 +178,7 @@ repTopDs group@(HsGroup { hs_valds = valds no_warn _ = panic "repTopDs" no_doc (dL->L loc _) = notHandledL loc "Haddock documentation" empty -repTopDs (XHsGroup _) = panic "repTopDs" +repTopDs (XHsGroup nec) = noExtCon nec hsScopedTvBinders :: HsValBinds GhcRn -> [Name] -- See Note [Scoped type variables in bindings] @@ -208,8 +208,8 @@ get_scoped_tvs (dL->L _ signature) , hsib_body = hs_ty } <- sig , (explicit_vars, _) <- splitLHsForAllTy hs_ty = implicit_vars ++ hsLTyVarNames explicit_vars - get_scoped_tvs_from_sig (XHsImplicitBndrs _) - = panic "get_scoped_tvs_from_sig" + get_scoped_tvs_from_sig (XHsImplicitBndrs nec) + = noExtCon nec {- Notes @@ -374,7 +374,7 @@ repDataDefn tc opts ; repData cxt1 tc opts ksig' cons1 derivs1 } } -repDataDefn _ _ (XHsDataDefn _) = panic "repDataDefn" +repDataDefn _ _ (XHsDataDefn nec) = noExtCon nec repSynDecl :: Core TH.Name -> Core [TH.TyVarBndrQ] -> LHsType GhcRn @@ -425,7 +425,7 @@ repFamilyResultSig (KindSig _ ki) = do { ki' <- repLTy ki ; repKindSig ki' } repFamilyResultSig (TyVarSig _ bndr) = do { bndr' <- repTyVarBndr bndr ; repTyVarSig bndr' } -repFamilyResultSig (XFamilyResultSig _) = panic "repFamilyResultSig" +repFamilyResultSig (XFamilyResultSig nec) = noExtCon nec -- | Represent result signature using a Maybe Kind. Used with data families, -- where the result signature can be either missing or a kind but never a named @@ -511,7 +511,7 @@ repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds ; wrapGenSyms ss decls2 } where (tvs, cxt, inst_ty) = splitLHsInstDeclTy ty -repClsInstD (XClsInstDecl _) = panic "repClsInstD" +repClsInstD (XClsInstDecl nec) = noExtCon nec repStandaloneDerivD :: LDerivDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ) repStandaloneDerivD (dL->L loc (DerivDecl { deriv_strategy = strat @@ -556,8 +556,8 @@ repTyFamEqn (HsIB { hsib_ext = var_names where checkTys :: [LHsTypeArg GhcRn] -> DsM [LHsTypeArg GhcRn] checkTys tys@(HsValArg _:HsValArg _:_) = return tys checkTys _ = panic "repTyFamEqn:checkTys" -repTyFamEqn (XHsImplicitBndrs _) = panic "repTyFamEqn" -repTyFamEqn (HsIB _ (XFamEqn _)) = panic "repTyFamEqn" +repTyFamEqn (XHsImplicitBndrs nec) = noExtCon nec +repTyFamEqn (HsIB _ (XFamEqn nec)) = noExtCon nec repTyArgs :: DsM (Core TH.TypeQ) -> [LHsTypeArg GhcRn] -> DsM (Core TH.TypeQ) repTyArgs f [] = f @@ -596,10 +596,10 @@ repDataFamInstD (DataFamInstDecl { dfid_eqn = checkTys tys@(HsValArg _: HsValArg _: _) = return tys checkTys _ = panic "repDataFamInstD:checkTys" -repDataFamInstD (DataFamInstDecl (XHsImplicitBndrs _)) - = panic "repDataFamInstD" -repDataFamInstD (DataFamInstDecl (HsIB _ (XFamEqn _))) - = panic "repDataFamInstD" +repDataFamInstD (DataFamInstDecl (XHsImplicitBndrs nec)) + = noExtCon nec +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 @@ -694,7 +694,7 @@ ruleBndrNames (dL->L _ (RuleBndrSig _ _ (HsWC _ (XHsImplicitBndrs _)))) = panic "ruleBndrNames" ruleBndrNames (dL->L _ (RuleBndrSig _ _ (XHsWildCardBndrs _))) = panic "ruleBndrNames" -ruleBndrNames (dL->L _ (XRuleBndr _)) = panic "ruleBndrNames" +ruleBndrNames (dL->L _ (XRuleBndr nec)) = noExtCon nec ruleBndrNames _ = panic "ruleBndrNames: Impossible Match" -- due to #15884 repRuleBndr :: LRuleBndr GhcRn -> DsM (Core TH.RuleBndrQ) @@ -887,7 +887,7 @@ rep_ty_sig mk_sig loc sig_ty nm else repTForall th_explicit_tvs th_ctxt th_ty ; sig <- repProto mk_sig nm1 ty1 ; return (loc, sig) } -rep_ty_sig _ _ (XHsImplicitBndrs _) _ = panic "rep_ty_sig" +rep_ty_sig _ _ (XHsImplicitBndrs nec) _ = noExtCon nec rep_patsyn_ty_sig :: SrcSpan -> LHsSigType GhcRn -> Located Name -> DsM (SrcSpan, Core TH.DecQ) @@ -916,7 +916,7 @@ rep_patsyn_ty_sig loc sig_ty nm repTForall th_exis th_provs th_ty ; sig <- repProto patSynSigDName nm1 ty1 ; return (loc, sig) } -rep_patsyn_ty_sig _ (XHsImplicitBndrs _) _ = panic "rep_patsyn_ty_sig" +rep_patsyn_ty_sig _ (XHsImplicitBndrs nec) _ = noExtCon nec rep_wc_ty_sig :: Name -> SrcSpan -> LHsSigWcType GhcRn -> Located Name -> DsM (SrcSpan, Core TH.DecQ) @@ -1024,7 +1024,7 @@ addTyVarBinds (HsQTvs { hsq_ext = imp_tvs = addSimpleTyVarBinds imp_tvs $ addHsTyVarBinds exp_tvs $ thing_inside -addTyVarBinds (XLHsQTyVars _) _ = panic "addTyVarBinds" +addTyVarBinds (XLHsQTyVars nec) _ = noExtCon nec addTyClTyVarBinds :: LHsQTyVars GhcRn -> (Core [TH.TyVarBndrQ] -> DsM (Core (TH.Q a))) @@ -1095,12 +1095,12 @@ repHsSigType (HsIB { hsib_ext = implicit_tvs ; if null explicit_tvs && null (unLoc ctxt) then return th_ty else repTForall th_explicit_tvs th_ctxt th_ty } -repHsSigType (XHsImplicitBndrs _) = panic "repHsSigType" +repHsSigType (XHsImplicitBndrs nec) = noExtCon nec repHsSigWcType :: LHsSigWcType GhcRn -> DsM (Core TH.TypeQ) repHsSigWcType (HsWC { hswc_body = sig1 }) = repHsSigType sig1 -repHsSigWcType (XHsWildCardBndrs _) = panic "repHsSigWcType" +repHsSigWcType (XHsWildCardBndrs nec) = noExtCon nec -- yield the representation of a list of types repLTys :: [LHsType GhcRn] -> DsM [Core TH.TypeQ] @@ -1225,7 +1225,7 @@ repSplice (HsUntypedSplice _ _ n _) = rep_splice n repSplice (HsQuasiQuote _ n _ _ _) = rep_splice n repSplice e@(HsSpliced {}) = pprPanic "repSplice" (ppr e) repSplice e@(HsSplicedT {}) = pprPanic "repSpliceT" (ppr e) -repSplice e@(XSplice {}) = pprPanic "repSplice" (ppr e) +repSplice (XSplice nec) = noExtCon nec rep_splice :: Name -> DsM (Core a) rep_splice splice_name @@ -1262,7 +1262,7 @@ repE (HsIPVar _ n) = rep_implicit_param_name n >>= repImplicitParamVar repE (HsOverLabel _ _ s) = repOverLabel s repE e@(HsRecFld _ f) = case f of - Unambiguous x _ -> repE (HsVar noExt (noLoc x)) + Unambiguous x _ -> repE (HsVar noExtField (noLoc x)) Ambiguous{} -> notHandled "Ambiguous record selectors" (ppr e) XAmbiguousFieldOcc{} -> notHandled "XAmbiguous record selectors" (ppr e) @@ -1421,7 +1421,7 @@ repClauseTup (dL->L _ (Match { m_pats = ps gs <- repGuards guards ; clause <- repClause ps1 gs ds ; wrapGenSyms (ss1++ss2) clause }}} -repClauseTup (dL->L _ (Match _ _ _ (XGRHSs _))) = panic "repClauseTup" +repClauseTup (dL->L _ (Match _ _ _ (XGRHSs nec))) = noExtCon nec repClauseTup _ = panic "repClauseTup" repGuards :: [LGRHS GhcRn (LHsExpr GhcRn)] -> DsM (Core TH.BodyQ) @@ -1528,7 +1528,7 @@ repSts (ParStmt _ stmt_blocks _ _ : ss) = do { (ss1, zs) <- repSts (map unLoc stmts) ; zs1 <- coreList stmtQTyConName zs ; return (ss1, zs1) } - rep_stmt_block (XParStmtBlock{}) = panic "repSts" + rep_stmt_block (XParStmtBlock nec) = noExtCon nec repSts [LastStmt _ e _ _] = do { e2 <- repLE e ; z <- repNoBindSt e2 @@ -1638,7 +1638,7 @@ rep_bind (dL->L loc (FunBind { fun_id = fn ; ans <- repFun fn' (nonEmptyCoreList ms1) ; return (loc, ans) } -rep_bind (dL->L _ (FunBind { fun_matches = XMatchGroup _ })) = panic "rep_bind" +rep_bind (dL->L _ (FunBind { fun_matches = XMatchGroup nec })) = noExtCon nec rep_bind (dL->L loc (PatBind { pat_lhs = pat , pat_rhs = GRHSs _ guards (dL->L _ wheres) })) @@ -1648,7 +1648,7 @@ rep_bind (dL->L loc (PatBind { pat_lhs = pat ; ans <- repVal patcore guardcore wherecore ; ans' <- wrapGenSyms ss ans ; return (loc, ans') } -rep_bind (dL->L _ (PatBind _ _ (XGRHSs _) _)) = panic "rep_bind" +rep_bind (dL->L _ (PatBind _ _ (XGRHSs nec) _)) = noExtCon nec rep_bind (dL->L _ (VarBind { var_id = v, var_rhs = e})) = do { v' <- lookupBinder v @@ -1698,9 +1698,9 @@ 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 _))) - = panic "rep_bind: XPatSynBind" -rep_bind (dL->L _ (XHsBindsLR {})) = panic "rep_bind: XHsBindsLR" +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 @@ -1741,7 +1741,7 @@ repPatSynDir ImplicitBidirectional = rep2 implBidirPatSynName [] repPatSynDir (ExplicitBidirectional (MG { mg_alts = (dL->L _ clauses) })) = do { clauses' <- mapM repClauseTup clauses ; repExplBidirPatSynDir (nonEmptyCoreList clauses') } -repPatSynDir (ExplicitBidirectional (XMatchGroup _)) = panic "repPatSynDir" +repPatSynDir (ExplicitBidirectional (XMatchGroup nec)) = noExtCon nec repExplBidirPatSynDir :: Core [TH.ClauseQ] -> DsM (Core TH.PatSynDirQ) repExplBidirPatSynDir (MkC cls) = rep2 explBidirPatSynName [cls] @@ -2597,7 +2597,7 @@ mk_integer i = do integer_ty <- lookupType integerTyConName mk_rational :: FractionalLit -> DsM (HsLit GhcRn) mk_rational r = do rat_ty <- lookupType rationalTyConName - return $ HsRat noExt r rat_ty + return $ HsRat noExtField r rat_ty mk_string :: FastString -> DsM (HsLit GhcRn) mk_string s = return $ HsString NoSourceText s @@ -2610,7 +2610,7 @@ repOverloadedLiteral (OverLit { ol_val = val}) -- The type Rational will be in the environment, because -- the smart constructor 'TH.Syntax.rationalL' uses it in its type, -- and rationalL is sucked in when any TH stuff is used -repOverloadedLiteral XOverLit{} = panic "repOverloadedLiteral" +repOverloadedLiteral (XOverLit nec) = noExtCon nec mk_lit :: OverLitVal -> DsM (HsLit GhcRn) mk_lit (HsIntegral i) = mk_integer (il_value i) diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs index d4ceb523df..c4abd16737 100644 --- a/compiler/deSugar/DsUtils.hs +++ b/compiler/deSugar/DsUtils.hs @@ -955,7 +955,7 @@ decideBangHood dflags lpat ParPat x p -> cL l (ParPat x (go p)) LazyPat _ lp' -> lp' BangPat _ _ -> lp - _ -> cL l (BangPat noExt lp) + _ -> cL l (BangPat noExtField lp) -- | Unconditionally make a 'Pat' strict. addBang :: LPat GhcTc -- ^ Original pattern @@ -965,10 +965,10 @@ addBang = go go lp@(dL->L l p) = case p of ParPat x p -> cL l (ParPat x (go p)) - LazyPat _ lp' -> cL l (BangPat noExt lp') + LazyPat _ lp' -> cL l (BangPat noExtField lp') -- Should we bring the extension value over? BangPat _ _ -> lp - _ -> cL l (BangPat noExt lp) + _ -> cL l (BangPat noExtField lp) isTrueLHsExpr :: LHsExpr GhcTc -> Maybe (CoreExpr -> DsM CoreExpr) diff --git a/compiler/deSugar/ExtractDocs.hs b/compiler/deSugar/ExtractDocs.hs index d2b191349d..ce5299443b 100644 --- a/compiler/deSugar/ExtractDocs.hs +++ b/compiler/deSugar/ExtractDocs.hs @@ -137,7 +137,7 @@ sigNameNoLoc _ = [] -- Extract the source location where an instance is defined. This is used -- to correlate InstDecls with their Instance/CoAxiom Names, via the -- instanceMap. -getInstLoc :: InstDecl name -> SrcSpan +getInstLoc :: InstDecl (GhcPass p) -> SrcSpan getInstLoc = \case ClsInstD _ (ClsInstDecl { cid_poly_ty = ty }) -> getLoc (hsSigType ty) DataFamInstD _ (DataFamInstDecl @@ -234,10 +234,10 @@ classDecls :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])] classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls where decls = docs ++ defs ++ sigs ++ ats - docs = mkDecls tcdDocs (DocD noExt) class_ - defs = mkDecls (bagToList . tcdMeths) (ValD noExt) class_ - sigs = mkDecls tcdSigs (SigD noExt) class_ - ats = mkDecls tcdATs (TyClD noExt . FamDecl noExt) class_ + docs = mkDecls tcdDocs (DocD noExtField) class_ + defs = mkDecls (bagToList . tcdMeths) (ValD noExtField) class_ + sigs = mkDecls tcdSigs (SigD noExtField) class_ + ats = mkDecls tcdATs (TyClD noExtField . FamDecl noExtField) class_ -- | Extract function argument docs from inside top-level decls. declTypeDocs :: HsDecl GhcRn -> Map Int (HsDocString) @@ -280,14 +280,14 @@ topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . ungroup -- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'. ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn] ungroup group_ = - mkDecls (tyClGroupTyClDecls . hs_tyclds) (TyClD noExt) group_ ++ - mkDecls hs_derivds (DerivD noExt) group_ ++ - mkDecls hs_defds (DefD noExt) group_ ++ - mkDecls hs_fords (ForD noExt) group_ ++ - mkDecls hs_docs (DocD noExt) group_ ++ - mkDecls (tyClGroupInstDecls . hs_tyclds) (InstD noExt) group_ ++ - mkDecls (typesigs . hs_valds) (SigD noExt) group_ ++ - mkDecls (valbinds . hs_valds) (ValD noExt) group_ + mkDecls (tyClGroupTyClDecls . hs_tyclds) (TyClD noExtField) group_ ++ + mkDecls hs_derivds (DerivD noExtField) group_ ++ + mkDecls hs_defds (DefD noExtField) group_ ++ + mkDecls hs_fords (ForD noExtField) group_ ++ + mkDecls hs_docs (DocD noExtField) group_ ++ + mkDecls (tyClGroupInstDecls . hs_tyclds) (InstD noExtField) group_ ++ + mkDecls (typesigs . hs_valds) (SigD noExtField) group_ ++ + mkDecls (valbinds . hs_valds) (ValD noExtField) group_ where typesigs (XValBindsLR (NValBinds _ sigs)) = filter (isUserSig . unLoc) sigs typesigs ValBinds{} = error "expected XValBindsLR" diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs index c057298420..921b829fb9 100644 --- a/compiler/deSugar/Match.hs +++ b/compiler/deSugar/Match.hs @@ -501,9 +501,9 @@ tidy_bang_pat v o _ (SigPat _ (dL->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 noExt p))) + = tidy1 v o (AsPat x v' (cL l (BangPat noExtField p))) tidy_bang_pat v o l (CoPat x w p t) - = tidy1 v o (CoPat x w (BangPat noExt (cL l p)) t) + = tidy1 v o (CoPat x w (BangPat noExtField (cL l p)) t) -- Discard bang around strict pattern tidy_bang_pat v o _ p@(LitPat {}) = tidy1 v o p @@ -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 noExt (cL l p)) +tidy_bang_pat _ _ l p = return (idDsWrapper, BangPat noExtField (cL 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 noExt arg)] + PrefixCon [cL l (BangPat noExtField arg)] push_bang_into_newtype_arg l _ty (RecCon rf) | HsRecFields { rec_flds = (dL->L lf fld) : flds } <- rf , HsRecField { hsRecFieldArg = arg } <- fld = ASSERT( null flds) RecCon (rf { rec_flds = [cL lf (fld { hsRecFieldArg - = cL l (BangPat noExt arg) })] }) + = cL 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 noExt (noLoc (WildPat ty)))] + = PrefixCon [cL l (BangPat noExtField (noLoc (WildPat ty)))] push_bang_into_newtype_arg _ _ cd = pprPanic "push_bang_into_newtype_arg" (pprConArgs cd) @@ -752,13 +752,13 @@ 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 _)) = panic "matchWrapper" + mk_eqn_info _ (dL->L _ (XMatch nec)) = noExtCon nec mk_eqn_info _ _ = panic "mk_eqn_info: Impossible Match" -- due to #15884 handleWarnings = if isGenerated origin then discardWarningsDs else id -matchWrapper _ _ (XMatchGroup _) = panic "matchWrapper" +matchWrapper _ _ (XMatchGroup nec) = noExtCon nec matchEquations :: HsMatchContext Name -> [MatchId] -> [EquationInfo] -> Type diff --git a/compiler/deSugar/MatchLit.hs b/compiler/deSugar/MatchLit.hs index d99ae7e443..3bab8cf000 100644 --- a/compiler/deSugar/MatchLit.hs +++ b/compiler/deSugar/MatchLit.hs @@ -95,7 +95,7 @@ dsLit l = do HsString _ str -> mkStringExprFS str HsInteger _ i _ -> mkIntegerExpr i HsInt _ i -> return (mkIntExpr dflags (il_value i)) - XLit x -> pprPanic "dsLit" (ppr x) + XLit nec -> noExtCon nec HsRat _ (FL _ _ val) ty -> do num <- mkIntegerExpr (numerator val) denom <- mkIntegerExpr (denominator val) @@ -116,7 +116,7 @@ dsOverLit (OverLit { ol_val = val, ol_ext = OverLitTc rebindable ty case shortCutLit dflags val ty of Just expr | not rebindable -> dsExpr expr -- Note [Literal short cut] _ -> dsExpr witness -dsOverLit XOverLit{} = panic "dsOverLit" +dsOverLit (XOverLit nec) = noExtCon nec {- Note [Literal short cut] ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -337,7 +337,7 @@ tidyLitPat (HsString src s) (mkNilPat charTy) (unpackFS s) -- The stringTy is the type of the whole pattern, not -- the type to instantiate (:) or [] with! -tidyLitPat lit = LitPat noExt lit +tidyLitPat lit = LitPat noExtField lit ---------------- tidyNPat :: HsOverLit GhcTc -> Maybe (SyntaxExpr GhcTc) -> SyntaxExpr GhcTc @@ -373,7 +373,7 @@ tidyNPat (OverLit (OverLitTc False ty) val _) mb_neg _eq outer_ty mk_con_pat :: DataCon -> HsLit GhcTc -> Pat GhcTc mk_con_pat con lit - = unLoc (mkPrefixConPat con [noLoc $ LitPat noExt lit] []) + = unLoc (mkPrefixConPat con [noLoc $ LitPat noExtField lit] []) mb_int_lit :: Maybe Integer mb_int_lit = case (mb_neg, val) of diff --git a/compiler/hieFile/HieAst.hs b/compiler/hieFile/HieAst.hs index 7c3ceb6138..e1047692ff 100644 --- a/compiler/hieFile/HieAst.hs +++ b/compiler/hieFile/HieAst.hs @@ -283,7 +283,7 @@ type family ProtectedSig a where ProtectedSig GhcRn = HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (Shielded (LHsType GhcRn))) - ProtectedSig GhcTc = NoExt + ProtectedSig GhcTc = NoExtField class ProtectSig a where protectSig :: Scope -> LHsSigWcType (NoGhcTc a) -> ProtectedSig a @@ -295,7 +295,7 @@ instance (ToHie (TScoped a)) => ToHie (TScoped (Shielded a)) where toHie (TS _ (SH sc a)) = toHie (TS (ResolvedScopes [sc]) a) instance ProtectSig GhcTc where - protectSig _ _ = NoExt + protectSig _ _ = noExtField instance ProtectSig GhcRn where protectSig sc (HsWC a (HsIB b sig)) = @@ -368,10 +368,10 @@ instance (ToHie a) => ToHie (Bag a) where instance (ToHie a) => ToHie (Maybe a) where toHie = maybe (pure []) toHie -instance ToHie (Context (Located NoExt)) where +instance ToHie (Context (Located NoExtField)) where toHie _ = pure [] -instance ToHie (TScoped NoExt) where +instance ToHie (TScoped NoExtField) where toHie _ = pure [] instance ToHie (IEContext (Located ModuleName)) where diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 97329aaa55..ee6553ce04 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -147,16 +147,16 @@ cvtDec (TH.ValD pat body ds) | TH.VarP s <- pat = do { s' <- vNameL s ; cl' <- cvtClause (mkPrefixFunRhs s') (Clause [] body ds) - ; returnJustL $ Hs.ValD noExt $ mkFunBind s' [cl'] } + ; returnJustL $ Hs.ValD noExtField $ mkFunBind s' [cl'] } | otherwise = do { pat' <- cvtPat pat ; body' <- cvtGuard body ; ds' <- cvtLocalDecs (text "a where clause") ds - ; returnJustL $ Hs.ValD noExt $ + ; returnJustL $ Hs.ValD noExtField $ PatBind { pat_lhs = pat' - , pat_rhs = GRHSs noExt body' (noLoc ds') - , pat_ext = noExt + , pat_rhs = GRHSs noExtField body' (noLoc ds') + , pat_ext = noExtField , pat_ticks = ([],[]) } } cvtDec (TH.FunD nm cls) @@ -167,13 +167,13 @@ cvtDec (TH.FunD nm cls) | otherwise = do { nm' <- vNameL nm ; cls' <- mapM (cvtClause (mkPrefixFunRhs nm')) cls - ; returnJustL $ Hs.ValD noExt $ mkFunBind nm' cls' } + ; returnJustL $ Hs.ValD noExtField $ mkFunBind nm' cls' } cvtDec (TH.SigD nm typ) = do { nm' <- vNameL nm ; ty' <- cvtType typ - ; returnJustL $ Hs.SigD noExt - (TypeSig noExt [nm'] (mkLHsSigWcType ty')) } + ; returnJustL $ Hs.SigD noExtField + (TypeSig noExtField [nm'] (mkLHsSigWcType ty')) } cvtDec (TH.InfixD fx nm) -- Fixity signatures are allowed for variables, constructors, and types @@ -181,8 +181,8 @@ cvtDec (TH.InfixD fx nm) -- the RdrName says it's a variable or a constructor. So, just assume -- it's a variable or constructor and proceed. = do { nm' <- vcNameL nm - ; returnJustL (Hs.SigD noExt (FixSig noExt - (FixitySig noExt [nm'] (cvtFixity fx)))) } + ; returnJustL (Hs.SigD noExtField (FixSig noExtField + (FixitySig noExtField [nm'] (cvtFixity fx)))) } cvtDec (PragmaD prag) = cvtPragmaD prag @@ -190,8 +190,8 @@ cvtDec (PragmaD prag) cvtDec (TySynD tc tvs rhs) = do { (_, tc', tvs') <- cvt_tycl_hdr [] tc tvs ; rhs' <- cvtType rhs - ; returnJustL $ TyClD noExt $ - SynDecl { tcdSExt = noExt, tcdLName = tc', tcdTyVars = tvs' + ; returnJustL $ TyClD noExtField $ + SynDecl { tcdSExt = noExtField, tcdLName = tc', tcdTyVars = tvs' , tcdFixity = Prefix , tcdRhs = rhs' } } @@ -211,33 +211,33 @@ cvtDec (DataD ctxt tc tvs ksig constrs derivs) ; ksig' <- cvtKind `traverse` ksig ; cons' <- mapM cvtConstr constrs ; derivs' <- cvtDerivs derivs - ; let defn = HsDataDefn { dd_ext = noExt + ; let defn = HsDataDefn { dd_ext = noExtField , dd_ND = DataType, dd_cType = Nothing , dd_ctxt = ctxt' , dd_kindSig = ksig' , dd_cons = cons', dd_derivs = derivs' } - ; returnJustL $ TyClD noExt (DataDecl - { tcdDExt = noExt - , tcdLName = tc', tcdTyVars = tvs' - , tcdFixity = Prefix - , tcdDataDefn = defn }) } + ; returnJustL $ TyClD noExtField $ + DataDecl { tcdDExt = noExtField + , tcdLName = tc', tcdTyVars = tvs' + , tcdFixity = Prefix + , tcdDataDefn = defn } } cvtDec (NewtypeD ctxt tc tvs ksig constr derivs) = do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs ; ksig' <- cvtKind `traverse` ksig ; con' <- cvtConstr constr ; derivs' <- cvtDerivs derivs - ; let defn = HsDataDefn { dd_ext = noExt + ; let defn = HsDataDefn { dd_ext = noExtField , dd_ND = NewType, dd_cType = Nothing , dd_ctxt = ctxt' , dd_kindSig = ksig' , dd_cons = [con'] , dd_derivs = derivs' } - ; returnJustL $ TyClD noExt (DataDecl - { tcdDExt = noExt - , tcdLName = tc', tcdTyVars = tvs' - , tcdFixity = Prefix - , tcdDataDefn = defn }) } + ; returnJustL $ TyClD noExtField $ + DataDecl { tcdDExt = noExtField + , tcdLName = tc', tcdTyVars = tvs' + , tcdFixity = Prefix + , tcdDataDefn = defn } } cvtDec (ClassD ctxt cl tvs fds decs) = do { (cxt', tc', tvs') <- cvt_tycl_hdr ctxt cl tvs @@ -247,8 +247,8 @@ cvtDec (ClassD ctxt cl tvs fds decs) (failWith $ (text "Default data instance declarations" <+> text "are not allowed:") $$ (Outputable.ppr adts')) - ; returnJustL $ TyClD noExt $ - ClassDecl { tcdCExt = noExt + ; returnJustL $ TyClD noExtField $ + ClassDecl { tcdCExt = noExtField , tcdCtxt = cxt', tcdLName = tc', tcdTyVars = tvs' , tcdFixity = Prefix , tcdFDs = fds', tcdSigs = Hs.mkClassOpSigs sigs' @@ -264,8 +264,8 @@ cvtDec (InstanceD o ctxt ty decs) ; ctxt' <- cvtContext funPrec ctxt ; (dL->L loc ty') <- cvtType ty ; let inst_ty' = mkHsQualTy ctxt loc ctxt' $ cL loc ty' - ; returnJustL $ InstD noExt $ ClsInstD noExt $ - ClsInstDecl { cid_ext = noExt, cid_poly_ty = mkLHsSigType inst_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' @@ -283,29 +283,29 @@ cvtDec (InstanceD o ctxt ty decs) cvtDec (ForeignD ford) = do { ford' <- cvtForD ford - ; returnJustL $ ForD noExt ford' } + ; returnJustL $ ForD noExtField ford' } cvtDec (DataFamilyD tc tvs kind) = do { (_, tc', tvs') <- cvt_tycl_hdr [] tc tvs ; result <- cvtMaybeKindToFamilyResultSig kind - ; returnJustL $ TyClD noExt $ FamDecl noExt $ - FamilyDecl noExt DataFamily tc' tvs' Prefix result Nothing } + ; returnJustL $ TyClD noExtField $ FamDecl noExtField $ + FamilyDecl noExtField DataFamily tc' tvs' Prefix result Nothing } cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs) = do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys ; ksig' <- cvtKind `traverse` ksig ; cons' <- mapM cvtConstr constrs ; derivs' <- cvtDerivs derivs - ; let defn = HsDataDefn { dd_ext = noExt + ; let defn = HsDataDefn { dd_ext = noExtField , dd_ND = DataType, dd_cType = Nothing , dd_ctxt = ctxt' , dd_kindSig = ksig' , dd_cons = cons', dd_derivs = derivs' } - ; returnJustL $ InstD noExt $ DataFamInstD - { dfid_ext = noExt + ; returnJustL $ InstD noExtField $ DataFamInstD + { dfid_ext = noExtField , dfid_inst = DataFamInstDecl { dfid_eqn = mkHsImplicitBndrs $ - FamEqn { feqn_ext = noExt + FamEqn { feqn_ext = noExtField , feqn_tycon = tc' , feqn_bndrs = bndrs' , feqn_pats = typats' @@ -317,15 +317,15 @@ cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs) ; ksig' <- cvtKind `traverse` ksig ; con' <- cvtConstr constr ; derivs' <- cvtDerivs derivs - ; let defn = HsDataDefn { dd_ext = noExt + ; let defn = HsDataDefn { dd_ext = noExtField , dd_ND = NewType, dd_cType = Nothing , dd_ctxt = ctxt' , dd_kindSig = ksig' , dd_cons = [con'], dd_derivs = derivs' } - ; returnJustL $ InstD noExt $ DataFamInstD - { dfid_ext = noExt + ; returnJustL $ InstD noExtField $ DataFamInstD + { dfid_ext = noExtField , dfid_inst = DataFamInstDecl { dfid_eqn = mkHsImplicitBndrs $ - FamEqn { feqn_ext = noExt + FamEqn { feqn_ext = noExtField , feqn_tycon = tc' , feqn_bndrs = bndrs' , feqn_pats = typats' @@ -334,35 +334,35 @@ cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs) cvtDec (TySynInstD eqn) = do { (dL->L _ eqn') <- cvtTySynEqn eqn - ; returnJustL $ InstD noExt $ TyFamInstD - { tfid_ext = noExt + ; returnJustL $ InstD noExtField $ TyFamInstD + { tfid_ext = noExtField , tfid_inst = TyFamInstDecl { tfid_eqn = eqn' } } } cvtDec (OpenTypeFamilyD head) = do { (tc', tyvars', result', injectivity') <- cvt_tyfam_head head - ; returnJustL $ TyClD noExt $ FamDecl noExt $ - FamilyDecl noExt OpenTypeFamily tc' tyvars' Prefix result' injectivity' + ; returnJustL $ TyClD noExtField $ FamDecl noExtField $ + FamilyDecl noExtField OpenTypeFamily tc' tyvars' Prefix result' injectivity' } cvtDec (ClosedTypeFamilyD head eqns) = do { (tc', tyvars', result', injectivity') <- cvt_tyfam_head head ; eqns' <- mapM cvtTySynEqn eqns - ; returnJustL $ TyClD noExt $ FamDecl noExt $ - FamilyDecl noExt (ClosedTypeFamily (Just eqns')) tc' tyvars' Prefix + ; returnJustL $ TyClD noExtField $ FamDecl noExtField $ + FamilyDecl noExtField (ClosedTypeFamily (Just eqns')) tc' tyvars' Prefix result' injectivity' } cvtDec (TH.RoleAnnotD tc roles) = do { tc' <- tconNameL tc ; let roles' = map (noLoc . cvtRole) roles - ; returnJustL $ Hs.RoleAnnotD noExt (RoleAnnotDecl noExt tc' roles') } + ; returnJustL $ Hs.RoleAnnotD noExtField (RoleAnnotDecl noExtField 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' - ; returnJustL $ DerivD noExt $ - DerivDecl { deriv_ext =noExt + ; returnJustL $ DerivD noExtField $ + DerivDecl { deriv_ext =noExtField , deriv_strategy = ds' , deriv_type = mkLHsSigWcType inst_ty' , deriv_overlap_mode = Nothing } } @@ -370,16 +370,16 @@ cvtDec (TH.StandaloneDerivD ds cxt ty) cvtDec (TH.DefaultSigD nm typ) = do { nm' <- vNameL nm ; ty' <- cvtType typ - ; returnJustL $ Hs.SigD noExt - $ ClassOpSig noExt True [nm'] (mkLHsSigType ty')} + ; returnJustL $ Hs.SigD noExtField + $ ClassOpSig noExtField True [nm'] (mkLHsSigType ty')} cvtDec (TH.PatSynD nm args dir pat) = do { nm' <- cNameL nm ; args' <- cvtArgs args ; dir' <- cvtDir nm' dir ; pat' <- cvtPat pat - ; returnJustL $ Hs.ValD noExt $ PatSynBind noExt $ - PSB noExt nm' args' pat' dir' } + ; returnJustL $ Hs.ValD noExtField $ PatSynBind noExtField $ + PSB noExtField nm' args' pat' dir' } where cvtArgs (TH.PrefixPatSyn args) = Hs.PrefixCon <$> mapM vNameL args cvtArgs (TH.InfixPatSyn a1 a2) = Hs.InfixCon <$> vNameL a1 <*> vNameL a2 @@ -397,7 +397,7 @@ cvtDec (TH.PatSynD nm args dir pat) cvtDec (TH.PatSynSigD nm ty) = do { nm' <- cNameL nm ; ty' <- cvtPatSynSigTy ty - ; returnJustL $ Hs.SigD noExt $ PatSynSig noExt [nm'] (mkLHsSigType ty')} + ; returnJustL $ Hs.SigD noExtField $ PatSynSig noExtField [nm'] (mkLHsSigType ty')} -- Implicit parameter bindings are handled in cvtLocalDecs and -- cvtImplicitParamBind. They are not allowed in any other scope, so @@ -415,7 +415,7 @@ cvtTySynEqn (TySynEqn mb_bndrs lhs rhs) ; rhs' <- cvtType rhs ; let args' = map wrap_tyarg args ; returnL $ mkHsImplicitBndrs - $ FamEqn { feqn_ext = noExt + $ FamEqn { feqn_ext = noExtField , feqn_tycon = nm' , feqn_bndrs = mb_bndrs' , feqn_pats = args' @@ -425,7 +425,7 @@ cvtTySynEqn (TySynEqn mb_bndrs lhs rhs) ; args' <- mapM cvtType [t1,t2] ; rhs' <- cvtType rhs ; returnL $ mkHsImplicitBndrs - $ FamEqn { feqn_ext = noExt + $ FamEqn { feqn_ext = noExtField , feqn_tycon = nm' , feqn_bndrs = mb_bndrs' , feqn_pats = @@ -587,7 +587,7 @@ cvtConstr (ForallC tvs ctxt con) where all_tvs = hsQTvExplicit tvs' ++ ex_tvs - add_forall _ _ (XConDecl _) = panic "cvtConstr" + add_forall _ _ (XConDecl nec) = noExtCon nec cvtConstr (GadtC c strtys ty) = do { c' <- mapM cNameL c @@ -600,8 +600,8 @@ cvtConstr (RecGadtC c varstrtys ty) = do { c' <- mapM cNameL c ; ty' <- cvtType ty ; rec_flds <- mapM cvt_id_arg varstrtys - ; let rec_ty = noLoc (HsFunTy noExt - (noLoc $ HsRecTy noExt rec_flds) ty') + ; let rec_ty = noLoc (HsFunTy noExtField + (noLoc $ HsRecTy noExtField rec_flds) ty') ; returnL $ fst $ mkGadtDecl c' rec_ty } cvtSrcUnpackedness :: TH.SourceUnpackedness -> SrcUnpackedness @@ -620,16 +620,16 @@ cvt_arg (Bang su ss, ty) ; let ty' = parenthesizeHsType appPrec ty'' su' = cvtSrcUnpackedness su ss' = cvtSrcStrictness ss - ; returnL $ HsBangTy noExt (HsSrcBang NoSourceText su' ss') ty' } + ; returnL $ HsBangTy noExtField (HsSrcBang NoSourceText 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 ; ty' <- cvt_arg (str,ty) ; return $ noLoc (ConDeclField - { cd_fld_ext = noExt + { cd_fld_ext = noExtField , cd_fld_names - = [cL li $ FieldOcc noExt (cL li i')] + = [cL li $ FieldOcc noExtField (cL li i')] , cd_fld_type = ty' , cd_fld_doc = Nothing}) } @@ -667,7 +667,7 @@ cvtForD (ImportF callconv safety from nm ty) mk_imp impspec = do { nm' <- vNameL nm ; ty' <- cvtType ty - ; return (ForeignImport { fd_i_ext = noExt + ; return (ForeignImport { fd_i_ext = noExtField , fd_name = nm' , fd_sig_ty = mkLHsSigType ty' , fd_fi = impspec }) @@ -684,7 +684,7 @@ cvtForD (ExportF callconv as nm ty) (mkFastString as) (cvt_conv callconv))) (noLoc (SourceText as)) - ; return $ ForeignExport { fd_e_ext = noExt + ; return $ ForeignExport { fd_e_ext = noExtField , fd_name = nm' , fd_sig_ty = mkLHsSigType ty' , fd_fe = e } } @@ -712,7 +712,7 @@ cvtPragmaD (InlineP nm inline rm phases) , inl_rule = cvtRuleMatch rm , inl_act = cvtPhases phases dflt , inl_sat = Nothing } - ; returnJustL $ Hs.SigD noExt $ InlineSig noExt nm' ip } + ; returnJustL $ Hs.SigD noExtField $ InlineSig noExtField nm' ip } cvtPragmaD (SpecialiseP nm ty inline phases) = do { nm' <- vNameL nm @@ -730,12 +730,12 @@ cvtPragmaD (SpecialiseP nm ty inline phases) , inl_rule = Hs.FunLike , inl_act = cvtPhases phases dflt , inl_sat = Nothing } - ; returnJustL $ Hs.SigD noExt $ SpecSig noExt nm' [mkLHsSigType ty'] ip } + ; returnJustL $ Hs.SigD noExtField $ SpecSig noExtField nm' [mkLHsSigType ty'] ip } cvtPragmaD (SpecialiseInstP ty) = do { ty' <- cvtType ty - ; returnJustL $ Hs.SigD noExt $ - SpecInstSig noExt (SourceText "{-# SPECIALISE") (mkLHsSigType ty') } + ; returnJustL $ Hs.SigD noExtField $ + SpecInstSig noExtField (SourceText "{-# SPECIALISE") (mkLHsSigType ty') } cvtPragmaD (RuleP nm ty_bndrs tm_bndrs lhs rhs phases) = do { let nm' = mkFastString nm @@ -744,11 +744,11 @@ cvtPragmaD (RuleP nm ty_bndrs tm_bndrs lhs rhs phases) ; tm_bndrs' <- mapM cvtRuleBndr tm_bndrs ; lhs' <- cvtl lhs ; rhs' <- cvtl rhs - ; returnJustL $ Hs.RuleD noExt - $ HsRules { rds_ext = noExt + ; returnJustL $ Hs.RuleD noExtField + $ HsRules { rds_ext = noExtField , rds_src = SourceText "{-# RULES" , rds_rules = [noLoc $ - HsRule { rd_ext = noExt + HsRule { rd_ext = noExtField , rd_name = (noLoc (quotedSourceText nm,nm')) , rd_act = act , rd_tyvs = ty_bndrs' @@ -768,8 +768,8 @@ cvtPragmaD (AnnP target exp) ValueAnnotation n -> do n' <- vcName n return (ValueAnnProvenance (noLoc n')) - ; returnJustL $ Hs.AnnD noExt - $ HsAnnotation noExt (SourceText "{-# ANN") target' exp' + ; returnJustL $ Hs.AnnD noExtField + $ HsAnnotation noExtField (SourceText "{-# ANN") target' exp' } cvtPragmaD (LineP line file) @@ -779,8 +779,8 @@ cvtPragmaD (LineP line file) cvtPragmaD (CompleteP cls mty) = do { cls' <- noLoc <$> mapM cNameL cls ; mty' <- traverse tconNameL mty - ; returnJustL $ Hs.SigD noExt - $ CompleteMatchSig noExt NoSourceText cls' mty' } + ; returnJustL $ Hs.SigD noExtField + $ CompleteMatchSig noExtField NoSourceText cls' mty' } dfltActivation :: TH.Inline -> Activation dfltActivation TH.NoInline = NeverActive @@ -803,11 +803,11 @@ cvtPhases (BeforePhase i) _ = ActiveBefore NoSourceText i cvtRuleBndr :: TH.RuleBndr -> CvtM (Hs.LRuleBndr GhcPs) cvtRuleBndr (RuleVar n) = do { n' <- vNameL n - ; return $ noLoc $ Hs.RuleBndr noExt n' } + ; return $ noLoc $ Hs.RuleBndr noExtField n' } cvtRuleBndr (TypedRuleVar n ty) = do { n' <- vNameL n ; ty' <- cvtType ty - ; return $ noLoc $ Hs.RuleBndrSig noExt n' $ mkLHsSigWcType ty' } + ; return $ noLoc $ Hs.RuleBndrSig noExtField n' $ mkLHsSigWcType ty' } --------------------------------------------------- -- Declarations @@ -816,16 +816,16 @@ cvtRuleBndr (TypedRuleVar n ty) cvtLocalDecs :: MsgDoc -> [TH.Dec] -> CvtM (HsLocalBinds GhcPs) cvtLocalDecs doc ds = case partitionWith is_ip_bind ds of - ([], []) -> return (EmptyLocalBinds noExt) + ([], []) -> return (EmptyLocalBinds noExtField) ([], _) -> do ds' <- cvtDecs ds let (binds, prob_sigs) = partitionWith is_bind ds' let (sigs, bads) = partitionWith is_sig prob_sigs unless (null bads) (failWith (mkBadDecMsg doc bads)) - return (HsValBinds noExt (ValBinds noExt (listToBag binds) sigs)) + return (HsValBinds noExtField (ValBinds noExtField (listToBag binds) sigs)) (ip_binds, []) -> do binds <- mapM (uncurry cvtImplicitParamBind) ip_binds - return (HsIPBinds noExt (IPBinds noExt binds)) + return (HsIPBinds noExtField (IPBinds noExtField binds)) ((_:_), (_:_)) -> failWith (text "Implicit parameters mixed with other bindings") @@ -836,13 +836,13 @@ cvtClause ctxt (Clause ps body wheres) ; let pps = map (parenthesizePat appPrec) ps' ; g' <- cvtGuard body ; ds' <- cvtLocalDecs (text "a where clause") wheres - ; returnL $ Hs.Match noExt ctxt pps (GRHSs noExt g' (noLoc ds')) } + ; returnL $ Hs.Match noExtField ctxt pps (GRHSs noExtField g' (noLoc ds')) } cvtImplicitParamBind :: String -> TH.Exp -> CvtM (LIPBind GhcPs) cvtImplicitParamBind n e = do n' <- wrapL (ipName n) e' <- cvtl e - returnL (IPBind noExt (Left n') e') + returnL (IPBind noExtField (Left n') e') ------------------------------------------------------------------- -- Expressions @@ -851,12 +851,12 @@ cvtImplicitParamBind n e = do cvtl :: TH.Exp -> CvtM (LHsExpr GhcPs) cvtl e = wrapL (cvt e) where - cvt (VarE s) = do { s' <- vName s; return $ HsVar noExt (noLoc s') } - cvt (ConE s) = do { s' <- cName s; return $ HsVar noExt (noLoc s') } + cvt (VarE s) = do { s' <- vName s; return $ HsVar noExtField (noLoc s') } + cvt (ConE s) = do { s' <- cName s; return $ HsVar noExtField (noLoc s') } cvt (LitE l) - | overloadedLit l = go cvtOverLit (HsOverLit noExt) + | overloadedLit l = go cvtOverLit (HsOverLit noExtField) (hsOverLitNeedsParens appPrec) - | otherwise = go cvtLit (HsLit noExt) + | otherwise = go cvtLit (HsLit noExtField) (hsLitNeedsParens appPrec) where go :: (Lit -> CvtM (l GhcPs)) @@ -866,17 +866,17 @@ cvtl e = wrapL (cvt e) go cvt_lit mk_expr is_compound_lit = do l' <- cvt_lit l let e' = mk_expr l' - return $ if is_compound_lit l' then HsPar noExt (noLoc e') else e' + return $ if is_compound_lit l' then HsPar noExtField (noLoc e') else e' cvt (AppE x@(LamE _ _) y) = do { x' <- cvtl x; y' <- cvtl y - ; return $ HsApp noExt (mkLHsPar x') + ; return $ HsApp noExtField (mkLHsPar x') (mkLHsPar y')} cvt (AppE x y) = do { x' <- cvtl x; y' <- cvtl y - ; return $ HsApp noExt (mkLHsPar x') + ; return $ HsApp noExtField (mkLHsPar x') (mkLHsPar y')} cvt (AppTypeE e t) = do { e' <- cvtl e ; t' <- cvtType t ; let tp = parenthesizeHsType appPrec t' - ; return $ HsAppType noExt e' + ; return $ HsAppType noExtField e' $ mkHsWildCardBndrs tp } cvt (LamE [] e) = cvt e -- Degenerate case. We convert the body as its -- own expression to avoid pretty-printing @@ -884,44 +884,44 @@ cvtl e = wrapL (cvt e) -- lambda expressions. See #13856. cvt (LamE ps e) = do { ps' <- cvtPats ps; e' <- cvtl e ; let pats = map (parenthesizePat appPrec) ps' - ; return $ HsLam noExt (mkMatchGroup FromSource + ; return $ HsLam noExtField (mkMatchGroup FromSource [mkSimpleMatch LambdaExpr pats e'])} cvt (LamCaseE ms) = do { ms' <- mapM (cvtMatch CaseAlt) ms - ; return $ HsLamCase noExt + ; return $ HsLamCase noExtField (mkMatchGroup FromSource ms') } - cvt (TupE [Just e]) = do { e' <- cvtl e; return $ HsPar noExt e' } + cvt (TupE [Just e]) = do { e' <- cvtl e; return $ HsPar noExtField e' } -- Note [Dropping constructors] -- Singleton tuples treated like nothing (just parens) cvt (TupE es) = cvt_tup es Boxed cvt (UnboxedTupE es) = cvt_tup es Unboxed cvt (UnboxedSumE e alt arity) = do { e' <- cvtl e ; unboxedSumChecks alt arity - ; return $ ExplicitSum noExt + ; return $ ExplicitSum noExtField alt arity e'} cvt (CondE x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z; - ; return $ HsIf noExt (Just noSyntaxExpr) x' y' z' } + ; return $ HsIf noExtField (Just noSyntaxExpr) x' y' z' } cvt (MultiIfE alts) | null alts = failWith (text "Multi-way if-expression with no alternatives") | otherwise = do { alts' <- mapM cvtpair alts - ; return $ HsMultiIf noExt alts' } + ; return $ HsMultiIf noExtField alts' } cvt (LetE ds e) = do { ds' <- cvtLocalDecs (text "a let expression") ds - ; e' <- cvtl e; return $ HsLet noExt (noLoc ds') e'} + ; e' <- cvtl e; return $ HsLet noExtField (noLoc ds') e'} cvt (CaseE e ms) = do { e' <- cvtl e; ms' <- mapM (cvtMatch CaseAlt) ms - ; return $ HsCase noExt e' + ; return $ HsCase noExtField e' (mkMatchGroup FromSource ms') } cvt (DoE ss) = cvtHsDo DoExpr ss cvt (MDoE ss) = cvtHsDo MDoExpr ss cvt (CompE ss) = cvtHsDo ListComp ss cvt (ArithSeqE dd) = do { dd' <- cvtDD dd - ; return $ ArithSeq noExt Nothing dd' } + ; return $ ArithSeq noExtField Nothing dd' } cvt (ListE xs) | Just s <- allCharLs xs = do { l' <- cvtLit (StringL s) - ; return (HsLit noExt l') } + ; return (HsLit noExtField l') } -- Note [Converting strings] | otherwise = do { xs' <- mapM cvtl xs - ; return $ ExplicitList noExt Nothing xs' + ; return $ ExplicitList noExtField Nothing xs' } -- Infix expressions @@ -931,25 +931,25 @@ cvtl e = wrapL (cvt e) ; y' <- cvtl y ; let px = parenthesizeHsExpr opPrec x' py = parenthesizeHsExpr opPrec y' - ; wrapParL (HsPar noExt) - $ OpApp noExt px s' py } + ; wrapParL (HsPar noExtField) + $ OpApp noExtField px s' py } -- Parenthesise both arguments and result, -- to ensure this operator application does -- does not get re-associated -- See Note [Operator association] cvt (InfixE Nothing s (Just y)) = ensureValidOpExp s $ do { s' <- cvtl s; y' <- cvtl y - ; wrapParL (HsPar noExt) $ - SectionR noExt s' y' } + ; wrapParL (HsPar noExtField) $ + SectionR noExtField s' y' } -- See Note [Sections in HsSyn] in HsExpr cvt (InfixE (Just x) s Nothing ) = ensureValidOpExp s $ do { x' <- cvtl x; s' <- cvtl s - ; wrapParL (HsPar noExt) $ - SectionL noExt x' s' } + ; wrapParL (HsPar noExtField) $ + SectionL noExtField x' s' } cvt (InfixE Nothing s Nothing ) = ensureValidOpExp s $ do { s' <- cvtl s - ; return $ HsPar noExt s' } + ; return $ HsPar noExtField s' } -- Can I indicate this is an infix thing? -- Note [Dropping constructors] @@ -960,10 +960,10 @@ cvtl e = wrapL (cvt e) _ -> mkLHsPar x' ; cvtOpApp x'' s y } -- Note [Converting UInfix] - cvt (ParensE e) = do { e' <- cvtl e; return $ HsPar noExt e' } + cvt (ParensE e) = do { e' <- cvtl e; return $ HsPar noExtField e' } cvt (SigE e t) = do { e' <- cvtl e; t' <- cvtType t ; let pe = parenthesizeHsExpr sigPrec e' - ; return $ ExprWithTySig noExt pe (mkLHsSigWcType t') } + ; return $ ExprWithTySig noExtField pe (mkLHsSigWcType t') } cvt (RecConE c flds) = do { c' <- cNameL c ; flds' <- mapM (cvtFld (mkFieldOcc . noLoc)) flds ; return $ mkRdrRecordCon c' (HsRecFields flds' Nothing) } @@ -972,14 +972,14 @@ cvtl e = wrapL (cvt e) <- mapM (cvtFld (mkAmbiguousFieldOcc . noLoc)) flds ; return $ mkRdrRecordUpd e' flds' } - cvt (StaticE e) = fmap (HsStatic noExt) $ cvtl e + cvt (StaticE e) = fmap (HsStatic noExtField) $ cvtl e cvt (UnboundVarE s) = do -- Use of 'vcName' here instead of 'vName' is -- important, because UnboundVarE may contain -- constructor names - see #14627. { s' <- vcName s - ; return $ HsVar noExt (noLoc s') } - cvt (LabelE s) = do { return $ HsOverLabel noExt Nothing (fsLit s) } - cvt (ImplicitParamVarE n) = do { n' <- ipName n; return $ HsIPVar noExt n' } + ; return $ HsVar noExtField (noLoc s') } + cvt (LabelE s) = do { return $ HsOverLabel noExtField Nothing (fsLit s) } + cvt (ImplicitParamVarE n) = do { n' <- ipName n; return $ HsIPVar noExtField n' } {- | #16895 Ensure an infix expression's operator is a variable/constructor. Consider this example: @@ -1031,10 +1031,10 @@ cvtDD (FromThenToR x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z; retur cvt_tup :: [Maybe Exp] -> Boxity -> CvtM (HsExpr GhcPs) cvt_tup es boxity = do { let cvtl_maybe Nothing = return missingTupArg - cvtl_maybe (Just e) = fmap (Present noExt) (cvtl e) + cvtl_maybe (Just e) = fmap (Present noExtField) (cvtl e) ; es' <- mapM cvtl_maybe es ; return $ ExplicitTuple - noExt + noExtField (map noLoc es') boxity } @@ -1097,7 +1097,7 @@ cvtOpApp x op1 (UInfixE y op2 z) cvtOpApp x op y = do { op' <- cvtl op ; y' <- cvtl y - ; return (OpApp noExt x op' y') } + ; return (OpApp noExtField x op' y') } ------------------------------------- -- Do notation and statements @@ -1115,7 +1115,7 @@ cvtHsDo do_or_lc stmts -> return (cL loc (mkLastStmt body)) _ -> failWith (bad_last last') - ; return $ HsDo noExt do_or_lc (noLoc (stmts'' ++ [last''])) } + ; return $ HsDo noExtField do_or_lc (noLoc (stmts'' ++ [last''])) } where bad_last stmt = vcat [ text "Illegal last statement of" <+> pprAStmtContext do_or_lc <> colon , nest 2 $ Outputable.ppr stmt @@ -1128,12 +1128,12 @@ cvtStmt :: TH.Stmt -> CvtM (Hs.LStmt GhcPs (LHsExpr GhcPs)) cvtStmt (NoBindS e) = do { e' <- cvtl e; returnL $ mkBodyStmt e' } cvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnL $ mkBindStmt p' e' } cvtStmt (TH.LetS ds) = do { ds' <- cvtLocalDecs (text "a let binding") ds - ; returnL $ LetStmt noExt (noLoc ds') } + ; returnL $ LetStmt noExtField (noLoc ds') } cvtStmt (TH.ParS dss) = do { dss' <- mapM cvt_one dss - ; returnL $ ParStmt noExt dss' noExpr noSyntaxExpr } + ; returnL $ ParStmt noExtField dss' noExpr noSyntaxExpr } where cvt_one ds = do { ds' <- cvtStmts ds - ; return (ParStmtBlock noExt ds' undefined noSyntaxExpr) } + ; return (ParStmtBlock noExtField ds' undefined noSyntaxExpr) } cvtStmt (TH.RecS ss) = do { ss' <- mapM cvtStmt ss; returnL (mkRecStmt ss') } cvtMatch :: HsMatchContext RdrName @@ -1141,23 +1141,23 @@ 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 NoExt p') -- #14875 + (dL->L loc SigPat{}) -> cL loc (ParPat noExtField p') -- #14875 _ -> p' ; g' <- cvtGuard body ; decs' <- cvtLocalDecs (text "a where clause") decs - ; returnL $ Hs.Match noExt ctxt [lp] (GRHSs noExt g' (noLoc decs')) } + ; returnL $ Hs.Match noExtField ctxt [lp] (GRHSs noExtField g' (noLoc decs')) } cvtGuard :: TH.Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)] cvtGuard (GuardedB pairs) = mapM cvtpair pairs cvtGuard (NormalB e) = do { e' <- cvtl e - ; g' <- returnL $ GRHS noExt [] e'; return [g'] } + ; g' <- returnL $ GRHS noExtField [] e'; return [g'] } cvtpair :: (TH.Guard, TH.Exp) -> CvtM (LGRHS GhcPs (LHsExpr GhcPs)) cvtpair (NormalG ge,rhs) = do { ge' <- cvtl ge; rhs' <- cvtl rhs ; g' <- returnL $ mkBodyStmt ge' - ; returnL $ GRHS noExt [g'] rhs' } + ; returnL $ GRHS noExtField [g'] rhs' } cvtpair (PatG gs,rhs) = do { gs' <- cvtStmts gs; rhs' <- cvtl rhs - ; returnL $ GRHS noExt gs' rhs' } + ; returnL $ GRHS noExtField gs' rhs' } cvtOverLit :: Lit -> CvtM (HsOverLit GhcPs) cvtOverLit (IntegerL i) @@ -1198,9 +1198,9 @@ cvtLit :: Lit -> CvtM (HsLit GhcPs) cvtLit (IntPrimL i) = do { force i; return $ HsIntPrim NoSourceText i } cvtLit (WordPrimL w) = do { force w; return $ HsWordPrim NoSourceText w } cvtLit (FloatPrimL f) - = do { force f; return $ HsFloatPrim noExt (mkFractionalLit f) } + = do { force f; return $ HsFloatPrim noExtField (mkFractionalLit f) } cvtLit (DoublePrimL f) - = do { force f; return $ HsDoublePrim noExt (mkFractionalLit f) } + = do { force f; return $ HsDoublePrim noExtField (mkFractionalLit f) } cvtLit (CharL c) = do { force c; return $ HsChar NoSourceText c } cvtLit (CharPrimL c) = do { force c; return $ HsCharPrim NoSourceText c } cvtLit (StringL s) = do { let { s' = mkFastString s } @@ -1234,24 +1234,24 @@ cvtp (TH.LitP l) ; return (mkNPat (noLoc l') Nothing) } -- Not right for negative patterns; -- need to think about that! - | otherwise = do { l' <- cvtLit l; return $ Hs.LitPat noExt l' } + | otherwise = do { l' <- cvtLit l; return $ Hs.LitPat noExtField l' } cvtp (TH.VarP s) = do { s' <- vName s - ; return $ Hs.VarPat noExt (noLoc s') } -cvtp (TupP [p]) = do { p' <- cvtPat p; return $ ParPat noExt p' } + ; return $ Hs.VarPat noExtField (noLoc s') } +cvtp (TupP [p]) = do { p' <- cvtPat p; return $ ParPat noExtField p' } -- Note [Dropping constructors] cvtp (TupP ps) = do { ps' <- cvtPats ps - ; return $ TuplePat noExt ps' Boxed } + ; return $ TuplePat noExtField ps' Boxed } cvtp (UnboxedTupP ps) = do { ps' <- cvtPats ps - ; return $ TuplePat noExt ps' Unboxed } + ; return $ TuplePat noExtField ps' Unboxed } cvtp (UnboxedSumP p alt arity) = do { p' <- cvtPat p ; unboxedSumChecks alt arity - ; return $ SumPat noExt p' alt arity } + ; return $ SumPat noExtField p' alt arity } cvtp (ConP s ps) = do { s' <- cNameL s; ps' <- cvtPats ps ; let pps = map (parenthesizePat appPrec) ps' ; return $ ConPatIn s' (PrefixCon pps) } cvtp (InfixP p1 s p2) = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2 - ; wrapParL (ParPat noExt) $ + ; wrapParL (ParPat noExtField) $ ConPatIn s' $ InfixCon (parenthesizePat opPrec p1') (parenthesizePat opPrec p2') } @@ -1260,22 +1260,22 @@ cvtp (UInfixP p1 s p2) = do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } -- Note [Co cvtp (ParensP p) = do { p' <- cvtPat p; ; case unLoc p' of -- may be wrapped ConPatIn ParPat {} -> return $ unLoc p' - _ -> return $ ParPat noExt p' } -cvtp (TildeP p) = do { p' <- cvtPat p; return $ LazyPat noExt p' } -cvtp (BangP p) = do { p' <- cvtPat p; return $ BangPat noExt p' } + _ -> return $ ParPat noExtField p' } +cvtp (TildeP p) = do { p' <- cvtPat p; return $ LazyPat noExtField p' } +cvtp (BangP p) = do { p' <- cvtPat p; return $ BangPat noExtField p' } cvtp (TH.AsP s p) = do { s' <- vNameL s; p' <- cvtPat p - ; return $ AsPat noExt s' p' } -cvtp TH.WildP = return $ WildPat noExt + ; return $ AsPat noExtField s' p' } +cvtp TH.WildP = return $ WildPat noExtField cvtp (RecP c fs) = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs ; return $ ConPatIn c' $ Hs.RecCon (HsRecFields fs' Nothing) } cvtp (ListP ps) = do { ps' <- cvtPats ps ; return - $ ListPat noExt ps'} + $ ListPat noExtField ps'} cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t - ; return $ SigPat noExt p' (mkLHsSigWcType t') } + ; return $ SigPat noExtField p' (mkLHsSigWcType t') } cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p - ; return $ ViewPat noExt e' p'} + ; return $ ViewPat noExtField e' p'} cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField GhcPs (LPat GhcPs)) cvtPatFld (s,p) @@ -1309,11 +1309,11 @@ cvtTvs tvs = do { tvs' <- mapM cvt_tv tvs; return (mkHsQTvs tvs') } cvt_tv :: TH.TyVarBndr -> CvtM (LHsTyVarBndr GhcPs) cvt_tv (TH.PlainTV nm) = do { nm' <- tNameL nm - ; returnL $ UserTyVar noExt nm' } + ; returnL $ UserTyVar noExtField nm' } cvt_tv (TH.KindedTV nm ki) = do { nm' <- tNameL nm ; ki' <- cvtKind ki - ; returnL $ KindedTyVar noExt nm' ki' } + ; returnL $ KindedTyVar noExtField nm' ki' } cvtRole :: TH.Role -> Maybe Coercion.Role cvtRole TH.NominalR = Just Coercion.Nominal @@ -1333,7 +1333,7 @@ cvtDerivClause :: TH.DerivClause cvtDerivClause (TH.DerivClause ds ctxt) = do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext appPrec ctxt ; ds' <- traverse cvtDerivStrategy ds - ; returnL $ HsDerivingClause noExt ds' ctxt' } + ; returnL $ HsDerivingClause noExtField ds' ctxt' } cvtDerivStrategy :: TH.DerivStrategy -> CvtM (Hs.LDerivStrategy GhcPs) cvtDerivStrategy TH.StockStrategy = returnL Hs.StockStrategy @@ -1359,21 +1359,21 @@ cvtTypeKind ty_str ty , normals `lengthIs` n -- Saturated -> if n==1 then return (head normals) -- Singleton tuples treated -- like nothing (ie just parens) - else returnL (HsTupleTy noExt + else returnL (HsTupleTy noExtField HsBoxedOrConstraintTuple normals) | n == 1 -> failWith (ptext (sLit ("Illegal 1-tuple " ++ ty_str ++ " constructor"))) | otherwise -> mk_apps - (HsTyVar noExt NotPromoted (noLoc (getRdrName (tupleTyCon Boxed n)))) + (HsTyVar noExtField NotPromoted (noLoc (getRdrName (tupleTyCon Boxed n)))) tys' UnboxedTupleT n | Just normals <- m_normals , normals `lengthIs` n -- Saturated - -> returnL (HsTupleTy noExt HsUnboxedTuple normals) + -> returnL (HsTupleTy noExtField HsUnboxedTuple normals) | otherwise -> mk_apps - (HsTyVar noExt NotPromoted (noLoc (getRdrName (tupleTyCon Unboxed n)))) + (HsTyVar noExtField NotPromoted (noLoc (getRdrName (tupleTyCon Unboxed n)))) tys' UnboxedSumT n | n < 2 @@ -1383,37 +1383,37 @@ cvtTypeKind ty_str ty text "Sums must have an arity of at least 2" ] | Just normals <- m_normals , normals `lengthIs` n -- Saturated - -> returnL (HsSumTy noExt normals) + -> returnL (HsSumTy noExtField normals) | otherwise -> mk_apps - (HsTyVar noExt NotPromoted (noLoc (getRdrName (sumTyCon n)))) + (HsTyVar noExtField NotPromoted (noLoc (getRdrName (sumTyCon n)))) tys' ArrowT | Just normals <- m_normals , [x',y'] <- normals -> do x'' <- case unLoc x' of - HsFunTy{} -> returnL (HsParTy noExt x') - HsForAllTy{} -> returnL (HsParTy noExt x') -- #14646 - HsQualTy{} -> returnL (HsParTy noExt x') -- #15324 + HsFunTy{} -> returnL (HsParTy noExtField x') + HsForAllTy{} -> returnL (HsParTy noExtField x') -- #14646 + HsQualTy{} -> returnL (HsParTy noExtField x') -- #15324 _ -> return $ parenthesizeHsType sigPrec x' let y'' = parenthesizeHsType sigPrec y' - returnL (HsFunTy noExt x'' y'') + returnL (HsFunTy noExtField x'' y'') | otherwise -> mk_apps - (HsTyVar noExt NotPromoted (noLoc (getRdrName funTyCon))) + (HsTyVar noExtField NotPromoted (noLoc (getRdrName funTyCon))) tys' ListT | Just normals <- m_normals , [x'] <- normals -> do - returnL (HsListTy noExt x') + returnL (HsListTy noExtField x') | otherwise -> mk_apps - (HsTyVar noExt NotPromoted (noLoc (getRdrName listTyCon))) + (HsTyVar noExtField NotPromoted (noLoc (getRdrName listTyCon))) tys' VarT nm -> do { nm' <- tNameL nm - ; mk_apps (HsTyVar noExt NotPromoted nm') tys' } + ; mk_apps (HsTyVar noExtField NotPromoted nm') tys' } ConT nm -> do { nm' <- tconName nm ; -- ConT can contain both data constructor (i.e., -- promoted) names and other (i.e, unpromoted) @@ -1422,7 +1422,7 @@ cvtTypeKind ty_str ty let prom = if isRdrDataCon nm' then IsPromoted else NotPromoted - ; mk_apps (HsTyVar noExt prom (noLoc nm')) tys'} + ; mk_apps (HsTyVar noExtField prom (noLoc nm')) tys'} ForallT tvs cxt ty | null tys' @@ -1445,11 +1445,11 @@ cvtTypeKind ty_str ty SigT ty ki -> do { ty' <- cvtType ty ; ki' <- cvtKind ki - ; mk_apps (HsKindSig noExt ty' ki') tys' + ; mk_apps (HsKindSig noExtField ty' ki') tys' } LitT lit - -> mk_apps (HsTyLit noExt (cvtTyLit lit)) tys' + -> mk_apps (HsTyLit noExtField (cvtTyLit lit)) tys' WildCardT -> mk_apps mkAnonWildCardTy tys' @@ -1459,7 +1459,7 @@ cvtTypeKind ty_str ty ; t1' <- cvtType t1 ; t2' <- cvtType t2 ; mk_apps - (HsTyVar noExt NotPromoted (noLoc s')) + (HsTyVar noExtField NotPromoted (noLoc s')) ([HsValArg t1', HsValArg t2'] ++ tys') } @@ -1471,11 +1471,11 @@ cvtTypeKind ty_str ty ParensT t -> do { t' <- cvtType t - ; mk_apps (HsParTy noExt t') tys' + ; mk_apps (HsParTy noExtField t') tys' } PromotedT nm -> do { nm' <- cName nm - ; mk_apps (HsTyVar noExt IsPromoted (noLoc nm')) + ; mk_apps (HsTyVar noExtField IsPromoted (noLoc nm')) tys' } -- Promoted data constructor; hence cName @@ -1484,34 +1484,34 @@ cvtTypeKind ty_str ty -> failWith (ptext (sLit ("Illegal promoted 1-tuple " ++ ty_str))) | Just normals <- m_normals , normals `lengthIs` n -- Saturated - -> returnL (HsExplicitTupleTy noExt normals) + -> returnL (HsExplicitTupleTy noExtField normals) | otherwise -> mk_apps - (HsTyVar noExt IsPromoted (noLoc (getRdrName (tupleDataCon Boxed n)))) + (HsTyVar noExtField IsPromoted (noLoc (getRdrName (tupleDataCon Boxed n)))) tys' PromotedNilT - -> mk_apps (HsExplicitListTy noExt IsPromoted []) tys' + -> mk_apps (HsExplicitListTy noExtField IsPromoted []) tys' PromotedConsT -- See Note [Representing concrete syntax in types] -- in Language.Haskell.TH.Syntax | Just normals <- m_normals , [ty1, dL->L _ (HsExplicitListTy _ ip tys2)] <- normals -> do - returnL (HsExplicitListTy noExt ip (ty1:tys2)) + returnL (HsExplicitListTy noExtField ip (ty1:tys2)) | otherwise -> mk_apps - (HsTyVar noExt IsPromoted (noLoc (getRdrName consDataCon))) + (HsTyVar noExtField IsPromoted (noLoc (getRdrName consDataCon))) tys' StarT -> mk_apps - (HsTyVar noExt NotPromoted (noLoc (getRdrName liftedTypeKindTyCon))) + (HsTyVar noExtField NotPromoted (noLoc (getRdrName liftedTypeKindTyCon))) tys' ConstraintT -> mk_apps - (HsTyVar noExt NotPromoted (noLoc (getRdrName constraintKindTyCon))) + (HsTyVar noExtField NotPromoted (noLoc (getRdrName constraintKindTyCon))) tys' EqualityT @@ -1519,18 +1519,18 @@ cvtTypeKind ty_str ty , [x',y'] <- normals -> let px = parenthesizeHsType opPrec x' py = parenthesizeHsType opPrec y' - in returnL (HsOpTy noExt px (noLoc eqTyCon_RDR) py) + in returnL (HsOpTy noExtField px (noLoc eqTyCon_RDR) py) -- The long-term goal is to remove the above case entirely and -- subsume it under the case for InfixT. See #15815, comment:6, -- for more details. | otherwise -> - mk_apps (HsTyVar noExt NotPromoted + mk_apps (HsTyVar noExtField NotPromoted (noLoc eqTyCon_RDR)) tys' ImplicitParamT n t -> do { n' <- wrapL $ ipName n ; t' <- cvtType t - ; returnL (HsIParamTy noExt n' t') + ; returnL (HsIParamTy noExtField n' t') } _ -> failWith (ptext (sLit ("Malformed " ++ ty_str)) <+> text (show ty)) @@ -1551,16 +1551,16 @@ mk_apps head_ty type_args = do go (arg:args) = case arg of HsValArg ty -> do p_ty <- add_parens ty - mk_apps (HsAppTy noExt phead_ty p_ty) args + mk_apps (HsAppTy noExtField phead_ty p_ty) args HsTypeArg l ki -> do p_ki <- add_parens ki mk_apps (HsAppKindTy l phead_ty p_ki) args - HsArgPar _ -> mk_apps (HsParTy noExt phead_ty) args + HsArgPar _ -> mk_apps (HsParTy noExtField phead_ty) args go type_args where -- See Note [Adding parens for splices] add_parens lt@(dL->L _ t) - | hsTypeNeedsParens appPrec t = returnL (HsParTy noExt lt) + | hsTypeNeedsParens appPrec t = returnL (HsParTy noExtField lt) | otherwise = return lt wrap_tyarg :: LHsTypeArg GhcPs -> LHsTypeArg GhcPs @@ -1596,7 +1596,7 @@ mk_arr_apps :: [LHsType GhcPs] -> HsType GhcPs -> CvtM (LHsType GhcPs) mk_arr_apps tys return_ty = foldrM go return_ty tys >>= returnL where go :: LHsType GhcPs -> HsType GhcPs -> CvtM (HsType GhcPs) go arg ret_ty = do { ret_ty_l <- returnL ret_ty - ; return (HsFunTy noExt arg ret_ty_l) } + ; return (HsFunTy noExtField arg ret_ty_l) } split_ty_app :: TH.Type -> CvtM (TH.Type, [LHsTypeArg GhcPs]) split_ty_app ty = go ty [] @@ -1634,18 +1634,18 @@ cvtKind = cvtTypeKind "kind" -- signature is possible). cvtMaybeKindToFamilyResultSig :: Maybe TH.Kind -> CvtM (LFamilyResultSig GhcPs) -cvtMaybeKindToFamilyResultSig Nothing = returnL (Hs.NoSig noExt) +cvtMaybeKindToFamilyResultSig Nothing = returnL (Hs.NoSig noExtField) cvtMaybeKindToFamilyResultSig (Just ki) = do { ki' <- cvtKind ki - ; returnL (Hs.KindSig noExt ki') } + ; returnL (Hs.KindSig noExtField ki') } -- | Convert type family result signature. Used with both open and closed type -- families. cvtFamilyResultSig :: TH.FamilyResultSig -> CvtM (Hs.LFamilyResultSig GhcPs) -cvtFamilyResultSig TH.NoSig = returnL (Hs.NoSig noExt) +cvtFamilyResultSig TH.NoSig = returnL (Hs.NoSig noExtField) cvtFamilyResultSig (TH.KindSig ki) = do { ki' <- cvtKind ki - ; returnL (Hs.KindSig noExt ki') } + ; returnL (Hs.KindSig noExtField ki') } cvtFamilyResultSig (TH.TyVarSig bndr) = do { tv <- cvt_tv bndr - ; returnL (Hs.TyVarSig noExt tv) } + ; returnL (Hs.TyVarSig noExtField tv) } -- | Convert injectivity annotation of a type family. cvtInjectivityAnnotation :: TH.InjectivityAnn @@ -1664,7 +1664,7 @@ cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty)) | null univs, null reqs = do { l <- getL ; ty' <- cvtType (ForallT exis provs ty) ; return $ cL l (HsQualTy { hst_ctxt = cL l [] - , hst_xqual = noExt + , hst_xqual = noExtField , hst_body = ty' }) } | null reqs = do { l <- getL ; univs' <- hsQTvExplicit <$> cvtTvs univs @@ -1672,10 +1672,10 @@ cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty)) ; let forTy = HsForAllTy { hst_fvf = ForallInvis , hst_bndrs = univs' - , hst_xforall = noExt + , hst_xforall = noExtField , hst_body = cL l cxtTy } cxtTy = HsQualTy { hst_ctxt = cL l [] - , hst_xqual = noExt + , hst_xqual = noExtField , hst_body = ty' } ; return $ cL l forTy } | otherwise = cvtType (ForallT univs reqs (ForallT exis provs ty)) @@ -1738,7 +1738,7 @@ mkHsForAllTy tvs loc fvf tvs' rho_ty | null tvs = rho_ty | otherwise = cL loc $ HsForAllTy { hst_fvf = fvf , hst_bndrs = hsQTvExplicit tvs' - , hst_xforall = noExt + , hst_xforall = noExtField , hst_body = rho_ty } -- | If passed an empty 'TH.Cxt', this simply returns the third argument @@ -1761,7 +1761,7 @@ 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 = noExt + | otherwise = cL loc $ HsQualTy { hst_xqual = noExtField , hst_ctxt = ctxt' , hst_body = ty } diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs index 1763c3f2de..c5fadc0b4a 100644 --- a/compiler/hsSyn/HsBinds.hs +++ b/compiler/hsSyn/HsBinds.hs @@ -94,10 +94,10 @@ data HsLocalBindsLR idL idR | XHsLocalBindsLR (XXHsLocalBindsLR idL idR) -type instance XHsValBinds (GhcPass pL) (GhcPass pR) = NoExt -type instance XHsIPBinds (GhcPass pL) (GhcPass pR) = NoExt -type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExt -type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExt +type instance XHsValBinds (GhcPass pL) (GhcPass pR) = NoExtField +type instance XHsIPBinds (GhcPass pL) (GhcPass pR) = NoExtField +type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExtField +type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon type LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR) @@ -135,7 +135,7 @@ data NHsValBindsLR idL [(RecFlag, LHsBinds idL)] [LSig GhcRn] -type instance XValBinds (GhcPass pL) (GhcPass pR) = NoExt +type instance XValBinds (GhcPass pL) (GhcPass pR) = NoExtField type instance XXValBindsLR (GhcPass pL) (GhcPass pR) = NHsValBindsLR (GhcPass pL) @@ -319,18 +319,18 @@ data NPatBindTc = NPatBindTc { pat_rhs_ty :: Type -- ^ Type of the GRHSs } deriving Data -type instance XFunBind (GhcPass pL) GhcPs = NoExt +type instance XFunBind (GhcPass pL) GhcPs = NoExtField type instance XFunBind (GhcPass pL) GhcRn = NameSet -- Free variables type instance XFunBind (GhcPass pL) GhcTc = NameSet -- Free variables -type instance XPatBind GhcPs (GhcPass pR) = NoExt +type instance XPatBind GhcPs (GhcPass pR) = NoExtField type instance XPatBind GhcRn (GhcPass pR) = NameSet -- Free variables type instance XPatBind GhcTc (GhcPass pR) = NPatBindTc -type instance XVarBind (GhcPass pL) (GhcPass pR) = NoExt -type instance XAbsBinds (GhcPass pL) (GhcPass pR) = NoExt -type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExt -type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExt +type instance XVarBind (GhcPass pL) (GhcPass pR) = NoExtField +type instance XAbsBinds (GhcPass pL) (GhcPass pR) = NoExtField +type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExtField +type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds] @@ -356,8 +356,8 @@ data ABExport p } | XABExport (XXABExport p) -type instance XABE (GhcPass p) = NoExt -type instance XXABExport (GhcPass p) = NoExt +type instance XABE (GhcPass p) = NoExtField +type instance XXABExport (GhcPass p) = NoExtCon -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern', @@ -379,11 +379,11 @@ data PatSynBind idL idR } | XPatSynBind (XXPatSynBind idL idR) -type instance XPSB (GhcPass idL) GhcPs = NoExt +type instance XPSB (GhcPass idL) GhcPs = NoExtField type instance XPSB (GhcPass idL) GhcRn = NameSet type instance XPSB (GhcPass idL) GhcTc = NameSet -type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExt +type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExtCon {- Note [AbsBinds] @@ -682,7 +682,7 @@ pprDeclList ds = pprDeeperList vcat ds ------------ emptyLocalBinds :: HsLocalBindsLR (GhcPass a) (GhcPass b) -emptyLocalBinds = EmptyLocalBinds noExt +emptyLocalBinds = EmptyLocalBinds noExtField -- AZ:These functions do not seem to be used at all? isEmptyLocalBindsTc :: HsLocalBindsLR (GhcPass a) GhcTc -> Bool @@ -706,7 +706,7 @@ isEmptyValBinds (ValBinds _ ds sigs) = isEmptyLHsBinds ds && null sigs isEmptyValBinds (XValBindsLR (NValBinds ds sigs)) = null ds && null sigs emptyValBindsIn, emptyValBindsOut :: HsValBindsLR (GhcPass a) (GhcPass b) -emptyValBindsIn = ValBinds noExt emptyBag [] +emptyValBindsIn = ValBinds noExtField emptyBag [] emptyValBindsOut = XValBindsLR (NValBinds [] []) emptyLHsBinds :: LHsBindsLR idL idR @@ -719,7 +719,7 @@ isEmptyLHsBinds = isEmptyBag plusHsValBinds :: HsValBinds (GhcPass a) -> HsValBinds (GhcPass a) -> HsValBinds(GhcPass a) plusHsValBinds (ValBinds _ ds1 sigs1) (ValBinds _ ds2 sigs2) - = ValBinds noExt (ds1 `unionBags` ds2) (sigs1 ++ sigs2) + = ValBinds noExtField (ds1 `unionBags` ds2) (sigs1 ++ sigs2) plusHsValBinds (XValBindsLR (NValBinds ds1 sigs1)) (XValBindsLR (NValBinds ds2 sigs2)) = XValBindsLR (NValBinds (ds1 ++ ds2) (sigs1 ++ sigs2)) @@ -824,13 +824,13 @@ data HsIPBinds id -- -- uses of the implicit parameters | XHsIPBinds (XXHsIPBinds id) -type instance XIPBinds GhcPs = NoExt -type instance XIPBinds GhcRn = NoExt +type instance XIPBinds GhcPs = NoExtField +type instance XIPBinds GhcRn = NoExtField type instance XIPBinds GhcTc = TcEvBinds -- binds uses of the -- implicit parameters -type instance XXHsIPBinds (GhcPass p) = NoExt +type instance XXHsIPBinds (GhcPass p) = NoExtCon isEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool isEmptyIPBindsPR (IPBinds _ is) = null is @@ -864,8 +864,8 @@ data IPBind id (LHsExpr id) | XIPBind (XXIPBind id) -type instance XCIPBind (GhcPass p) = NoExt -type instance XXIPBind (GhcPass p) = NoExt +type instance XCIPBind (GhcPass p) = NoExtField +type instance XXIPBind (GhcPass p) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsIPBinds p) where @@ -1047,18 +1047,18 @@ data Sig pass (Maybe (Located (IdP pass))) | XSig (XXSig pass) -type instance XTypeSig (GhcPass p) = NoExt -type instance XPatSynSig (GhcPass p) = NoExt -type instance XClassOpSig (GhcPass p) = NoExt -type instance XIdSig (GhcPass p) = NoExt -type instance XFixSig (GhcPass p) = NoExt -type instance XInlineSig (GhcPass p) = NoExt -type instance XSpecSig (GhcPass p) = NoExt -type instance XSpecInstSig (GhcPass p) = NoExt -type instance XMinimalSig (GhcPass p) = NoExt -type instance XSCCFunSig (GhcPass p) = NoExt -type instance XCompleteMatchSig (GhcPass p) = NoExt -type instance XXSig (GhcPass p) = NoExt +type instance XTypeSig (GhcPass p) = NoExtField +type instance XPatSynSig (GhcPass p) = NoExtField +type instance XClassOpSig (GhcPass p) = NoExtField +type instance XIdSig (GhcPass p) = NoExtField +type instance XFixSig (GhcPass p) = NoExtField +type instance XInlineSig (GhcPass p) = NoExtField +type instance XSpecSig (GhcPass p) = NoExtField +type instance XSpecInstSig (GhcPass p) = NoExtField +type instance XMinimalSig (GhcPass p) = NoExtField +type instance XSCCFunSig (GhcPass p) = NoExtField +type instance XCompleteMatchSig (GhcPass p) = NoExtField +type instance XXSig (GhcPass p) = NoExtCon -- | Located Fixity Signature type LFixitySig pass = Located (FixitySig pass) @@ -1067,8 +1067,8 @@ type LFixitySig pass = Located (FixitySig pass) data FixitySig pass = FixitySig (XFixitySig pass) [Located (IdP pass)] Fixity | XFixitySig (XXFixitySig pass) -type instance XFixitySig (GhcPass p) = NoExt -type instance XXFixitySig (GhcPass p) = NoExt +type instance XFixitySig (GhcPass p) = NoExtField +type instance XXFixitySig (GhcPass p) = NoExtCon -- | Type checker Specialisation Pragmas -- diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 7adfb01b2d..5a6d927ab9 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -146,20 +146,20 @@ data HsDecl p | RoleAnnotD (XRoleAnnotD p) (RoleAnnotDecl p) -- ^Role annotation declaration | XHsDecl (XXHsDecl p) -type instance XTyClD (GhcPass _) = NoExt -type instance XInstD (GhcPass _) = NoExt -type instance XDerivD (GhcPass _) = NoExt -type instance XValD (GhcPass _) = NoExt -type instance XSigD (GhcPass _) = NoExt -type instance XDefD (GhcPass _) = NoExt -type instance XForD (GhcPass _) = NoExt -type instance XWarningD (GhcPass _) = NoExt -type instance XAnnD (GhcPass _) = NoExt -type instance XRuleD (GhcPass _) = NoExt -type instance XSpliceD (GhcPass _) = NoExt -type instance XDocD (GhcPass _) = NoExt -type instance XRoleAnnotD (GhcPass _) = NoExt -type instance XXHsDecl (GhcPass _) = NoExt +type instance XTyClD (GhcPass _) = NoExtField +type instance XInstD (GhcPass _) = NoExtField +type instance XDerivD (GhcPass _) = NoExtField +type instance XValD (GhcPass _) = NoExtField +type instance XSigD (GhcPass _) = NoExtField +type instance XDefD (GhcPass _) = NoExtField +type instance XForD (GhcPass _) = NoExtField +type instance XWarningD (GhcPass _) = NoExtField +type instance XAnnD (GhcPass _) = NoExtField +type instance XRuleD (GhcPass _) = NoExtField +type instance XSpliceD (GhcPass _) = NoExtField +type instance XDocD (GhcPass _) = NoExtField +type instance XRoleAnnotD (GhcPass _) = NoExtField +type instance XXHsDecl (GhcPass _) = NoExtCon -- NB: all top-level fixity decls are contained EITHER -- EITHER SigDs @@ -206,8 +206,8 @@ data HsGroup p } | XHsGroup (XXHsGroup p) -type instance XCHsGroup (GhcPass _) = NoExt -type instance XXHsGroup (GhcPass _) = NoExt +type instance XCHsGroup (GhcPass _) = NoExtField +type instance XXHsGroup (GhcPass _) = NoExtCon emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p) @@ -217,7 +217,7 @@ emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut } hsGroupInstDecls :: HsGroup id -> [LInstDecl id] hsGroupInstDecls = (=<<) group_instds . hs_tyclds -emptyGroup = HsGroup { hs_ext = noExt, +emptyGroup = HsGroup { hs_ext = noExtField, hs_tyclds = [], hs_derivds = [], hs_fixds = [], hs_defds = [], hs_annds = [], @@ -255,7 +255,7 @@ appendGroups hs_docs = docs2 } = HsGroup { - hs_ext = noExt, + hs_ext = noExtField, hs_valds = val_groups1 `plusHsValBinds` val_groups2, hs_splcds = spliceds1 ++ spliceds2, hs_tyclds = tyclds1 ++ tyclds2, @@ -330,8 +330,8 @@ data SpliceDecl p SpliceExplicitFlag | XSpliceDecl (XXSpliceDecl p) -type instance XSpliceDecl (GhcPass _) = NoExt -type instance XXSpliceDecl (GhcPass _) = NoExt +type instance XSpliceDecl (GhcPass _) = NoExtField +type instance XXSpliceDecl (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (SpliceDecl p) where @@ -576,21 +576,21 @@ c.f. Note [Associated type tyvar names] in Class.hs Note [Family instance declaration binders] -} -type instance XFamDecl (GhcPass _) = NoExt +type instance XFamDecl (GhcPass _) = NoExtField -type instance XSynDecl GhcPs = NoExt +type instance XSynDecl GhcPs = NoExtField type instance XSynDecl GhcRn = NameSet -- FVs type instance XSynDecl GhcTc = NameSet -- FVs -type instance XDataDecl GhcPs = NoExt +type instance XDataDecl GhcPs = NoExtField type instance XDataDecl GhcRn = DataDeclRn type instance XDataDecl GhcTc = DataDeclRn -type instance XClassDecl GhcPs = NoExt +type instance XClassDecl GhcPs = NoExtField type instance XClassDecl GhcRn = NameSet -- FVs type instance XClassDecl GhcTc = NameSet -- FVs -type instance XXTyClDecl (GhcPass _) = NoExt +type instance XXTyClDecl (GhcPass _) = NoExtCon -- Simple classifiers for TyClDecl -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -641,17 +641,17 @@ isDataFamilyDecl _other = False -- Dealing with names -tyFamInstDeclName :: TyFamInstDecl pass -> (IdP pass) +tyFamInstDeclName :: TyFamInstDecl (GhcPass p) -> IdP (GhcPass p) tyFamInstDeclName = unLoc . tyFamInstDeclLName -tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass) +tyFamInstDeclLName :: TyFamInstDecl (GhcPass p) -> Located (IdP (GhcPass p)) tyFamInstDeclLName (TyFamInstDecl { tfid_eqn = (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) }) = ln -tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn _))) - = panic "tyFamInstDeclLName" -tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs _)) - = panic "tyFamInstDeclLName" +tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn nec))) + = noExtCon nec +tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs nec)) + = noExtCon nec tyClDeclLName :: TyClDecl pass -> Located (IdP pass) tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln @@ -699,7 +699,7 @@ hsDeclHasCusk _cusks_enabled@True (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) _ -> False hsDeclHasCusk _cusks_enabled@True (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk hsDeclHasCusk _cusks_enabled@True (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars -hsDeclHasCusk _ (XTyClDecl _) = panic "hsDeclHasCusk" +hsDeclHasCusk _ (XTyClDecl nec) = noExtCon nec -- Pretty-printing TyClDecl -- ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -912,12 +912,12 @@ data TyClGroup pass -- See Note [TyClGroups and dependency analysis] , group_instds :: [LInstDecl pass] } | XTyClGroup (XXTyClGroup pass) -type instance XCTyClGroup (GhcPass _) = NoExt -type instance XXTyClGroup (GhcPass _) = NoExt +type instance XCTyClGroup (GhcPass _) = NoExtField +type instance XXTyClGroup (GhcPass _) = NoExtCon emptyTyClGroup :: TyClGroup (GhcPass p) -emptyTyClGroup = TyClGroup noExt [] [] [] +emptyTyClGroup = TyClGroup noExtField [] [] [] tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass] tyClGroupTyClDecls = concatMap group_tyclds @@ -931,7 +931,7 @@ tyClGroupRoleDecls = concatMap group_roles mkTyClGroup :: [LTyClDecl (GhcPass p)] -> [LInstDecl (GhcPass p)] -> TyClGroup (GhcPass p) mkTyClGroup decls instds = TyClGroup - { group_ext = noExt + { group_ext = noExtField , group_tyclds = decls , group_roles = [] , group_instds = instds @@ -1033,10 +1033,10 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig] -- For details on above see note [Api annotations] in ApiAnnotation -type instance XNoSig (GhcPass _) = NoExt -type instance XCKindSig (GhcPass _) = NoExt -type instance XTyVarSig (GhcPass _) = NoExt -type instance XXFamilyResultSig (GhcPass _) = NoExt +type instance XNoSig (GhcPass _) = NoExtField +type instance XCKindSig (GhcPass _) = NoExtField +type instance XTyVarSig (GhcPass _) = NoExtField +type instance XXFamilyResultSig (GhcPass _) = NoExtCon -- | Located type Family Declaration @@ -1063,8 +1063,8 @@ data FamilyDecl pass = FamilyDecl -- For details on above see note [Api annotations] in ApiAnnotation -type instance XCFamilyDecl (GhcPass _) = NoExt -type instance XXFamilyDecl (GhcPass _) = NoExt +type instance XCFamilyDecl (GhcPass _) = NoExtField +type instance XXFamilyDecl (GhcPass _) = NoExtCon -- | Located Injectivity Annotation @@ -1097,7 +1097,7 @@ data FamilyInfo pass famDeclHasCusk :: Bool -- ^ True <=> the -XCUSKs extension is enabled -> Bool -- ^ True <=> this is an associated type family, -- and the parent class has /no/ CUSK - -> FamilyDecl pass + -> FamilyDecl (GhcPass pass) -> Bool famDeclHasCusk _cusks_enabled@False _ _ = False famDeclHasCusk _cusks_enabled@True assoc_with_no_cusk @@ -1111,7 +1111,7 @@ famDeclHasCusk _cusks_enabled@True assoc_with_no_cusk -- Un-associated open type/data families have CUSKs -- Associated type families have CUSKs iff the parent class does -famDeclHasCusk _ _ (XFamilyDecl {}) = panic "famDeclHasCusk" +famDeclHasCusk _ _ (XFamilyDecl nec) = noExtCon nec -- | Does this family declaration have user-supplied return kind signature? hasReturnKindSignature :: FamilyResultSig a -> Bool @@ -1120,7 +1120,7 @@ hasReturnKindSignature (TyVarSig _ (L _ (UserTyVar{}))) = False hasReturnKindSignature _ = True -- | Maybe return name of the result type variable -resultVariableName :: FamilyResultSig a -> Maybe (IdP a) +resultVariableName :: FamilyResultSig (GhcPass a) -> Maybe (IdP (GhcPass a)) resultVariableName (TyVarSig _ sig) = Just $ hsLTyVarName sig resultVariableName _ = Nothing @@ -1213,8 +1213,8 @@ data HsDataDefn pass -- The payload of a data type defn } | XHsDataDefn (XXHsDataDefn pass) -type instance XCHsDataDefn (GhcPass _) = NoExt -type instance XXHsDataDefn (GhcPass _) = NoExt +type instance XCHsDataDefn (GhcPass _) = NoExtField +type instance XXHsDataDefn (GhcPass _) = NoExtCon -- | Haskell Deriving clause type HsDeriving pass = Located [LHsDerivingClause pass] @@ -1253,8 +1253,8 @@ data HsDerivingClause pass } | XHsDerivingClause (XXHsDerivingClause pass) -type instance XCHsDerivingClause (GhcPass _) = NoExt -type instance XXHsDerivingClause (GhcPass _) = NoExt +type instance XCHsDerivingClause (GhcPass _) = NoExtField +type instance XXHsDerivingClause (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsDerivingClause p) where @@ -1363,9 +1363,9 @@ data ConDecl pass } | XConDecl (XXConDecl pass) -type instance XConDeclGADT (GhcPass _) = NoExt -type instance XConDeclH98 (GhcPass _) = NoExt -type instance XXConDecl (GhcPass _) = NoExt +type instance XConDeclGADT (GhcPass _) = NoExtField +type instance XConDeclH98 (GhcPass _) = NoExtField +type instance XXConDecl (GhcPass _) = NoExtCon {- Note [GADT abstract syntax] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1408,10 +1408,10 @@ There's a wrinkle in ConDeclGADT type HsConDeclDetails pass = HsConDetails (LBangType pass) (Located [LConDeclField pass]) -getConNames :: ConDecl pass -> [Located (IdP pass)] +getConNames :: ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))] getConNames ConDeclH98 {con_name = name} = [name] getConNames ConDeclGADT {con_names = names} = names -getConNames XConDecl {} = panic "getConNames" +getConNames (XConDecl nec) = noExtCon nec getConArgs :: ConDecl pass -> HsConDeclDetails pass getConArgs d = con_args d @@ -1648,8 +1648,8 @@ data FamEqn pass rhs -- For details on above see note [Api annotations] in ApiAnnotation -type instance XCFamEqn (GhcPass _) r = NoExt -type instance XXFamEqn (GhcPass _) r = NoExt +type instance XCFamEqn (GhcPass _) r = NoExtField +type instance XXFamEqn (GhcPass _) r = NoExtCon ----------------- Class instances ------------- @@ -1681,8 +1681,8 @@ data ClsInstDecl pass -- For details on above see note [Api annotations] in ApiAnnotation | XClsInstDecl (XXClsInstDecl pass) -type instance XCClsInstDecl (GhcPass _) = NoExt -type instance XXClsInstDecl (GhcPass _) = NoExt +type instance XCClsInstDecl (GhcPass _) = NoExtField +type instance XXClsInstDecl (GhcPass _) = NoExtCon ----------------- Instances of all kinds ------------- @@ -1702,10 +1702,10 @@ data InstDecl pass -- Both class and family instances , tfid_inst :: TyFamInstDecl pass } | XInstDecl (XXInstDecl pass) -type instance XClsInstD (GhcPass _) = NoExt -type instance XDataFamInstD (GhcPass _) = NoExt -type instance XTyFamInstD (GhcPass _) = NoExt -type instance XXInstDecl (GhcPass _) = NoExt +type instance XClsInstD (GhcPass _) = NoExtField +type instance XDataFamInstD (GhcPass _) = NoExtField +type instance XTyFamInstD (GhcPass _) = NoExtField +type instance XXInstDecl (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (TyFamInstDecl p) where @@ -1841,7 +1841,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (InstDecl p) where -- Extract the declarations of associated data types from an instance -instDeclDataFamInsts :: [LInstDecl pass] -> [DataFamInstDecl pass] +instDeclDataFamInsts :: [LInstDecl (GhcPass p)] -> [DataFamInstDecl (GhcPass p)] instDeclDataFamInsts inst_decls = concatMap do_one inst_decls where @@ -1849,8 +1849,8 @@ instDeclDataFamInsts inst_decls = map unLoc fam_insts do_one (L _ (DataFamInstD { dfid_inst = fam_inst })) = [fam_inst] do_one (L _ (TyFamInstD {})) = [] - do_one (L _ (ClsInstD _ (XClsInstDecl _))) = panic "instDeclDataFamInsts" - do_one (L _ (XInstDecl _)) = panic "instDeclDataFamInsts" + do_one (L _ (ClsInstD _ (XClsInstDecl nec))) = noExtCon nec + do_one (L _ (XInstDecl nec)) = noExtCon nec {- ************************************************************************ @@ -1889,8 +1889,8 @@ data DerivDecl pass = DerivDecl } | XDerivDecl (XXDerivDecl pass) -type instance XCDerivDecl (GhcPass _) = NoExt -type instance XXDerivDecl (GhcPass _) = NoExt +type instance XCDerivDecl (GhcPass _) = NoExtField +type instance XXDerivDecl (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (DerivDecl p) where @@ -1972,8 +1972,8 @@ data DefaultDecl pass -- For details on above see note [Api annotations] in ApiAnnotation | XDefaultDecl (XXDefaultDecl pass) -type instance XCDefaultDecl (GhcPass _) = NoExt -type instance XXDefaultDecl (GhcPass _) = NoExt +type instance XCDefaultDecl (GhcPass _) = NoExtField +type instance XXDefaultDecl (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (DefaultDecl p) where @@ -2028,15 +2028,15 @@ data ForeignDecl pass such as Int and IO that we know how to make foreign calls with. -} -type instance XForeignImport GhcPs = NoExt -type instance XForeignImport GhcRn = NoExt +type instance XForeignImport GhcPs = NoExtField +type instance XForeignImport GhcRn = NoExtField type instance XForeignImport GhcTc = Coercion -type instance XForeignExport GhcPs = NoExt -type instance XForeignExport GhcRn = NoExt +type instance XForeignExport GhcPs = NoExtField +type instance XForeignExport GhcRn = NoExtField type instance XForeignExport GhcTc = Coercion -type instance XXForeignDecl (GhcPass _) = NoExt +type instance XXForeignDecl (GhcPass _) = NoExtCon -- Specification Of an imported external entity in dependence on the calling -- convention @@ -2143,8 +2143,8 @@ data RuleDecls pass = HsRules { rds_ext :: XCRuleDecls pass , rds_rules :: [LRuleDecl pass] } | XRuleDecls (XXRuleDecls pass) -type instance XCRuleDecls (GhcPass _) = NoExt -type instance XXRuleDecls (GhcPass _) = NoExt +type instance XCRuleDecls (GhcPass _) = NoExtField +type instance XXRuleDecls (GhcPass _) = NoExtCon -- | Located Rule Declaration type LRuleDecl pass = Located (RuleDecl pass) @@ -2177,11 +2177,11 @@ data RuleDecl pass data HsRuleRn = HsRuleRn NameSet NameSet -- Free-vars from the LHS and RHS deriving Data -type instance XHsRule GhcPs = NoExt +type instance XHsRule GhcPs = NoExtField type instance XHsRule GhcRn = HsRuleRn type instance XHsRule GhcTc = HsRuleRn -type instance XXRuleDecl (GhcPass _) = NoExt +type instance XXRuleDecl (GhcPass _) = NoExtCon flattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass] flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls @@ -2200,9 +2200,9 @@ data RuleBndr pass -- For details on above see note [Api annotations] in ApiAnnotation -type instance XCRuleBndr (GhcPass _) = NoExt -type instance XRuleBndrSig (GhcPass _) = NoExt -type instance XXRuleBndr (GhcPass _) = NoExt +type instance XCRuleBndr (GhcPass _) = NoExtField +type instance XRuleBndrSig (GhcPass _) = NoExtField +type instance XXRuleBndr (GhcPass _) = NoExtCon collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass] collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs] @@ -2290,8 +2290,8 @@ data WarnDecls pass = Warnings { wd_ext :: XWarnings pass } | XWarnDecls (XXWarnDecls pass) -type instance XWarnings (GhcPass _) = NoExt -type instance XXWarnDecls (GhcPass _) = NoExt +type instance XWarnings (GhcPass _) = NoExtField +type instance XXWarnDecls (GhcPass _) = NoExtCon -- | Located Warning pragma Declaration type LWarnDecl pass = Located (WarnDecl pass) @@ -2300,8 +2300,8 @@ type LWarnDecl pass = Located (WarnDecl pass) data WarnDecl pass = Warning (XWarning pass) [Located (IdP pass)] WarningTxt | XWarnDecl (XXWarnDecl pass) -type instance XWarning (GhcPass _) = NoExt -type instance XXWarnDecl (GhcPass _) = NoExt +type instance XWarning (GhcPass _) = NoExtField +type instance XXWarnDecl (GhcPass _) = NoExtCon instance (p ~ GhcPass pass,OutputableBndr (IdP p)) @@ -2342,8 +2342,8 @@ data AnnDecl pass = HsAnnotation -- For details on above see note [Api annotations] in ApiAnnotation | XAnnDecl (XXAnnDecl pass) -type instance XHsAnnotation (GhcPass _) = NoExt -type instance XXAnnDecl (GhcPass _) = NoExt +type instance XHsAnnotation (GhcPass _) = NoExtField +type instance XXAnnDecl (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (AnnDecl p) where ppr (HsAnnotation _ _ provenance expr) @@ -2395,8 +2395,8 @@ data RoleAnnotDecl pass -- For details on above see note [Api annotations] in ApiAnnotation | XRoleAnnotDecl (XXRoleAnnotDecl pass) -type instance XCRoleAnnotDecl (GhcPass _) = NoExt -type instance XXRoleAnnotDecl (GhcPass _) = NoExt +type instance XCRoleAnnotDecl (GhcPass _) = NoExtField +type instance XXRoleAnnotDecl (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndr (IdP p)) => Outputable (RoleAnnotDecl p) where @@ -2408,6 +2408,6 @@ instance (p ~ GhcPass pass, OutputableBndr (IdP p)) pp_role (Just r) = ppr r ppr (XRoleAnnotDecl x) = ppr x -roleAnnotDeclName :: RoleAnnotDecl pass -> (IdP pass) +roleAnnotDeclName :: RoleAnnotDecl (GhcPass p) -> IdP (GhcPass p) roleAnnotDeclName (RoleAnnotDecl _ (L _ name) _) = name -roleAnnotDeclName (XRoleAnnotDecl _) = panic "roleAnnotDeclName" +roleAnnotDeclName (XRoleAnnotDecl nec) = noExtCon nec diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index 9052855c69..6bfdad1600 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -110,13 +110,14 @@ data SyntaxExpr p = SyntaxExpr { syn_expr :: HsExpr p -- | This is used for rebindable-syntax pieces that are too polymorphic -- for tcSyntaxOp (trS_fmap and the mzip in ParStmt) noExpr :: HsExpr (GhcPass p) -noExpr = HsLit noExt (HsString (SourceText "noExpr") (fsLit "noExpr")) +noExpr = HsLit noExtField (HsString (SourceText "noExpr") (fsLit "noExpr")) noSyntaxExpr :: SyntaxExpr (GhcPass p) -- Before renaming, and sometimes after, -- (if the syntax slot makes no sense) -noSyntaxExpr = SyntaxExpr { syn_expr = HsLit noExt (HsString NoSourceText - (fsLit "noSyntaxExpr")) +noSyntaxExpr = SyntaxExpr { syn_expr = HsLit noExtField + (HsString NoSourceText + (fsLit "noSyntaxExpr")) , syn_arg_wraps = [] , syn_res_wrap = WpHole } @@ -129,7 +130,7 @@ mkSyntaxExpr expr = SyntaxExpr { syn_expr = expr -- | Make a 'SyntaxExpr Name' (the "rn" is because this is used in the -- renamer), missing its HsWrappers. mkRnSyntaxExpr :: Name -> SyntaxExpr GhcRn -mkRnSyntaxExpr name = mkSyntaxExpr $ HsVar noExt $ noLoc name +mkRnSyntaxExpr name = mkSyntaxExpr $ HsVar noExtField $ noLoc name -- don't care about filling in syn_arg_wraps because we're clearly -- not past the typechecker @@ -659,84 +660,84 @@ data RecordUpdTc = RecordUpdTc -- --------------------------------------------------------------------- -type instance XVar (GhcPass _) = NoExt -type instance XUnboundVar (GhcPass _) = NoExt -type instance XConLikeOut (GhcPass _) = NoExt -type instance XRecFld (GhcPass _) = NoExt -type instance XOverLabel (GhcPass _) = NoExt -type instance XIPVar (GhcPass _) = NoExt -type instance XOverLitE (GhcPass _) = NoExt -type instance XLitE (GhcPass _) = NoExt -type instance XLam (GhcPass _) = NoExt -type instance XLamCase (GhcPass _) = NoExt -type instance XApp (GhcPass _) = NoExt - -type instance XAppTypeE (GhcPass _) = NoExt - -type instance XOpApp GhcPs = NoExt +type instance XVar (GhcPass _) = NoExtField +type instance XUnboundVar (GhcPass _) = NoExtField +type instance XConLikeOut (GhcPass _) = NoExtField +type instance XRecFld (GhcPass _) = NoExtField +type instance XOverLabel (GhcPass _) = NoExtField +type instance XIPVar (GhcPass _) = NoExtField +type instance XOverLitE (GhcPass _) = NoExtField +type instance XLitE (GhcPass _) = NoExtField +type instance XLam (GhcPass _) = NoExtField +type instance XLamCase (GhcPass _) = NoExtField +type instance XApp (GhcPass _) = NoExtField + +type instance XAppTypeE (GhcPass _) = NoExtField + +type instance XOpApp GhcPs = NoExtField type instance XOpApp GhcRn = Fixity type instance XOpApp GhcTc = Fixity -type instance XNegApp (GhcPass _) = NoExt -type instance XPar (GhcPass _) = NoExt -type instance XSectionL (GhcPass _) = NoExt -type instance XSectionR (GhcPass _) = NoExt -type instance XExplicitTuple (GhcPass _) = NoExt +type instance XNegApp (GhcPass _) = NoExtField +type instance XPar (GhcPass _) = NoExtField +type instance XSectionL (GhcPass _) = NoExtField +type instance XSectionR (GhcPass _) = NoExtField +type instance XExplicitTuple (GhcPass _) = NoExtField -type instance XExplicitSum GhcPs = NoExt -type instance XExplicitSum GhcRn = NoExt +type instance XExplicitSum GhcPs = NoExtField +type instance XExplicitSum GhcRn = NoExtField type instance XExplicitSum GhcTc = [Type] -type instance XCase (GhcPass _) = NoExt -type instance XIf (GhcPass _) = NoExt +type instance XCase (GhcPass _) = NoExtField +type instance XIf (GhcPass _) = NoExtField -type instance XMultiIf GhcPs = NoExt -type instance XMultiIf GhcRn = NoExt +type instance XMultiIf GhcPs = NoExtField +type instance XMultiIf GhcRn = NoExtField type instance XMultiIf GhcTc = Type -type instance XLet (GhcPass _) = NoExt +type instance XLet (GhcPass _) = NoExtField -type instance XDo GhcPs = NoExt -type instance XDo GhcRn = NoExt +type instance XDo GhcPs = NoExtField +type instance XDo GhcRn = NoExtField type instance XDo GhcTc = Type -type instance XExplicitList GhcPs = NoExt -type instance XExplicitList GhcRn = NoExt +type instance XExplicitList GhcPs = NoExtField +type instance XExplicitList GhcRn = NoExtField type instance XExplicitList GhcTc = Type -type instance XRecordCon GhcPs = NoExt -type instance XRecordCon GhcRn = NoExt +type instance XRecordCon GhcPs = NoExtField +type instance XRecordCon GhcRn = NoExtField type instance XRecordCon GhcTc = RecordConTc -type instance XRecordUpd GhcPs = NoExt -type instance XRecordUpd GhcRn = NoExt +type instance XRecordUpd GhcPs = NoExtField +type instance XRecordUpd GhcRn = NoExtField type instance XRecordUpd GhcTc = RecordUpdTc -type instance XExprWithTySig (GhcPass _) = NoExt +type instance XExprWithTySig (GhcPass _) = NoExtField -type instance XArithSeq GhcPs = NoExt -type instance XArithSeq GhcRn = NoExt +type instance XArithSeq GhcPs = NoExtField +type instance XArithSeq GhcRn = NoExtField type instance XArithSeq GhcTc = PostTcExpr -type instance XSCC (GhcPass _) = NoExt -type instance XCoreAnn (GhcPass _) = NoExt -type instance XBracket (GhcPass _) = NoExt +type instance XSCC (GhcPass _) = NoExtField +type instance XCoreAnn (GhcPass _) = NoExtField +type instance XBracket (GhcPass _) = NoExtField -type instance XRnBracketOut (GhcPass _) = NoExt -type instance XTcBracketOut (GhcPass _) = NoExt +type instance XRnBracketOut (GhcPass _) = NoExtField +type instance XTcBracketOut (GhcPass _) = NoExtField -type instance XSpliceE (GhcPass _) = NoExt -type instance XProc (GhcPass _) = NoExt +type instance XSpliceE (GhcPass _) = NoExtField +type instance XProc (GhcPass _) = NoExtField -type instance XStatic GhcPs = NoExt +type instance XStatic GhcPs = NoExtField type instance XStatic GhcRn = NameSet type instance XStatic GhcTc = NameSet -type instance XTick (GhcPass _) = NoExt -type instance XBinTick (GhcPass _) = NoExt -type instance XTickPragma (GhcPass _) = NoExt -type instance XWrap (GhcPass _) = NoExt -type instance XXExpr (GhcPass _) = NoExt +type instance XTick (GhcPass _) = NoExtField +type instance XBinTick (GhcPass _) = NoExtField +type instance XTickPragma (GhcPass _) = NoExtField +type instance XWrap (GhcPass _) = NoExtField +type instance XXExpr (GhcPass _) = NoExtCon -- --------------------------------------------------------------------- @@ -757,13 +758,13 @@ data HsTupArg id | Missing (XMissing id) -- ^ The argument is missing, but this is its type | XTupArg (XXTupArg id) -- ^ Note [Trees that Grow] extension point -type instance XPresent (GhcPass _) = NoExt +type instance XPresent (GhcPass _) = NoExtField -type instance XMissing GhcPs = NoExt -type instance XMissing GhcRn = NoExt +type instance XMissing GhcPs = NoExtField +type instance XMissing GhcRn = NoExtField type instance XMissing GhcTc = Type -type instance XXTupArg (GhcPass _) = NoExt +type instance XXTupArg (GhcPass _) = NoExtCon tupArgPresent :: LHsTupArg id -> Bool tupArgPresent (L _ (Present {})) = True @@ -1173,7 +1174,7 @@ hsExprNeedsParens p = go -- and if so, surrounds @e@ with an 'HsPar'. Otherwise, it simply returns @e@. parenthesizeHsExpr :: PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) parenthesizeHsExpr p le@(L loc e) - | hsExprNeedsParens p e = L loc (HsPar NoExt le) + | hsExprNeedsParens p e = L loc (HsPar noExtField le) | otherwise = le isAtomicHsExpr :: HsExpr id -> Bool @@ -1298,24 +1299,24 @@ data HsCmd id -- Then (HsCmdWrap wrap cmd) :: arg2 --> res | XCmd (XXCmd id) -- Note [Trees that Grow] extension point -type instance XCmdArrApp GhcPs = NoExt -type instance XCmdArrApp GhcRn = NoExt +type instance XCmdArrApp GhcPs = NoExtField +type instance XCmdArrApp GhcRn = NoExtField type instance XCmdArrApp GhcTc = Type -type instance XCmdArrForm (GhcPass _) = NoExt -type instance XCmdApp (GhcPass _) = NoExt -type instance XCmdLam (GhcPass _) = NoExt -type instance XCmdPar (GhcPass _) = NoExt -type instance XCmdCase (GhcPass _) = NoExt -type instance XCmdIf (GhcPass _) = NoExt -type instance XCmdLet (GhcPass _) = NoExt +type instance XCmdArrForm (GhcPass _) = NoExtField +type instance XCmdApp (GhcPass _) = NoExtField +type instance XCmdLam (GhcPass _) = NoExtField +type instance XCmdPar (GhcPass _) = NoExtField +type instance XCmdCase (GhcPass _) = NoExtField +type instance XCmdIf (GhcPass _) = NoExtField +type instance XCmdLet (GhcPass _) = NoExtField -type instance XCmdDo GhcPs = NoExt -type instance XCmdDo GhcRn = NoExt +type instance XCmdDo GhcPs = NoExtField +type instance XCmdDo GhcRn = NoExtField type instance XCmdDo GhcTc = Type -type instance XCmdWrap (GhcPass _) = NoExt -type instance XXCmd (GhcPass _) = NoExt +type instance XCmdWrap (GhcPass _) = NoExtField +type instance XXCmd (GhcPass _) = NoExtCon -- | Haskell Array Application Type data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp @@ -1341,11 +1342,11 @@ data CmdTopTc Type -- return type of the command (CmdSyntaxTable GhcTc) -- See Note [CmdSyntaxTable] -type instance XCmdTop GhcPs = NoExt +type instance XCmdTop GhcPs = NoExtField type instance XCmdTop GhcRn = CmdSyntaxTable GhcRn -- See Note [CmdSyntaxTable] type instance XCmdTop GhcTc = CmdTopTc -type instance XXCmdTop (GhcPass _) = NoExt +type instance XXCmdTop (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p) where ppr cmd = pprCmd cmd @@ -1491,11 +1492,11 @@ data MatchGroupTc , mg_res_ty :: Type -- Type of the result, tr } deriving Data -type instance XMG GhcPs b = NoExt -type instance XMG GhcRn b = NoExt +type instance XMG GhcPs b = NoExtField +type instance XMG GhcRn b = NoExtField type instance XMG GhcTc b = MatchGroupTc -type instance XXMatchGroup (GhcPass _) b = NoExt +type instance XXMatchGroup (GhcPass _) b = NoExtCon -- | Located Match type LMatch id body = Located (Match id body) @@ -1513,8 +1514,8 @@ data Match p body } | XMatch (XXMatch p body) -type instance XCMatch (GhcPass _) b = NoExt -type instance XXMatch (GhcPass _) b = NoExt +type instance XCMatch (GhcPass _) b = NoExtField +type instance XXMatch (GhcPass _) b = NoExtCon instance (idR ~ GhcPass pr, OutputableBndrId idR, Outputable body) => Outputable (Match idR body) where @@ -1564,7 +1565,7 @@ isInfixMatch match = case m_ctxt match of isEmptyMatchGroup :: MatchGroup id body -> Bool isEmptyMatchGroup (MG { mg_alts = ms }) = null $ unLoc ms -isEmptyMatchGroup (XMatchGroup{}) = panic "isEmptyMatchGroup" +isEmptyMatchGroup (XMatchGroup {}) = False -- | Is there only one RHS in this list of matches? isSingletonMatchGroup :: [LMatch id body] -> Bool @@ -1575,17 +1576,17 @@ isSingletonMatchGroup matches | otherwise = False -matchGroupArity :: MatchGroup id body -> Arity +matchGroupArity :: MatchGroup (GhcPass id) body -> Arity -- Precondition: MatchGroup is non-empty -- This is called before type checking, when mg_arg_tys is not set matchGroupArity (MG { mg_alts = alts }) | L _ (alt1:_) <- alts = length (hsLMatchPats alt1) | otherwise = panic "matchGroupArity" -matchGroupArity (XMatchGroup{}) = panic "matchGroupArity" +matchGroupArity (XMatchGroup nec) = noExtCon nec -hsLMatchPats :: LMatch id body -> [LPat id] +hsLMatchPats :: LMatch (GhcPass id) body -> [LPat (GhcPass id)] hsLMatchPats (L _ (Match { m_pats = pats })) = pats -hsLMatchPats (L _ (XMatch _)) = panic "hsLMatchPats" +hsLMatchPats (L _ (XMatch nec)) = noExtCon nec -- | Guarded Right-Hand Sides -- @@ -1605,8 +1606,8 @@ data GRHSs p body } | XGRHSs (XXGRHSs p body) -type instance XCGRHSs (GhcPass _) b = NoExt -type instance XXGRHSs (GhcPass _) b = NoExt +type instance XCGRHSs (GhcPass _) b = NoExtField +type instance XXGRHSs (GhcPass _) b = NoExtCon -- | Located Guarded Right-Hand Side type LGRHS id body = Located (GRHS id body) @@ -1617,8 +1618,8 @@ data GRHS p body = GRHS (XCGRHS p body) body -- Right hand side | XGRHS (XXGRHS p body) -type instance XCGRHS (GhcPass _) b = NoExt -type instance XXGRHS (GhcPass _) b = NoExt +type instance XCGRHS (GhcPass _) b = NoExtField +type instance XXGRHS (GhcPass _) b = NoExtCon -- We know the list must have at least one @Match@ in it. @@ -1887,35 +1888,35 @@ data RecStmtTc = } -type instance XLastStmt (GhcPass _) (GhcPass _) b = NoExt +type instance XLastStmt (GhcPass _) (GhcPass _) b = NoExtField -type instance XBindStmt (GhcPass _) GhcPs b = NoExt -type instance XBindStmt (GhcPass _) GhcRn b = NoExt +type instance XBindStmt (GhcPass _) GhcPs b = NoExtField +type instance XBindStmt (GhcPass _) GhcRn b = NoExtField type instance XBindStmt (GhcPass _) GhcTc b = Type -type instance XApplicativeStmt (GhcPass _) GhcPs b = NoExt -type instance XApplicativeStmt (GhcPass _) GhcRn b = NoExt +type instance XApplicativeStmt (GhcPass _) GhcPs b = NoExtField +type instance XApplicativeStmt (GhcPass _) GhcRn b = NoExtField type instance XApplicativeStmt (GhcPass _) GhcTc b = Type -type instance XBodyStmt (GhcPass _) GhcPs b = NoExt -type instance XBodyStmt (GhcPass _) GhcRn b = NoExt +type instance XBodyStmt (GhcPass _) GhcPs b = NoExtField +type instance XBodyStmt (GhcPass _) GhcRn b = NoExtField type instance XBodyStmt (GhcPass _) GhcTc b = Type -type instance XLetStmt (GhcPass _) (GhcPass _) b = NoExt +type instance XLetStmt (GhcPass _) (GhcPass _) b = NoExtField -type instance XParStmt (GhcPass _) GhcPs b = NoExt -type instance XParStmt (GhcPass _) GhcRn b = NoExt +type instance XParStmt (GhcPass _) GhcPs b = NoExtField +type instance XParStmt (GhcPass _) GhcRn b = NoExtField type instance XParStmt (GhcPass _) GhcTc b = Type -type instance XTransStmt (GhcPass _) GhcPs b = NoExt -type instance XTransStmt (GhcPass _) GhcRn b = NoExt +type instance XTransStmt (GhcPass _) GhcPs b = NoExtField +type instance XTransStmt (GhcPass _) GhcRn b = NoExtField type instance XTransStmt (GhcPass _) GhcTc b = Type -type instance XRecStmt (GhcPass _) GhcPs b = NoExt -type instance XRecStmt (GhcPass _) GhcRn b = NoExt +type instance XRecStmt (GhcPass _) GhcPs b = NoExtField +type instance XRecStmt (GhcPass _) GhcRn b = NoExtField type instance XRecStmt (GhcPass _) GhcTc b = RecStmtTc -type instance XXStmtLR (GhcPass _) (GhcPass _) b = NoExt +type instance XXStmtLR (GhcPass _) (GhcPass _) b = NoExtCon data TransForm -- The 'f' below is the 'using' function, 'e' is the by function = ThenForm -- then f or then f by e (depending on trS_by) @@ -1931,8 +1932,8 @@ data ParStmtBlock idL idR (SyntaxExpr idR) -- The return operator | XParStmtBlock (XXParStmtBlock idL idR) -type instance XParStmtBlock (GhcPass pL) (GhcPass pR) = NoExt -type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExt +type instance XParStmtBlock (GhcPass pL) (GhcPass pR) = NoExtField +type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExtCon -- | Applicative Argument data ApplicativeArg idL @@ -1951,9 +1952,9 @@ data ApplicativeArg idL (LPat idL) -- (v1,...,vn) | XApplicativeArg (XXApplicativeArg idL) -type instance XApplicativeArgOne (GhcPass _) = NoExt -type instance XApplicativeArgMany (GhcPass _) = NoExt -type instance XXApplicativeArg (GhcPass _) = NoExt +type instance XApplicativeArgOne (GhcPass _) = NoExtField +type instance XApplicativeArgMany (GhcPass _) = NoExtField +type instance XXApplicativeArg (GhcPass _) = NoExtCon {- Note [The type of bind in Stmts] @@ -2184,7 +2185,7 @@ pprStmt (ApplicativeStmt _ args mb_join) :: ExprStmt (GhcPass idL))] flattenArg (_, ApplicativeArgMany _ stmts _ _) = concatMap flattenStmt stmts - flattenArg (_, XApplicativeArg _) = panic "flattenArg" + flattenArg (_, XApplicativeArg nec) = noExtCon nec pp_debug = let @@ -2207,7 +2208,7 @@ pprStmt (ApplicativeStmt _ args mb_join) text "<-" <+> ppr (HsDo (panic "pprStmt") DoExpr (noLoc (stmts ++ - [noLoc (LastStmt noExt (noLoc return) False noSyntaxExpr)]))) + [noLoc (LastStmt noExtField (noLoc return) False noSyntaxExpr)]))) pp_arg (_, XApplicativeArg x) = ppr x pprStmt (XStmtLR x) = ppr x @@ -2308,11 +2309,11 @@ data HsSplice id DelayedSplice | XSplice (XXSplice id) -- Note [Trees that Grow] extension point -type instance XTypedSplice (GhcPass _) = NoExt -type instance XUntypedSplice (GhcPass _) = NoExt -type instance XQuasiQuote (GhcPass _) = NoExt -type instance XSpliced (GhcPass _) = NoExt -type instance XXSplice (GhcPass _) = NoExt +type instance XTypedSplice (GhcPass _) = NoExtField +type instance XUntypedSplice (GhcPass _) = NoExtField +type instance XQuasiQuote (GhcPass _) = NoExtField +type instance XSpliced (GhcPass _) = NoExtField +type instance XXSplice (GhcPass _) = NoExtCon -- | A splice can appear with various decorations wrapped around it. This data -- type captures explicitly how it was originally written, for use in the pretty @@ -2515,14 +2516,14 @@ data HsBracket p | TExpBr (XTExpBr p) (LHsExpr p) -- [|| expr ||] | XBracket (XXBracket p) -- Note [Trees that Grow] extension point -type instance XExpBr (GhcPass _) = NoExt -type instance XPatBr (GhcPass _) = NoExt -type instance XDecBrL (GhcPass _) = NoExt -type instance XDecBrG (GhcPass _) = NoExt -type instance XTypBr (GhcPass _) = NoExt -type instance XVarBr (GhcPass _) = NoExt -type instance XTExpBr (GhcPass _) = NoExt -type instance XXBracket (GhcPass _) = NoExt +type instance XExpBr (GhcPass _) = NoExtField +type instance XPatBr (GhcPass _) = NoExtField +type instance XDecBrL (GhcPass _) = NoExtField +type instance XDecBrG (GhcPass _) = NoExtField +type instance XTypBr (GhcPass _) = NoExtField +type instance XVarBr (GhcPass _) = NoExtField +type instance XTExpBr (GhcPass _) = NoExtField +type instance XXBracket (GhcPass _) = NoExtCon isTypedBracket :: HsBracket id -> Bool isTypedBracket (TExpBr {}) = True diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs index 0ae0dd01e3..c486ad8a11 100644 --- a/compiler/hsSyn/HsExtension.hs +++ b/compiler/hsSyn/HsExtension.hs @@ -1,5 +1,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE EmptyDataDeriving #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} @@ -53,16 +55,79 @@ haskell-src-exts ASTs as well. -} --- | used as place holder in TTG values -data NoExt = NoExt +-- | A placeholder type for TTG extension points that are not currently +-- unused to represent any particular value. +-- +-- This should not be confused with 'NoExtCon', which are found in unused +-- extension /constructors/ and therefore should never be inhabited. In +-- contrast, 'NoExtField' is used in extension /points/ (e.g., as the field of +-- some constructor), so it must have an inhabitant to construct AST passes +-- that manipulate fields with that extension point as their type. +data NoExtField = NoExtField deriving (Data,Eq,Ord) -instance Outputable NoExt where - ppr _ = text "NoExt" +instance Outputable NoExtField where + ppr _ = text "NoExtField" -- | Used when constructing a term with an unused extension point. -noExt :: NoExt -noExt = NoExt +noExtField :: NoExtField +noExtField = NoExtField + +-- | Used in TTG extension constructors that have yet to be extended with +-- anything. If an extension constructor has 'NoExtCon' as its field, it is +-- not intended to ever be constructed anywhere, and any function that consumes +-- the extension constructor can eliminate it by way of 'noExtCon'. +-- +-- This should not be confused with 'NoExtField', which are found in unused +-- extension /points/ (not /constructors/) and therefore can be inhabited. + +-- See also [NoExtCon and strict fields]. +data NoExtCon + deriving (Data,Eq,Ord) + +instance Outputable NoExtCon where + ppr = noExtCon + +-- | Eliminate a 'NoExtCon'. Much like 'Data.Void.absurd'. +noExtCon :: NoExtCon -> a +noExtCon x = case x of {} + +{- +Note [NoExtCon and strict fields] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Currently, any unused TTG extension constructor will generally look like the +following: + + type instance XXHsDecl (GhcPass _) = NoExtCon + data HsDecl p + = ... + | XHsDecl (XXHsDecl p) + +This means that any function that wishes to consume an HsDecl will need to +have a case for XHsDecl. This might look like this: + + ex :: HsDecl GhcPs -> HsDecl GhcRn + ... + ex (XHsDecl nec) = noExtCon nec + +Ideally, we wouldn't need a case for XHsDecl at all (it /is/ supposed to be +an unused extension constructor, after all). There is a way to achieve this +on GHC 8.8 or later: make the field of XHsDecl strict: + + data HsDecl p + = ... + | XHsDecl !(XXHsDecl p) + +If this is done, GHC's pattern-match coverage checker is clever enough to +figure out that the XHsDecl case of `ex` is unreachable, so it can simply be +omitted. (See Note [Extensions to GADTs Meet Their Match] in Check for more on +how this works.) + +When GHC drops support for bootstrapping with GHC 8.6 and earlier, we can make +the strict field changes described above and delete gobs of code involving +`noExtCon`. Until then, it is necessary to use, so be aware of it when writing +code that consumes unused extension constructors. +-} -- | Used as a data type index for the hsSyn AST data GhcPass (c :: Pass) @@ -1068,7 +1133,7 @@ type ConvertIdX a b = -- -- So -- --- type instance XXHsIPBinds (GhcPass p) = NoExt +-- type instance XXHsIPBinds (GhcPass p) = NoExtCon -- -- will correctly deduce Outputable for (GhcPass p), but -- diff --git a/compiler/hsSyn/HsImpExp.hs b/compiler/hsSyn/HsImpExp.hs index 1d487565e2..bedb74e05d 100644 --- a/compiler/hsSyn/HsImpExp.hs +++ b/compiler/hsSyn/HsImpExp.hs @@ -108,12 +108,12 @@ data ImportDecl pass -- For details on above see note [Api annotations] in ApiAnnotation -type instance XCImportDecl (GhcPass _) = NoExt -type instance XXImportDecl (GhcPass _) = NoExt +type instance XCImportDecl (GhcPass _) = NoExtField +type instance XXImportDecl (GhcPass _) = NoExtCon simpleImportDecl :: ModuleName -> ImportDecl (GhcPass p) simpleImportDecl mn = ImportDecl { - ideclExt = noExt, + ideclExt = noExtField, ideclSourceSrc = NoSourceText, ideclName = noLoc mn, ideclPkgQual = Nothing, @@ -254,15 +254,15 @@ data IE pass | IEDocNamed (XIEDocNamed pass) String -- ^ Reference to named doc | XIE (XXIE pass) -type instance XIEVar (GhcPass _) = NoExt -type instance XIEThingAbs (GhcPass _) = NoExt -type instance XIEThingAll (GhcPass _) = NoExt -type instance XIEThingWith (GhcPass _) = NoExt -type instance XIEModuleContents (GhcPass _) = NoExt -type instance XIEGroup (GhcPass _) = NoExt -type instance XIEDoc (GhcPass _) = NoExt -type instance XIEDocNamed (GhcPass _) = NoExt -type instance XXIE (GhcPass _) = NoExt +type instance XIEVar (GhcPass _) = NoExtField +type instance XIEThingAbs (GhcPass _) = NoExtField +type instance XIEThingAll (GhcPass _) = NoExtField +type instance XIEThingWith (GhcPass _) = NoExtField +type instance XIEModuleContents (GhcPass _) = NoExtField +type instance XIEGroup (GhcPass _) = NoExtField +type instance XIEDoc (GhcPass _) = NoExtField +type instance XIEDocNamed (GhcPass _) = NoExtField +type instance XXIE (GhcPass _) = NoExtCon -- | Imported or Exported Wildcard data IEWildcard = NoIEWildcard | IEWildcard Int deriving (Eq, Data) @@ -284,14 +284,14 @@ gives rise to See Note [Representing fields in AvailInfo] in Avail for more details. -} -ieName :: IE pass -> IdP pass +ieName :: IE (GhcPass p) -> IdP (GhcPass p) ieName (IEVar _ (L _ n)) = ieWrappedName n ieName (IEThingAbs _ (L _ n)) = ieWrappedName n ieName (IEThingWith _ (L _ n) _ _ _) = ieWrappedName n ieName (IEThingAll _ (L _ n)) = ieWrappedName n ieName _ = panic "ieName failed pattern match!" -ieNames :: IE pass -> [IdP pass] +ieNames :: IE (GhcPass p) -> [IdP (GhcPass p)] ieNames (IEVar _ (L _ n) ) = [ieWrappedName n] ieNames (IEThingAbs _ (L _ n) ) = [ieWrappedName n] ieNames (IEThingAll _ (L _ n) ) = [ieWrappedName n] @@ -301,7 +301,7 @@ ieNames (IEModuleContents {}) = [] ieNames (IEGroup {}) = [] ieNames (IEDoc {}) = [] ieNames (IEDocNamed {}) = [] -ieNames (XIE {}) = panic "ieNames" +ieNames (XIE nec) = noExtCon nec ieWrappedName :: IEWrappedName name -> name ieWrappedName (IEName (L _ n)) = n diff --git a/compiler/hsSyn/HsLit.hs b/compiler/hsSyn/HsLit.hs index d1411bd750..074c7295af 100644 --- a/compiler/hsSyn/HsLit.hs +++ b/compiler/hsSyn/HsLit.hs @@ -82,16 +82,16 @@ type instance XHsChar (GhcPass _) = SourceText type instance XHsCharPrim (GhcPass _) = SourceText type instance XHsString (GhcPass _) = SourceText type instance XHsStringPrim (GhcPass _) = SourceText -type instance XHsInt (GhcPass _) = NoExt +type instance XHsInt (GhcPass _) = NoExtField type instance XHsIntPrim (GhcPass _) = SourceText type instance XHsWordPrim (GhcPass _) = SourceText type instance XHsInt64Prim (GhcPass _) = SourceText type instance XHsWord64Prim (GhcPass _) = SourceText type instance XHsInteger (GhcPass _) = SourceText -type instance XHsRat (GhcPass _) = NoExt -type instance XHsFloatPrim (GhcPass _) = NoExt -type instance XHsDoublePrim (GhcPass _) = NoExt -type instance XXLit (GhcPass _) = NoExt +type instance XHsRat (GhcPass _) = NoExtField +type instance XHsFloatPrim (GhcPass _) = NoExtField +type instance XHsDoublePrim (GhcPass _) = NoExtField +type instance XXLit (GhcPass _) = NoExtCon instance Eq (HsLit x) where (HsChar _ x1) == (HsChar _ x2) = x1==x2 @@ -125,11 +125,11 @@ data OverLitTc ol_type :: Type } deriving Data -type instance XOverLit GhcPs = NoExt +type instance XOverLit GhcPs = NoExtField type instance XOverLit GhcRn = Bool -- Note [ol_rebindable] type instance XOverLit GhcTc = OverLitTc -type instance XXOverLit (GhcPass _) = NoExt +type instance XXOverLit (GhcPass _) = NoExtCon -- Note [Literal source text] in BasicTypes for SourceText fields in -- the following @@ -147,7 +147,7 @@ negateOverLitVal _ = panic "negateOverLitVal: argument is not a number" overLitType :: HsOverLit GhcTc -> Type overLitType (OverLit (OverLitTc _ ty) _ _) = ty -overLitType XOverLit{} = panic "overLitType" +overLitType (XOverLit nec) = noExtCon nec -- | Convert a literal from one index type to another, updating the annotations -- according to the relevant 'Convertable' instance diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs index bce65ba25a..9f8d2a5ed4 100644 --- a/compiler/hsSyn/HsPat.hs +++ b/compiler/hsSyn/HsPat.hs @@ -281,51 +281,51 @@ data ListPatTc Type -- The type of the elements (Maybe (Type, SyntaxExpr GhcTc)) -- For rebindable syntax -type instance XWildPat GhcPs = NoExt -type instance XWildPat GhcRn = NoExt +type instance XWildPat GhcPs = NoExtField +type instance XWildPat GhcRn = NoExtField type instance XWildPat GhcTc = Type -type instance XVarPat (GhcPass _) = NoExt -type instance XLazyPat (GhcPass _) = NoExt -type instance XAsPat (GhcPass _) = NoExt -type instance XParPat (GhcPass _) = NoExt -type instance XBangPat (GhcPass _) = NoExt +type instance XVarPat (GhcPass _) = NoExtField +type instance XLazyPat (GhcPass _) = NoExtField +type instance XAsPat (GhcPass _) = NoExtField +type instance XParPat (GhcPass _) = NoExtField +type instance XBangPat (GhcPass _) = NoExtField -- Note: XListPat cannot be extended when using GHC 8.0.2 as the bootstrap -- compiler, as it triggers https://gitlab.haskell.org/ghc/ghc/issues/14396 for -- `SyntaxExpr` -type instance XListPat GhcPs = NoExt +type instance XListPat GhcPs = NoExtField type instance XListPat GhcRn = Maybe (SyntaxExpr GhcRn) type instance XListPat GhcTc = ListPatTc -type instance XTuplePat GhcPs = NoExt -type instance XTuplePat GhcRn = NoExt +type instance XTuplePat GhcPs = NoExtField +type instance XTuplePat GhcRn = NoExtField type instance XTuplePat GhcTc = [Type] -type instance XSumPat GhcPs = NoExt -type instance XSumPat GhcRn = NoExt +type instance XSumPat GhcPs = NoExtField +type instance XSumPat GhcRn = NoExtField type instance XSumPat GhcTc = [Type] -type instance XViewPat GhcPs = NoExt -type instance XViewPat GhcRn = NoExt +type instance XViewPat GhcPs = NoExtField +type instance XViewPat GhcRn = NoExtField type instance XViewPat GhcTc = Type -type instance XSplicePat (GhcPass _) = NoExt -type instance XLitPat (GhcPass _) = NoExt +type instance XSplicePat (GhcPass _) = NoExtField +type instance XLitPat (GhcPass _) = NoExtField -type instance XNPat GhcPs = NoExt -type instance XNPat GhcRn = NoExt +type instance XNPat GhcPs = NoExtField +type instance XNPat GhcRn = NoExtField type instance XNPat GhcTc = Type -type instance XNPlusKPat GhcPs = NoExt -type instance XNPlusKPat GhcRn = NoExt +type instance XNPlusKPat GhcPs = NoExtField +type instance XNPlusKPat GhcRn = NoExtField type instance XNPlusKPat GhcTc = Type -type instance XSigPat GhcPs = NoExt -type instance XSigPat GhcRn = NoExt +type instance XSigPat GhcPs = NoExtField +type instance XSigPat GhcRn = NoExtField type instance XSigPat GhcTc = Type -type instance XCoPat (GhcPass _) = NoExt +type instance XCoPat (GhcPass _) = NoExtField type instance XXPat (GhcPass p) = Located (Pat (GhcPass p)) @@ -460,11 +460,11 @@ data HsRecField' id arg = HsRecField { -- -- The parsed HsRecUpdField corresponding to the record update will have: -- --- hsRecFieldLbl = Unambiguous "x" NoExt :: AmbiguousFieldOcc RdrName +-- hsRecFieldLbl = Unambiguous "x" noExtField :: AmbiguousFieldOcc RdrName -- -- After the renamer, this will become: -- --- hsRecFieldLbl = Ambiguous "x" NoExt :: AmbiguousFieldOcc Name +-- hsRecFieldLbl = Ambiguous "x" noExtField :: AmbiguousFieldOcc Name -- -- (note that the Unambiguous constructor is not type-correct here). -- The typechecker will determine the particular selector: @@ -630,7 +630,7 @@ mkNilPat ty = mkPrefixConPat nilDataCon [] [ty] mkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p) mkCharLitPat src c = mkPrefixConPat charDataCon - [noLoc $ LitPat NoExt (HsCharPrim src c)] [] + [noLoc $ LitPat noExtField (HsCharPrim src c)] [] {- ************************************************************************ @@ -811,7 +811,7 @@ conPatNeedsParens p = go -- 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 NoExt lpat) + | patNeedsParens p pat = cL loc (ParPat noExtField lpat) | otherwise = lpat {- diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 130e39efab..b9b140bf45 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -334,14 +334,14 @@ type HsQTvsRn = [Name] -- Implicit variables -- For example, in data T (a :: k1 -> k2) = ... -- the 'a' is explicit while 'k1', 'k2' are implicit -type instance XHsQTvs GhcPs = NoExt +type instance XHsQTvs GhcPs = NoExtField type instance XHsQTvs GhcRn = HsQTvsRn type instance XHsQTvs GhcTc = HsQTvsRn -type instance XXLHsQTyVars (GhcPass _) = NoExt +type instance XXLHsQTyVars (GhcPass _) = NoExtCon mkHsQTvs :: [LHsTyVarBndr GhcPs] -> LHsQTyVars GhcPs -mkHsQTvs tvs = HsQTvs { hsq_ext = noExt, hsq_explicit = tvs } +mkHsQTvs tvs = HsQTvs { hsq_ext = noExtField, hsq_explicit = tvs } hsQTvExplicit :: LHsQTyVars pass -> [LHsTyVarBndr pass] hsQTvExplicit = hsq_explicit @@ -372,11 +372,11 @@ data HsImplicitBndrs pass thing -- See Note [HsType binders] } | XHsImplicitBndrs (XXHsImplicitBndrs pass thing) -type instance XHsIB GhcPs _ = NoExt +type instance XHsIB GhcPs _ = NoExtField type instance XHsIB GhcRn _ = [Name] type instance XHsIB GhcTc _ = [Name] -type instance XXHsImplicitBndrs (GhcPass _) _ = NoExt +type instance XXHsImplicitBndrs (GhcPass _) _ = NoExtCon -- | Haskell Wildcard Binders data HsWildCardBndrs pass thing @@ -394,11 +394,11 @@ data HsWildCardBndrs pass thing } | XHsWildCardBndrs (XXHsWildCardBndrs pass thing) -type instance XHsWC GhcPs b = NoExt +type instance XHsWC GhcPs b = NoExtField type instance XHsWC GhcRn b = [Name] type instance XHsWC GhcTc b = [Name] -type instance XXHsWildCardBndrs (GhcPass _) b = NoExt +type instance XXHsWildCardBndrs (GhcPass _) b = NoExtCon -- | Located Haskell Signature Type type LHsSigType pass = HsImplicitBndrs pass (LHsType pass) -- Implicit only @@ -411,11 +411,11 @@ type LHsSigWcType pass = HsWildCardBndrs pass (LHsSigType pass) -- Both -- See Note [Representing type signatures] -hsImplicitBody :: HsImplicitBndrs pass thing -> thing +hsImplicitBody :: HsImplicitBndrs (GhcPass p) thing -> thing hsImplicitBody (HsIB { hsib_body = body }) = body -hsImplicitBody (XHsImplicitBndrs _) = panic "hsImplicitBody" +hsImplicitBody (XHsImplicitBndrs nec) = noExtCon nec -hsSigType :: LHsSigType pass -> LHsType pass +hsSigType :: LHsSigType (GhcPass p) -> LHsType (GhcPass p) hsSigType = hsImplicitBody hsSigWcType :: LHsSigWcType pass -> LHsType pass @@ -446,12 +446,12 @@ the explicitly forall'd tyvar 'a' is bound by the HsForAllTy -} mkHsImplicitBndrs :: thing -> HsImplicitBndrs GhcPs thing -mkHsImplicitBndrs x = HsIB { hsib_ext = noExt +mkHsImplicitBndrs x = HsIB { hsib_ext = noExtField , hsib_body = x } mkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing mkHsWildCardBndrs x = HsWC { hswc_body = x - , hswc_ext = noExt } + , hswc_ext = noExtField } -- Add empty binders. This is a bit suspicious; what if -- the wrapped thing had free type variables? @@ -502,15 +502,15 @@ data HsTyVarBndr pass | XTyVarBndr (XXTyVarBndr pass) -type instance XUserTyVar (GhcPass _) = NoExt -type instance XKindedTyVar (GhcPass _) = NoExt -type instance XXTyVarBndr (GhcPass _) = NoExt +type instance XUserTyVar (GhcPass _) = NoExtField +type instance XKindedTyVar (GhcPass _) = NoExtField +type instance XXTyVarBndr (GhcPass _) = NoExtCon -- | Does this 'HsTyVarBndr' come with an explicit kind annotation? isHsKindedTyVar :: HsTyVarBndr pass -> Bool isHsKindedTyVar (UserTyVar {}) = False isHsKindedTyVar (KindedTyVar {}) = True -isHsKindedTyVar (XTyVarBndr{}) = panic "isHsKindedTyVar" +isHsKindedTyVar (XTyVarBndr {}) = False -- | Do all type variables in this 'LHsQTyVars' come with kind annotations? hsTvbAllKinded :: LHsQTyVars pass -> Bool @@ -704,41 +704,41 @@ data NewHsTypeX instance Outputable NewHsTypeX where ppr (NHsCoreTy ty) = ppr ty -type instance XForAllTy (GhcPass _) = NoExt -type instance XQualTy (GhcPass _) = NoExt -type instance XTyVar (GhcPass _) = NoExt -type instance XAppTy (GhcPass _) = NoExt -type instance XFunTy (GhcPass _) = NoExt -type instance XListTy (GhcPass _) = NoExt -type instance XTupleTy (GhcPass _) = NoExt -type instance XSumTy (GhcPass _) = NoExt -type instance XOpTy (GhcPass _) = NoExt -type instance XParTy (GhcPass _) = NoExt -type instance XIParamTy (GhcPass _) = NoExt -type instance XStarTy (GhcPass _) = NoExt -type instance XKindSig (GhcPass _) = NoExt +type instance XForAllTy (GhcPass _) = NoExtField +type instance XQualTy (GhcPass _) = NoExtField +type instance XTyVar (GhcPass _) = NoExtField +type instance XAppTy (GhcPass _) = NoExtField +type instance XFunTy (GhcPass _) = NoExtField +type instance XListTy (GhcPass _) = NoExtField +type instance XTupleTy (GhcPass _) = NoExtField +type instance XSumTy (GhcPass _) = NoExtField +type instance XOpTy (GhcPass _) = NoExtField +type instance XParTy (GhcPass _) = NoExtField +type instance XIParamTy (GhcPass _) = NoExtField +type instance XStarTy (GhcPass _) = NoExtField +type instance XKindSig (GhcPass _) = NoExtField type instance XAppKindTy (GhcPass _) = SrcSpan -- Where the `@` lives -type instance XSpliceTy GhcPs = NoExt -type instance XSpliceTy GhcRn = NoExt +type instance XSpliceTy GhcPs = NoExtField +type instance XSpliceTy GhcRn = NoExtField type instance XSpliceTy GhcTc = Kind -type instance XDocTy (GhcPass _) = NoExt -type instance XBangTy (GhcPass _) = NoExt -type instance XRecTy (GhcPass _) = NoExt +type instance XDocTy (GhcPass _) = NoExtField +type instance XBangTy (GhcPass _) = NoExtField +type instance XRecTy (GhcPass _) = NoExtField -type instance XExplicitListTy GhcPs = NoExt -type instance XExplicitListTy GhcRn = NoExt +type instance XExplicitListTy GhcPs = NoExtField +type instance XExplicitListTy GhcRn = NoExtField type instance XExplicitListTy GhcTc = Kind -type instance XExplicitTupleTy GhcPs = NoExt -type instance XExplicitTupleTy GhcRn = NoExt +type instance XExplicitTupleTy GhcPs = NoExtField +type instance XExplicitTupleTy GhcRn = NoExtField type instance XExplicitTupleTy GhcTc = [Kind] -type instance XTyLit (GhcPass _) = NoExt +type instance XTyLit (GhcPass _) = NoExtField -type instance XWildCardTy (GhcPass _) = NoExt +type instance XWildCardTy (GhcPass _) = NoExtField type instance XXType (GhcPass _) = NewHsTypeX @@ -890,8 +890,8 @@ data ConDeclField pass -- Record fields have Haddoc docs on them -- For details on above see note [Api annotations] in ApiAnnotation | XConDeclField (XXConDeclField pass) -type instance XConDeclField (GhcPass _) = NoExt -type instance XXConDeclField (GhcPass _) = NoExt +type instance XConDeclField (GhcPass _) = NoExtField +type instance XXConDeclField (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ConDeclField p) where @@ -962,8 +962,8 @@ hsWcScopedTvs sig_ty -- include kind variables only if the type is headed by forall -- (this is consistent with GHC 7 behaviour) _ -> nwcs -hsWcScopedTvs (HsWC _ (XHsImplicitBndrs _)) = panic "hsWcScopedTvs" -hsWcScopedTvs (XHsWildCardBndrs _) = panic "hsWcScopedTvs" +hsWcScopedTvs (HsWC _ (XHsImplicitBndrs nec)) = noExtCon nec +hsWcScopedTvs (XHsWildCardBndrs nec) = noExtCon nec hsScopedTvs :: LHsSigType GhcRn -> [Name] -- Same as hsWcScopedTvs, but for a LHsSigType @@ -989,18 +989,18 @@ I don't know if this is a good idea, but there it is. -} --------------------- -hsTyVarName :: HsTyVarBndr pass -> IdP pass +hsTyVarName :: HsTyVarBndr (GhcPass p) -> IdP (GhcPass p) hsTyVarName (UserTyVar _ (L _ n)) = n hsTyVarName (KindedTyVar _ (L _ n) _) = n -hsTyVarName (XTyVarBndr{}) = panic "hsTyVarName" +hsTyVarName (XTyVarBndr nec) = noExtCon nec -hsLTyVarName :: LHsTyVarBndr pass -> IdP pass +hsLTyVarName :: LHsTyVarBndr (GhcPass p) -> IdP (GhcPass p) hsLTyVarName = hsTyVarName . unLoc -hsLTyVarNames :: [LHsTyVarBndr pass] -> [IdP pass] +hsLTyVarNames :: [LHsTyVarBndr (GhcPass p)] -> [IdP (GhcPass p)] hsLTyVarNames = map hsLTyVarName -hsExplicitLTyVarNames :: LHsQTyVars pass -> [IdP pass] +hsExplicitLTyVarNames :: LHsQTyVars (GhcPass p) -> [IdP (GhcPass p)] -- Explicit variables only hsExplicitLTyVarNames qtvs = map hsLTyVarName (hsQTvExplicit qtvs) @@ -1009,28 +1009,28 @@ hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name] hsAllLTyVarNames (HsQTvs { hsq_ext = kvs , hsq_explicit = tvs }) = kvs ++ hsLTyVarNames tvs -hsAllLTyVarNames (XLHsQTyVars _) = panic "hsAllLTyVarNames" +hsAllLTyVarNames (XLHsQTyVars nec) = noExtCon nec -hsLTyVarLocName :: LHsTyVarBndr pass -> Located (IdP pass) +hsLTyVarLocName :: LHsTyVarBndr (GhcPass p) -> Located (IdP (GhcPass p)) hsLTyVarLocName = onHasSrcSpan hsTyVarName -hsLTyVarLocNames :: LHsQTyVars pass -> [Located (IdP pass)] +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 - where cvt (UserTyVar _ n) = HsTyVar noExt NotPromoted n + where cvt (UserTyVar _ n) = HsTyVar noExtField NotPromoted n cvt (KindedTyVar _ (L name_loc n) kind) - = HsKindSig noExt - (L name_loc (HsTyVar noExt NotPromoted (L name_loc n))) kind - cvt (XTyVarBndr{}) = panic "hsLTyVarBndrToType" + = HsKindSig noExtField + (L name_loc (HsTyVar noExtField NotPromoted (L name_loc n))) kind + cvt (XTyVarBndr nec) = noExtCon nec -- | Convert a LHsTyVarBndrs to a list of types. -- Works on *type* variable only, no kind vars. hsLTyVarBndrsToTypes :: LHsQTyVars (GhcPass p) -> [LHsType (GhcPass p)] hsLTyVarBndrsToTypes (HsQTvs { hsq_explicit = tvbs }) = map hsLTyVarBndrToType tvbs -hsLTyVarBndrsToTypes (XLHsQTyVars _) = panic "hsLTyVarBndrsToTypes" +hsLTyVarBndrsToTypes (XLHsQTyVars nec) = noExtCon nec --------------------- ignoreParens :: LHsType pass -> LHsType pass @@ -1050,15 +1050,15 @@ isLHsForAllTy _ = False -} mkAnonWildCardTy :: HsType GhcPs -mkAnonWildCardTy = HsWildCardTy noExt +mkAnonWildCardTy = HsWildCardTy noExtField mkHsOpTy :: LHsType (GhcPass p) -> Located (IdP (GhcPass p)) -> LHsType (GhcPass p) -> HsType (GhcPass p) -mkHsOpTy ty1 op ty2 = HsOpTy noExt ty1 op ty2 +mkHsOpTy ty1 op ty2 = HsOpTy noExtField ty1 op ty2 mkHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) mkHsAppTy t1 t2 - = addCLoc t1 t2 (HsAppTy noExt t1 (parenthesizeHsType appPrec t2)) + = addCLoc t1 t2 (HsAppTy noExtField t1 (parenthesizeHsType appPrec t2)) mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p) @@ -1270,9 +1270,9 @@ splitLHsInstDeclTy (HsIB { hsib_ext = itkvs = (itkvs ++ hsLTyVarNames tvs, cxt, body_ty) -- Return implicitly bound type and kind vars -- For an instance decl, all of them are in scope -splitLHsInstDeclTy (XHsImplicitBndrs _) = panic "splitLHsInstDeclTy" +splitLHsInstDeclTy (XHsImplicitBndrs nec) = noExtCon nec -getLHsInstDeclHead :: LHsSigType pass -> LHsType pass +getLHsInstDeclHead :: LHsSigType (GhcPass p) -> LHsType (GhcPass p) getLHsInstDeclHead inst_ty | (_tvs, _cxt, body_ty) <- splitLHsSigmaTyInvis (hsSigType inst_ty) = body_ty @@ -1311,17 +1311,17 @@ data FieldOcc pass = FieldOcc { extFieldOcc :: XCFieldOcc pass deriving instance (p ~ GhcPass pass, Eq (XCFieldOcc p)) => Eq (FieldOcc p) deriving instance (p ~ GhcPass pass, Ord (XCFieldOcc p)) => Ord (FieldOcc p) -type instance XCFieldOcc GhcPs = NoExt +type instance XCFieldOcc GhcPs = NoExtField type instance XCFieldOcc GhcRn = Name type instance XCFieldOcc GhcTc = Id -type instance XXFieldOcc (GhcPass _) = NoExt +type instance XXFieldOcc (GhcPass _) = NoExtCon instance Outputable (FieldOcc pass) where ppr = ppr . rdrNameFieldOcc mkFieldOcc :: Located RdrName -> FieldOcc GhcPs -mkFieldOcc rdr = FieldOcc noExt rdr +mkFieldOcc rdr = FieldOcc noExtField rdr -- | Ambiguous Field Occurrence @@ -1341,15 +1341,15 @@ data AmbiguousFieldOcc pass | Ambiguous (XAmbiguous pass) (Located RdrName) | XAmbiguousFieldOcc (XXAmbiguousFieldOcc pass) -type instance XUnambiguous GhcPs = NoExt +type instance XUnambiguous GhcPs = NoExtField type instance XUnambiguous GhcRn = Name type instance XUnambiguous GhcTc = Id -type instance XAmbiguous GhcPs = NoExt -type instance XAmbiguous GhcRn = NoExt +type instance XAmbiguous GhcPs = NoExtField +type instance XAmbiguous GhcRn = NoExtField type instance XAmbiguous GhcTc = Id -type instance XXAmbiguousFieldOcc (GhcPass _) = NoExt +type instance XXAmbiguousFieldOcc (GhcPass _) = NoExtCon instance p ~ GhcPass pass => Outputable (AmbiguousFieldOcc p) where ppr = ppr . rdrNameAmbiguousFieldOcc @@ -1359,28 +1359,28 @@ instance p ~ GhcPass pass => OutputableBndr (AmbiguousFieldOcc p) where pprPrefixOcc = pprPrefixOcc . rdrNameAmbiguousFieldOcc mkAmbiguousFieldOcc :: Located RdrName -> AmbiguousFieldOcc GhcPs -mkAmbiguousFieldOcc rdr = Unambiguous noExt rdr +mkAmbiguousFieldOcc rdr = Unambiguous noExtField rdr rdrNameAmbiguousFieldOcc :: AmbiguousFieldOcc (GhcPass p) -> RdrName rdrNameAmbiguousFieldOcc (Unambiguous _ (L _ rdr)) = rdr rdrNameAmbiguousFieldOcc (Ambiguous _ (L _ rdr)) = rdr -rdrNameAmbiguousFieldOcc (XAmbiguousFieldOcc _) - = panic "rdrNameAmbiguousFieldOcc" +rdrNameAmbiguousFieldOcc (XAmbiguousFieldOcc nec) + = noExtCon nec selectorAmbiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> Id selectorAmbiguousFieldOcc (Unambiguous sel _) = sel selectorAmbiguousFieldOcc (Ambiguous sel _) = sel -selectorAmbiguousFieldOcc (XAmbiguousFieldOcc _) - = panic "selectorAmbiguousFieldOcc" +selectorAmbiguousFieldOcc (XAmbiguousFieldOcc nec) + = noExtCon nec unambiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc unambiguousFieldOcc (Unambiguous rdr sel) = FieldOcc rdr sel unambiguousFieldOcc (Ambiguous rdr sel) = FieldOcc rdr sel -unambiguousFieldOcc (XAmbiguousFieldOcc _) = panic "unambiguousFieldOcc" +unambiguousFieldOcc (XAmbiguousFieldOcc nec) = noExtCon nec ambiguousFieldOcc :: FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc ambiguousFieldOcc (FieldOcc sel rdr) = Unambiguous sel rdr -ambiguousFieldOcc (XFieldOcc _) = panic "ambiguousFieldOcc" +ambiguousFieldOcc (XFieldOcc nec) = noExtCon nec {- ************************************************************************ @@ -1664,7 +1664,7 @@ lhsTypeHasLeadingPromotionQuote ty -- returns @ty@. parenthesizeHsType :: PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p) parenthesizeHsType p lty@(L loc ty) - | hsTypeNeedsParens p ty = L loc (HsParTy NoExt lty) + | hsTypeNeedsParens p ty = L loc (HsParTy noExtField lty) | otherwise = lty -- | @'parenthesizeHsContext' p ctxt@ checks if @ctxt@ is a single constraint diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index 531ff46ee4..93e7cf5f81 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -140,14 +140,14 @@ just attach noSrcSpan to everything. -} mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -mkHsPar e = cL (getLoc e) (HsPar noExt e) +mkHsPar e = cL (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 $ - Match { m_ext = noExt, m_ctxt = ctxt, m_pats = pats + Match { m_ext = noExtField, m_ctxt = ctxt, m_pats = pats , m_grhss = unguardedGRHSs rhs } where loc = case pats of @@ -157,16 +157,16 @@ mkSimpleMatch ctxt pats rhs unguardedGRHSs :: Located (body (GhcPass p)) -> GRHSs (GhcPass p) (Located (body (GhcPass p))) unguardedGRHSs rhs@(dL->L loc _) - = GRHSs noExt (unguardedRHS loc rhs) (noLoc emptyLocalBinds) + = 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 noExt [] rhs)] +unguardedRHS loc rhs = [cL loc (GRHS noExtField [] rhs)] -mkMatchGroup :: (XMG name (Located (body name)) ~ NoExt) +mkMatchGroup :: (XMG name (Located (body name)) ~ NoExtField) => Origin -> [LMatch name (Located (body name))] -> MatchGroup name (Located (body name)) -mkMatchGroup origin matches = MG { mg_ext = noExt +mkMatchGroup origin matches = MG { mg_ext = noExtField , mg_alts = mkLocatedList matches , mg_origin = origin } @@ -175,11 +175,11 @@ mkLocatedList [] = noLoc [] mkLocatedList ms = cL (combineLocs (head ms) (last ms)) ms mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExt e1 e2) +mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExtField e1 e2) mkHsAppType :: (NoGhcTc (GhcPass id) ~ GhcRn) => LHsExpr (GhcPass id) -> LHsWcType GhcRn -> LHsExpr (GhcPass id) -mkHsAppType e t = addCLoc e t_body (HsAppType noExt e paren_wct) +mkHsAppType e t = addCLoc e t_body (HsAppType noExtField e paren_wct) where t_body = hswc_body t paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body } @@ -187,9 +187,9 @@ mkHsAppType e t = addCLoc e t_body (HsAppType noExt e paren_wct) mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn mkHsAppTypes = foldl' mkHsAppType -mkHsLam :: (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExt) => +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 noExt matches)) +mkHsLam pats body = mkHsPar (cL (getLoc body) (HsLam noExtField matches)) where matches = mkMatchGroup Generated [mkSimpleMatch LambdaExpr pats' body] @@ -208,7 +208,7 @@ mkHsCaseAlt pat expr nlHsTyApp :: IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id) nlHsTyApp fun_id tys - = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExt (noLoc fun_id))) + = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExtField (noLoc fun_id))) nlHsTyApps :: IdP (GhcPass id) -> [Type] -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id) @@ -219,16 +219,16 @@ mkLHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -- Wrap in parens if (hsExprNeedsParens appPrec) says it needs them -- So 'f x' becomes '(f x)', but '3' stays as '3' mkLHsPar le@(dL->L loc e) - | hsExprNeedsParens appPrec e = cL loc (HsPar noExt le) + | hsExprNeedsParens appPrec e = cL 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 noExt lp) + | patNeedsParens appPrec p = cL loc (ParPat noExtField lp) | otherwise = lp nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name) -nlParPat p = noLoc (ParPat noExt p) +nlParPat p = noLoc (ParPat noExtField p) ------------------------------- -- These are the bits of syntax that contain rebindable names @@ -250,7 +250,7 @@ mkLastStmt :: Located (bodyR (GhcPass idR)) mkBodyStmt :: Located (bodyR GhcPs) -> StmtLR (GhcPass idL) GhcPs (Located (bodyR GhcPs)) mkBindStmt :: (XBindStmt (GhcPass idL) (GhcPass idR) - (Located (bodyR (GhcPass idR))) ~ NoExt) + (Located (bodyR (GhcPass idR))) ~ NoExtField) => LPat (GhcPass idL) -> Located (bodyR (GhcPass idR)) -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR))) mkTcBindStmt :: LPat GhcTc -> Located (bodyR GhcTc) @@ -263,26 +263,26 @@ mkRecStmt :: [LStmtLR (GhcPass idL) GhcPs bodyR] -> StmtLR (GhcPass idL) GhcPs bodyR -mkHsIntegral i = OverLit noExt (HsIntegral i) noExpr -mkHsFractional f = OverLit noExt (HsFractional f) noExpr -mkHsIsString src s = OverLit noExt (HsIsString src s) noExpr +mkHsIntegral i = OverLit noExtField (HsIntegral i) noExpr +mkHsFractional f = OverLit noExtField (HsFractional f) noExpr +mkHsIsString src s = OverLit noExtField (HsIsString src s) noExpr -mkHsDo ctxt stmts = HsDo noExt ctxt (mkLocatedList stmts) +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 mkHsIf :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> HsExpr (GhcPass p) -mkHsIf c a b = HsIf noExt (Just noSyntaxExpr) c a b +mkHsIf c a b = HsIf noExtField (Just noSyntaxExpr) c a b mkHsCmdIf :: LHsExpr (GhcPass p) -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p) -> HsCmd (GhcPass p) -mkHsCmdIf c a b = HsCmdIf noExt (Just noSyntaxExpr) c a b +mkHsCmdIf c a b = HsCmdIf noExtField (Just noSyntaxExpr) c a b -mkNPat lit neg = NPat noExt lit neg noSyntaxExpr +mkNPat lit neg = NPat noExtField lit neg noSyntaxExpr mkNPlusKPat id lit - = NPlusKPat noExt id lit (unLoc lit) noSyntaxExpr noSyntaxExpr + = NPlusKPat noExtField id lit (unLoc lit) noSyntaxExpr noSyntaxExpr mkTransformStmt :: [ExprLStmt GhcPs] -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) @@ -295,7 +295,7 @@ mkGroupByUsingStmt :: [ExprLStmt GhcPs] -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) emptyTransStmt :: StmtLR GhcPs GhcPs (LHsExpr GhcPs) -emptyTransStmt = TransStmt { trS_ext = noExt +emptyTransStmt = TransStmt { trS_ext = noExtField , trS_form = panic "emptyTransStmt: form" , trS_stmts = [], trS_bndrs = [] , trS_by = Nothing, trS_using = noLoc noExpr @@ -306,11 +306,11 @@ mkTransformByStmt ss u b = emptyTransStmt { trS_form = ThenForm, trS_stmts = s mkGroupUsingStmt ss u = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u } mkGroupByUsingStmt ss b u = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u, trS_by = Just b } -mkLastStmt body = LastStmt noExt body False noSyntaxExpr +mkLastStmt body = LastStmt noExtField body False noSyntaxExpr mkBodyStmt body - = BodyStmt noExt body noSyntaxExpr noSyntaxExpr + = BodyStmt noExtField body noSyntaxExpr noSyntaxExpr mkBindStmt pat body - = BindStmt noExt pat body noSyntaxExpr noSyntaxExpr + = BindStmt noExtField pat body noSyntaxExpr noSyntaxExpr mkTcBindStmt pat body = BindStmt unitTy pat body noSyntaxExpr noSyntaxExpr -- don't use placeHolderTypeTc above, because that panics during zonking @@ -332,8 +332,8 @@ unitRecStmtTc = RecStmtTc { recS_bind_ty = unitTy , recS_rec_rets = [] , recS_ret_ty = unitTy } -emptyRecStmt = emptyRecStmt' noExt -emptyRecStmtName = emptyRecStmt' noExt +emptyRecStmt = emptyRecStmt' noExtField +emptyRecStmtName = emptyRecStmt' noExtField emptyRecStmtId = emptyRecStmt' unitRecStmtTc -- a panic might trigger during zonking mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts } @@ -342,20 +342,20 @@ mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts } --- A useful function for building @OpApps@. The operator is always a -- variable, and we don't know the fixity yet. mkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs -mkHsOpApp e1 op e2 = OpApp noExt e1 (noLoc (HsVar noExt (noLoc op))) e2 +mkHsOpApp e1 op e2 = OpApp noExtField e1 (noLoc (HsVar noExtField (noLoc op))) e2 unqualSplice :: RdrName unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice")) mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs -mkUntypedSplice hasParen e = HsUntypedSplice noExt hasParen unqualSplice e +mkUntypedSplice hasParen e = HsUntypedSplice noExtField hasParen unqualSplice e mkTypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs -mkTypedSplice hasParen e = HsTypedSplice noExt hasParen unqualSplice e +mkTypedSplice hasParen e = HsTypedSplice noExtField hasParen unqualSplice e mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs mkHsQuasiQuote quoter span quote - = HsQuasiQuote noExt unqualSplice quoter span quote + = HsQuasiQuote noExtField unqualSplice quoter span quote unqualQuasiQuote :: RdrName unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote")) @@ -372,11 +372,11 @@ mkHsStringPrimLit fs = HsStringPrim NoSourceText (bytesFS fs) userHsLTyVarBndrs :: SrcSpan -> [Located (IdP (GhcPass p))] -> [LHsTyVarBndr (GhcPass p)] -- Caller sets location -userHsLTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt v) | v <- bndrs ] +userHsLTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExtField v) | v <- bndrs ] userHsTyVarBndrs :: SrcSpan -> [IdP (GhcPass p)] -> [LHsTyVarBndr (GhcPass p)] -- Caller sets location -userHsTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt (cL loc v)) +userHsTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExtField (cL loc v)) | v <- bndrs ] @@ -389,26 +389,26 @@ userHsTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt (cL loc v)) -} nlHsVar :: IdP (GhcPass id) -> LHsExpr (GhcPass id) -nlHsVar n = noLoc (HsVar noExt (noLoc n)) +nlHsVar n = noLoc (HsVar noExtField (noLoc n)) -- NB: Only for LHsExpr **Id** nlHsDataCon :: DataCon -> LHsExpr GhcTc -nlHsDataCon con = noLoc (HsConLikeOut noExt (RealDataCon con)) +nlHsDataCon con = noLoc (HsConLikeOut noExtField (RealDataCon con)) nlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p) -nlHsLit n = noLoc (HsLit noExt n) +nlHsLit n = noLoc (HsLit noExtField n) nlHsIntLit :: Integer -> LHsExpr (GhcPass p) -nlHsIntLit n = noLoc (HsLit noExt (HsInt noExt (mkIntegralLit n))) +nlHsIntLit n = noLoc (HsLit noExtField (HsInt noExtField (mkIntegralLit n))) nlVarPat :: IdP (GhcPass id) -> LPat (GhcPass id) -nlVarPat n = noLoc (VarPat noExt (noLoc n)) +nlVarPat n = noLoc (VarPat noExtField (noLoc n)) nlLitPat :: HsLit GhcPs -> LPat GhcPs -nlLitPat l = noLoc (LitPat noExt l) +nlLitPat l = noLoc (LitPat noExtField l) nlHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -nlHsApp f x = noLoc (HsApp noExt f (mkLHsPar x)) +nlHsApp f x = noLoc (HsApp noExtField f (mkLHsPar x)) nlHsSyntaxApps :: SyntaxExpr (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id) @@ -427,10 +427,10 @@ nlHsApps :: IdP (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id) nlHsApps f xs = foldl' nlHsApp (nlHsVar f) xs nlHsVarApps :: IdP (GhcPass id) -> [IdP (GhcPass id)] -> LHsExpr (GhcPass id) -nlHsVarApps f xs = noLoc (foldl' mk (HsVar noExt (noLoc f)) - (map ((HsVar noExt) . noLoc) xs)) +nlHsVarApps f xs = noLoc (foldl' mk (HsVar noExtField (noLoc f)) + (map ((HsVar noExtField) . noLoc) xs)) where - mk f a = HsApp noExt (noLoc f) (noLoc a) + mk f a = HsApp noExtField (noLoc f) (noLoc a) nlConVarPat :: RdrName -> [RdrName] -> LPat GhcPs nlConVarPat con vars = nlConPat con (map nlVarPat vars) @@ -460,10 +460,10 @@ nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con)) nlWildPat))) nlWildPat :: LPat GhcPs -nlWildPat = noLoc (WildPat noExt ) -- Pre-typechecking +nlWildPat = noLoc (WildPat noExtField ) -- Pre-typechecking nlWildPatName :: LPat GhcRn -nlWildPatName = noLoc (WildPat noExt ) -- Pre-typechecking +nlWildPatName = noLoc (WildPat noExtField ) -- Pre-typechecking nlHsDo :: HsStmtContext Name -> [LStmt GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs @@ -480,27 +480,27 @@ nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs nlList :: [LHsExpr GhcPs] -> LHsExpr GhcPs -nlHsLam match = noLoc (HsLam noExt (mkMatchGroup Generated [match])) -nlHsPar e = noLoc (HsPar noExt e) +nlHsLam match = noLoc (HsLam noExtField (mkMatchGroup Generated [match])) +nlHsPar e = noLoc (HsPar noExtField e) -- Note [Rebindable nlHsIf] -- nlHsIf should generate if-expressions which are NOT subject to -- RebindableSyntax, so the first field of HsIf is Nothing. (#12080) -nlHsIf cond true false = noLoc (HsIf noExt Nothing cond true false) +nlHsIf cond true false = noLoc (HsIf noExtField Nothing cond true false) nlHsCase expr matches - = noLoc (HsCase noExt expr (mkMatchGroup Generated matches)) -nlList exprs = noLoc (ExplicitList noExt Nothing exprs) + = noLoc (HsCase noExtField expr (mkMatchGroup Generated matches)) +nlList exprs = noLoc (ExplicitList noExtField Nothing exprs) nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) nlHsTyVar :: IdP (GhcPass p) -> LHsType (GhcPass p) nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) nlHsParTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -nlHsAppTy f t = noLoc (HsAppTy noExt f (parenthesizeHsType appPrec t)) -nlHsTyVar x = noLoc (HsTyVar noExt NotPromoted (noLoc x)) -nlHsFunTy a b = noLoc (HsFunTy noExt (parenthesizeHsType funPrec a) b) -nlHsParTy t = noLoc (HsParTy noExt t) +nlHsAppTy f t = noLoc (HsAppTy noExtField f (parenthesizeHsType appPrec t)) +nlHsTyVar x = noLoc (HsTyVar noExtField NotPromoted (noLoc x)) +nlHsFunTy a b = noLoc (HsFunTy noExtField (parenthesizeHsType funPrec a) b) +nlHsParTy t = noLoc (HsParTy noExtField t) nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p) nlHsTyConApp tycon tys = foldl' nlHsAppTy (nlHsTyVar tycon) tys @@ -519,21 +519,21 @@ mkLHsTupleExpr :: [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a) -- Makes a pre-typechecker boxed tuple, deals with 1 case mkLHsTupleExpr [e] = e mkLHsTupleExpr es - = noLoc $ ExplicitTuple noExt (map (noLoc . (Present noExt)) es) Boxed + = noLoc $ ExplicitTuple noExtField (map (noLoc . (Present noExtField)) es) Boxed mkLHsVarTuple :: [IdP (GhcPass a)] -> LHsExpr (GhcPass a) mkLHsVarTuple ids = mkLHsTupleExpr (map nlHsVar ids) nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs -nlTuplePat pats box = noLoc (TuplePat noExt pats box) +nlTuplePat pats box = noLoc (TuplePat noExtField pats box) missingTupArg :: HsTupArg GhcPs -missingTupArg = Missing noExt +missingTupArg = Missing noExtField mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn -mkLHsPatTup [] = noLoc $ TuplePat noExt [] Boxed +mkLHsPatTup [] = noLoc $ TuplePat noExtField [] Boxed mkLHsPatTup [lpat] = lpat -mkLHsPatTup lpats = cL (getLoc (head lpats)) $ TuplePat noExt lpats Boxed +mkLHsPatTup lpats = cL (getLoc (head lpats)) $ TuplePat noExtField lpats Boxed -- The Big equivalents for the source tuple expressions mkBigLHsVarTup :: [IdP (GhcPass id)] -> LHsExpr (GhcPass id) @@ -637,7 +637,7 @@ mkClassOpSigs sigs = map fiddle sigs where fiddle (dL->L loc (TypeSig _ nms ty)) - = cL loc (ClassOpSig noExt False nms (dropWildCards ty)) + = cL loc (ClassOpSig noExtField False nms (dropWildCards ty)) fiddle sig = sig typeToLHsType :: Type -> LHsType GhcPs @@ -655,25 +655,25 @@ typeToLHsType ty VisArg -> nlHsFunTy (go arg) (go res) InvisArg | (theta, tau) <- tcSplitPhiTy ty -> noLoc (HsQualTy { hst_ctxt = noLoc (map go theta) - , hst_xqual = noExt + , hst_xqual = noExtField , hst_body = go tau }) go ty@(ForAllTy (Bndr _ argf) _) | (tvs, tau) <- tcSplitForAllTysSameVis argf ty = noLoc (HsForAllTy { hst_fvf = argToForallVisFlag argf , hst_bndrs = map go_tv tvs - , hst_xforall = noExt + , hst_xforall = noExtField , hst_body = go tau }) go (TyVarTy tv) = nlHsTyVar (getRdrName tv) go (LitTy (NumTyLit n)) - = noLoc $ HsTyLit NoExt (HsNumTy NoSourceText n) + = noLoc $ HsTyLit noExtField (HsNumTy NoSourceText n) go (LitTy (StrTyLit s)) - = noLoc $ HsTyLit NoExt (HsStrTy NoSourceText s) + = noLoc $ HsTyLit noExtField (HsStrTy NoSourceText s) go ty@(TyConApp tc args) | tyConAppNeedsKindSig True tc (length args) -- We must produce an explicit kind signature here to make certain -- programs kind-check. See Note [Kind signatures in typeToLHsType]. - = nlHsParTy $ noLoc $ HsKindSig NoExt ty' (go (tcTypeKind ty)) + = nlHsParTy $ noLoc $ HsKindSig noExtField ty' (go (tcTypeKind ty)) | otherwise = ty' where ty' :: LHsType GhcPs @@ -703,7 +703,7 @@ typeToLHsType ty head (zip args arg_flags) go_tv :: TyVar -> LHsTyVarBndr GhcPs - go_tv tv = noLoc $ KindedTyVar noExt (noLoc (getRdrName tv)) + go_tv tv = noLoc $ KindedTyVar noExtField (noLoc (getRdrName tv)) (go (tyVarKind tv)) {- @@ -762,7 +762,7 @@ mkLHsWrap co_fn (dL->L loc e) = cL loc (mkHsWrap co_fn e) mkHsWrap :: HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id) mkHsWrap co_fn e | isIdHsWrapper co_fn = e mkHsWrap co_fn (HsWrap _ co_fn' e) = mkHsWrap (co_fn <.> co_fn') e -mkHsWrap co_fn e = HsWrap noExt co_fn e +mkHsWrap co_fn e = HsWrap noExtField co_fn e mkHsWrapCo :: TcCoercionN -- A Nominal coercion a ~N b -> HsExpr (GhcPass id) -> HsExpr (GhcPass id) @@ -777,18 +777,18 @@ mkLHsWrapCo co (dL->L loc e) = cL loc (mkHsWrapCo co e) mkHsCmdWrap :: HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p) mkHsCmdWrap w cmd | isIdHsWrapper w = cmd - | otherwise = HsCmdWrap noExt 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) mkHsWrapPat :: HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id) mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p - | otherwise = CoPat noExt co_fn p ty + | otherwise = CoPat noExtField co_fn p ty mkHsWrapPatCo :: TcCoercionN -> Pat (GhcPass id) -> Type -> Pat (GhcPass id) mkHsWrapPatCo co pat ty | isTcReflCo co = pat - | otherwise = CoPat noExt (mkWpCastN co) pat ty + | otherwise = CoPat noExtField (mkWpCastN co) pat ty mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr @@ -808,7 +808,7 @@ mkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] mkFunBind fn ms = FunBind { fun_id = fn , fun_matches = mkMatchGroup Generated ms , fun_co_fn = idHsWrapper - , fun_ext = noExt + , fun_ext = noExtField , fun_tick = [] } mkTopFunBind :: Origin -> Located Name -> [LMatch GhcRn (LHsExpr GhcRn)] @@ -826,14 +826,14 @@ mkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs mkVarBind :: IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p) mkVarBind var rhs = cL (getLoc rhs) $ - VarBind { var_ext = noExt, + VarBind { var_ext = noExtField, var_id = var, var_rhs = rhs, var_inline = False } mkPatSynBind :: Located RdrName -> HsPatSynDetails (Located RdrName) -> LPat GhcPs -> HsPatSynDir GhcPs -> HsBind GhcPs -mkPatSynBind name details lpat dir = PatSynBind noExt psb +mkPatSynBind name details lpat dir = PatSynBind noExtField psb where - psb = PSB{ psb_ext = noExt + psb = PSB{ psb_ext = noExtField , psb_id = name , psb_args = details , psb_def = lpat @@ -867,13 +867,13 @@ mkMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p))) -> Located (HsLocalBinds (GhcPass p)) -> LMatch (GhcPass p) (LHsExpr (GhcPass p)) mkMatch ctxt pats expr lbinds - = noLoc (Match { m_ext = noExt + = noLoc (Match { m_ext = noExtField , m_ctxt = ctxt , m_pats = map paren pats - , m_grhss = GRHSs noExt (unguardedRHS noSrcSpan expr) lbinds }) + , m_grhss = GRHSs noExtField (unguardedRHS noSrcSpan expr) lbinds }) where paren lp@(dL->L l p) - | patNeedsParens appPrec p = cL l (ParPat noExt lp) + | patNeedsParens appPrec p = cL l (ParPat noExtField lp) | otherwise = lp {- @@ -1054,7 +1054,7 @@ collectStmtBinders (ApplicativeStmt _ args _) = concatMap collectArgBinders args collectArgBinders (_, ApplicativeArgOne _ pat _ _) = collectPatBinders pat collectArgBinders (_, ApplicativeArgMany _ _ _ pat) = collectPatBinders pat collectArgBinders _ = [] -collectStmtBinders XStmtLR{} = panic "collectStmtBinders" +collectStmtBinders (XStmtLR nec) = noExtCon nec ----------------- Patterns -------------------------- @@ -1130,7 +1130,7 @@ hsGroupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls, hs_fords = foreign_decls }) = collectHsValBinders val_decls ++ hsTyClForeignBinders tycl_decls foreign_decls -hsGroupBinders (XHsGroup {}) = panic "hsGroupBinders" +hsGroupBinders (XHsGroup nec) = noExtCon nec hsTyClForeignBinders :: [TyClGroup GhcRn] -> [LForeignDecl GhcRn] @@ -1148,8 +1148,8 @@ hsTyClForeignBinders tycl_decls foreign_decls getSelectorNames (ns, fs) = map unLoc ns ++ map (extFieldOcc . unLoc) fs ------------------- -hsLTyClDeclBinders :: Located (TyClDecl pass) - -> ([Located (IdP pass)], [LFieldOcc pass]) +hsLTyClDeclBinders :: Located (TyClDecl (GhcPass p)) + -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)]) -- ^ Returns all the /binding/ names of the decl. The first one is -- guaranteed to be the name of the decl. The first component -- represents all binding names except record fields; the second @@ -1162,8 +1162,8 @@ hsLTyClDeclBinders :: Located (TyClDecl pass) hsLTyClDeclBinders (dL->L loc (FamDecl { tcdFam = FamilyDecl { fdLName = (dL->L _ name) } })) = ([cL loc name], []) -hsLTyClDeclBinders (dL->L _ (FamDecl { tcdFam = XFamilyDecl _ })) - = panic "hsLTyClDeclBinders" +hsLTyClDeclBinders (dL->L _ (FamDecl { tcdFam = XFamilyDecl nec })) + = noExtCon nec hsLTyClDeclBinders (dL->L loc (SynDecl { tcdLName = (dL->L _ name) })) = ([cL loc name], []) @@ -1181,7 +1181,7 @@ hsLTyClDeclBinders (dL->L loc (ClassDecl hsLTyClDeclBinders (dL->L loc (DataDecl { tcdLName = (dL->L _ name) , tcdDataDefn = defn })) = (\ (xs, ys) -> (cL loc name : xs, ys)) $ hsDataDefnBinders defn -hsLTyClDeclBinders (dL->L _ (XTyClDecl _)) = panic "hsLTyClDeclBinders" +hsLTyClDeclBinders (dL->L _ (XTyClDecl nec)) = noExtCon nec hsLTyClDeclBinders _ = panic "hsLTyClDeclBinders: Impossible Match" -- due to #15884 @@ -1224,48 +1224,50 @@ hsLInstDeclBinders (dL->L _ (ClsInstD hsLInstDeclBinders (dL->L _ (DataFamInstD { dfid_inst = fi })) = hsDataFamInstBinders fi hsLInstDeclBinders (dL->L _ (TyFamInstD {})) = mempty -hsLInstDeclBinders (dL->L _ (ClsInstD _ (XClsInstDecl {}))) - = panic "hsLInstDeclBinders" -hsLInstDeclBinders (dL->L _ (XInstDecl _)) - = panic "hsLInstDeclBinders" +hsLInstDeclBinders (dL->L _ (ClsInstD _ (XClsInstDecl nec))) + = noExtCon nec +hsLInstDeclBinders (dL->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 -hsDataFamInstBinders :: DataFamInstDecl pass - -> ([Located (IdP pass)], [LFieldOcc pass]) +hsDataFamInstBinders :: DataFamInstDecl (GhcPass p) + -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)]) hsDataFamInstBinders (DataFamInstDecl { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = defn }}}) = hsDataDefnBinders defn -- There can't be repeated symbols because only data instances have binders hsDataFamInstBinders (DataFamInstDecl - { dfid_eqn = HsIB { hsib_body = XFamEqn _}}) - = panic "hsDataFamInstBinders" -hsDataFamInstBinders (DataFamInstDecl (XHsImplicitBndrs _)) - = panic "hsDataFamInstBinders" + { dfid_eqn = HsIB { hsib_body = XFamEqn nec}}) + = noExtCon nec +hsDataFamInstBinders (DataFamInstDecl (XHsImplicitBndrs nec)) + = noExtCon nec ------------------- -- the SrcLoc returned are for the whole declarations, not just the names -hsDataDefnBinders :: HsDataDefn pass -> ([Located (IdP pass)], [LFieldOcc pass]) +hsDataDefnBinders :: HsDataDefn (GhcPass p) + -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)]) hsDataDefnBinders (HsDataDefn { dd_cons = cons }) = hsConDeclsBinders cons -- See Note [Binders in family instances] -hsDataDefnBinders (XHsDataDefn _) = panic "hsDataDefnBinders" +hsDataDefnBinders (XHsDataDefn nec) = noExtCon nec ------------------- -type Seen pass = [LFieldOcc pass] -> [LFieldOcc pass] +type Seen p = [LFieldOcc (GhcPass p)] -> [LFieldOcc (GhcPass p)] -- Filters out ones that have already been seen -hsConDeclsBinders :: [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass]) +hsConDeclsBinders :: [LConDecl (GhcPass p)] + -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)]) -- See hsLTyClDeclBinders for what this does -- The function is boringly complicated because of the records -- And since we only have equality, we have to be a little careful hsConDeclsBinders cons = go id cons where - go :: Seen pass -> [LConDecl pass] - -> ([Located (IdP pass)], [LFieldOcc pass]) + go :: Seen p -> [LConDecl (GhcPass p)] + -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)]) go _ [] = ([], []) go remSeen (r:rs) -- Don't re-mangle the location of field names, because we don't @@ -1286,10 +1288,10 @@ hsConDeclsBinders cons (remSeen', flds) = get_flds remSeen args (ns, fs) = go remSeen' rs - XConDecl _ -> panic "hsConDeclsBinders" + XConDecl nec -> noExtCon nec - get_flds :: Seen pass -> HsConDeclDetails pass - -> (Seen pass, [LFieldOcc pass]) + get_flds :: Seen p -> HsConDeclDetails (GhcPass p) + -> (Seen p, [LFieldOcc (GhcPass p)]) get_flds remSeen (RecCon flds) = (remSeen', fld_names) where @@ -1355,7 +1357,7 @@ lStmtsImplicits = hs_lstmts hs_stmt (ApplicativeStmt _ args _) = concatMap do_arg args where do_arg (_, ApplicativeArgOne _ pat _ _) = lPatImplicits pat do_arg (_, ApplicativeArgMany _ stmts _ _) = hs_lstmts stmts - do_arg (_, XApplicativeArg _) = panic "lStmtsImplicits" + do_arg (_, XApplicativeArg nec) = noExtCon nec hs_stmt (LetStmt _ binds) = hs_local_binds (unLoc binds) hs_stmt (BodyStmt {}) = [] hs_stmt (LastStmt {}) = [] @@ -1363,7 +1365,7 @@ lStmtsImplicits = hs_lstmts , s <- ss] hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts hs_stmt (RecStmt { recS_stmts = ss }) = hs_lstmts ss - hs_stmt (XStmtLR {}) = panic "lStmtsImplicits" + hs_stmt (XStmtLR nec) = noExtCon nec hs_local_binds (HsValBinds _ val_binds) = hsValBindsImplicits val_binds hs_local_binds (HsIPBinds {}) = [] diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index d5b3f90737..c7557922bc 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -127,7 +127,7 @@ mkPrelImports this_mod loc implicit_prelude import_decls preludeImportDecl :: LImportDecl GhcPs preludeImportDecl - = cL loc $ ImportDecl { ideclExt = noExt, + = cL loc $ ImportDecl { ideclExt = noExtField, ideclSourceSrc = NoSourceText, ideclName = cL loc pRELUDE_NAME, ideclPkgQual = Nothing, diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index aa29554e9d..aaf9a3c285 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -965,11 +965,13 @@ hscCheckSafeImports tcg_env = do -> return tcg_env' warns dflags rules = listToBag $ map (warnRules dflags) rules + + warnRules :: DynFlags -> GenLocated SrcSpan (RuleDecl GhcTc) -> ErrMsg warnRules dflags (L loc (HsRule { rd_name = n })) = mkPlainWarnMsg dflags loc $ text "Rule \"" <> ftext (snd $ unLoc n) <> text "\" ignored" $+$ text "User defined rules are disabled under Safe Haskell" - warnRules _ (L _ (XRuleDecl _)) = panic "hscCheckSafeImports" + warnRules _ (L _ (XRuleDecl nec)) = noExtCon nec -- | Validate that safe imported modules are actually safe. For modules in the -- HomePackage (the package the module we are compiling in resides) this just diff --git a/compiler/main/HscStats.hs b/compiler/main/HscStats.hs index fdd5ee78e2..df77ae41a4 100644 --- a/compiler/main/HscStats.hs +++ b/compiler/main/HscStats.hs @@ -122,7 +122,7 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _)) import_info (dL->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 _)) = panic "import_info" + import_info (dL->L _ (XImportDecl nec)) = noExtCon nec import_info _ = panic " import_info: Impossible Match" -- due to #15884 @@ -163,8 +163,8 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _)) ss, is, length ats, length adts) where methods = map unLoc $ bagToList inst_meths - inst_info (ClsInstD _ (XClsInstDecl _)) = panic "inst_info" - inst_info (XInstDecl _) = panic "inst_info" + inst_info (ClsInstD _ (XClsInstDecl nec)) = noExtCon nec + inst_info (XInstDecl nec) = noExtCon nec -- TODO: use Sum monoid addpr :: (Int,Int,Int) -> Int diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 091efb37fd..b2c644e65c 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -1138,8 +1138,8 @@ compileParsedExprRemote expr@(L loc _) = withSession $ \hsc_env -> do -- create a new binding. let expr_fs = fsLit "_compileParsedExpr" expr_name = mkInternalName (getUnique expr_fs) (mkTyVarOccFS expr_fs) loc - let_stmt = L loc . LetStmt noExt . L loc . (HsValBinds noExt) $ - ValBinds noExt + let_stmt = L loc . LetStmt noExtField . L loc . (HsValBinds noExtField) $ + ValBinds noExtField (unitBag $ mkHsVarBind loc (getRdrName expr_name) expr) [] pstmt <- liftIO $ hscParsedStmt hsc_env let_stmt @@ -1167,7 +1167,7 @@ dynCompileExpr expr = do parsed_expr <- parseExpr expr -- > Data.Dynamic.toDyn expr let loc = getLoc parsed_expr - to_dyn_expr = mkHsApp (L loc . HsVar noExt . L loc $ getRdrName toDynName) + to_dyn_expr = mkHsApp (L loc . HsVar noExtField . L loc $ getRdrName toDynName) parsed_expr hval <- compileParsedExpr to_dyn_expr return (unsafeCoerce# hval :: Dynamic) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 087474f9af..774b32f0ab 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -869,9 +869,9 @@ expdoclist :: { OrdList (LIE GhcPs) } | {- empty -} { nilOL } exp_doc :: { OrdList (LIE GhcPs) } - : docsection { unitOL (sL1 $1 (case (unLoc $1) of (n, doc) -> IEGroup noExt n doc)) } - | docnamed { unitOL (sL1 $1 (IEDocNamed noExt ((fst . unLoc) $1))) } - | docnext { unitOL (sL1 $1 (IEDoc noExt (unLoc $1))) } + : docsection { unitOL (sL1 $1 (case (unLoc $1) of (n, doc) -> IEGroup noExtField n doc)) } + | docnamed { unitOL (sL1 $1 (IEDocNamed noExtField ((fst . unLoc) $1))) } + | docnext { unitOL (sL1 $1 (IEDoc noExtField (unLoc $1))) } -- No longer allow things like [] and (,,,) to be exported @@ -879,9 +879,9 @@ exp_doc :: { OrdList (LIE GhcPs) } export :: { OrdList (LIE GhcPs) } : qcname_ext export_subspec {% mkModuleImpExp $1 (snd $ unLoc $2) >>= \ie -> amsu (sLL $1 $> ie) (fst $ unLoc $2) } - | 'module' modid {% amsu (sLL $1 $> (IEModuleContents noExt $2)) + | 'module' modid {% amsu (sLL $1 $> (IEModuleContents noExtField $2)) [mj AnnModule $1] } - | 'pattern' qcon {% amsu (sLL $1 $> (IEVar noExt (sLL $1 $> (IEPattern $2)))) + | 'pattern' qcon {% amsu (sLL $1 $> (IEVar noExtField (sLL $1 $> (IEPattern $2)))) [mj AnnPattern $1] } export_subspec :: { Located ([AddAnn],ImpExpSubSpec) } @@ -960,7 +960,7 @@ importdecl :: { LImportDecl GhcPs } {% do { ; checkImportDecl $4 $7 ; ams (cL (comb4 $1 $6 (snd $8) $9) $ - ImportDecl { ideclExt = noExt + ImportDecl { ideclExt = noExtField , ideclSourceSrc = snd $ fst $2 , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 @@ -1047,21 +1047,21 @@ topdecls_semi :: { OrdList (LHsDecl GhcPs) } | {- empty -} { nilOL } topdecl :: { LHsDecl GhcPs } - : cl_decl { sL1 $1 (TyClD noExt (unLoc $1)) } - | ty_decl { sL1 $1 (TyClD noExt (unLoc $1)) } - | inst_decl { sL1 $1 (InstD noExt (unLoc $1)) } - | stand_alone_deriving { sLL $1 $> (DerivD noExt (unLoc $1)) } - | role_annot { sL1 $1 (RoleAnnotD noExt (unLoc $1)) } - | 'default' '(' comma_types0 ')' {% ams (sLL $1 $> (DefD noExt (DefaultDecl noExt $3))) + : cl_decl { sL1 $1 (TyClD noExtField (unLoc $1)) } + | ty_decl { sL1 $1 (TyClD noExtField (unLoc $1)) } + | inst_decl { sL1 $1 (InstD noExtField (unLoc $1)) } + | stand_alone_deriving { sLL $1 $> (DerivD noExtField (unLoc $1)) } + | role_annot { sL1 $1 (RoleAnnotD noExtField (unLoc $1)) } + | 'default' '(' comma_types0 ')' {% ams (sLL $1 $> (DefD noExtField (DefaultDecl noExtField $3))) [mj AnnDefault $1 ,mop $2,mcp $4] } | 'foreign' fdecl {% ams (sLL $1 $> (snd $ unLoc $2)) (mj AnnForeign $1:(fst $ unLoc $2)) } - | '{-# DEPRECATED' deprecations '#-}' {% ams (sLL $1 $> $ WarningD noExt (Warnings noExt (getDEPRECATED_PRAGs $1) (fromOL $2))) + | '{-# DEPRECATED' deprecations '#-}' {% ams (sLL $1 $> $ WarningD noExtField (Warnings noExtField (getDEPRECATED_PRAGs $1) (fromOL $2))) [mo $1,mc $3] } - | '{-# WARNING' warnings '#-}' {% ams (sLL $1 $> $ WarningD noExt (Warnings noExt (getWARNING_PRAGs $1) (fromOL $2))) + | '{-# WARNING' warnings '#-}' {% ams (sLL $1 $> $ WarningD noExtField (Warnings noExtField (getWARNING_PRAGs $1) (fromOL $2))) [mo $1,mc $3] } - | '{-# RULES' rules '#-}' {% ams (sLL $1 $> $ RuleD noExt (HsRules noExt (getRULES_PRAGs $1) (fromOL $2))) + | '{-# RULES' rules '#-}' {% ams (sLL $1 $> $ RuleD noExtField (HsRules noExtField (getRULES_PRAGs $1) (fromOL $2))) [mo $1,mc $3] } | annotation { $1 } | decl_no_th { $1 } @@ -1134,13 +1134,13 @@ ty_decl :: { LTyClDecl GhcPs } inst_decl :: { LInstDecl GhcPs } : 'instance' overlap_pragma inst_type where_inst {% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $4) - ; let cid = ClsInstDecl { cid_ext = noExt + ; let cid = ClsInstDecl { cid_ext = noExtField , cid_poly_ty = $3, cid_binds = binds , cid_sigs = mkClassOpSigs sigs , cid_tyfam_insts = ats , cid_overlap_mode = $2 , cid_datafam_insts = adts } - ; ams (cL (comb3 $1 (hsSigType $3) $4) (ClsInstD { cid_d_ext = noExt, cid_inst = cid })) + ; ams (cL (comb3 $1 (hsSigType $3) $4) (ClsInstD { cid_d_ext = noExtField, cid_inst = cid })) (mj AnnInstance $1 : (fst $ unLoc $4)) } } -- type instance declarations @@ -1362,22 +1362,22 @@ opt_kind_sig :: { Located ([AddAnn], Maybe (LHsKind GhcPs)) } | '::' kind { sLL $1 $> ([mu AnnDcolon $1], Just $2) } opt_datafam_kind_sig :: { Located ([AddAnn], LFamilyResultSig GhcPs) } - : { noLoc ([] , noLoc (NoSig noExt) )} - | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig noExt $2))} + : { noLoc ([] , noLoc (NoSig noExtField) )} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig noExtField $2))} opt_tyfam_kind_sig :: { Located ([AddAnn], LFamilyResultSig GhcPs) } - : { noLoc ([] , noLoc (NoSig noExt) )} - | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig noExt $2))} - | '=' tv_bndr { sLL $1 $> ([mj AnnEqual $1] , sLL $1 $> (TyVarSig noExt $2))} + : { noLoc ([] , noLoc (NoSig noExtField) )} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig noExtField $2))} + | '=' tv_bndr { sLL $1 $> ([mj AnnEqual $1] , sLL $1 $> (TyVarSig noExtField $2))} opt_at_kind_inj_sig :: { Located ([AddAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} - : { noLoc ([], (noLoc (NoSig noExt), Nothing)) } + : { noLoc ([], (noLoc (NoSig noExtField), Nothing)) } | '::' kind { sLL $1 $> ( [mu AnnDcolon $1] - , (sLL $2 $> (KindSig noExt $2), Nothing)) } + , (sLL $2 $> (KindSig noExtField $2), Nothing)) } | '=' tv_bndr '|' injectivity_cond { sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] - , (sLL $1 $2 (TyVarSig noExt $2), Just $4))} + , (sLL $1 $2 (TyVarSig noExtField $2), Just $4))} -- tycl_hdr parses the header of a class or data type decl, -- which takes the form @@ -1430,7 +1430,7 @@ stand_alone_deriving :: { LDerivDecl GhcPs } {% do { let { err = text "in the stand-alone deriving instance" <> colon <+> quotes (ppr $5) } ; ams (sLL $1 (hsSigType $>) - (DerivDecl noExt (mkHsWildCardBndrs $5) $2 $4)) + (DerivDecl noExtField (mkHsWildCardBndrs $5) $2 $4)) [mj AnnDeriving $1, mj AnnInstance $3] } } ----------------------------------------------------------------------------- @@ -1461,20 +1461,20 @@ role : VARID { sL1 $1 $ Just $ getVARID $1 } pattern_synonym_decl :: { LHsDecl GhcPs } : 'pattern' pattern_synonym_lhs '=' pat {% let (name, args,as ) = $2 in - ams (sLL $1 $> . ValD noExt $ mkPatSynBind name args $4 + ams (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 ImplicitBidirectional) (as ++ [mj AnnPattern $1, mj AnnEqual $3]) } | 'pattern' pattern_synonym_lhs '<-' pat {% let (name, args, as) = $2 in - ams (sLL $1 $> . ValD noExt $ mkPatSynBind name args $4 Unidirectional) + ams (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 Unidirectional) (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) } | 'pattern' pattern_synonym_lhs '<-' pat where_decls {% do { let (name, args, as) = $2 ; mg <- mkPatSynMatchGroup name (snd $ unLoc $5) - ; ams (sLL $1 $> . ValD noExt $ + ; ams (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 (ExplicitBidirectional mg)) (as ++ ((mj AnnPattern $1:mu AnnLarrow $3:(fst $ unLoc $5))) ) }} @@ -1502,7 +1502,7 @@ where_decls :: { Located ([AddAnn] pattern_synonym_sig :: { LSig GhcPs } : 'pattern' con_list '::' sigtypedoc - {% ams (sLL $1 $> $ PatSynSig noExt (unLoc $2) (mkLHsSigType $4)) + {% ams (sLL $1 $> $ PatSynSig noExtField (unLoc $2) (mkLHsSigType $4)) [mj AnnPattern $1, mu AnnDcolon $3] } ----------------------------------------------------------------------------- @@ -1520,7 +1520,7 @@ decl_cls : at_decl_cls { $1 } do { v <- checkValSigLhs $2 ; let err = text "in default signature" <> colon <+> quotes (ppr $2) - ; ams (sLL $1 $> $ SigD noExt $ ClassOpSig noExt True [v] $ mkLHsSigType $4) + ; ams (sLL $1 $> $ SigD noExtField $ ClassOpSig noExtField True [v] $ mkLHsSigType $4) [mj AnnDefault $1,mu AnnDcolon $3] } } decls_cls :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) } -- Reversed @@ -1558,7 +1558,7 @@ where_cls :: { Located ([AddAnn] -- Declarations in instance bodies -- decl_inst :: { Located (OrdList (LHsDecl GhcPs)) } -decl_inst : at_decl_inst { sLL $1 $> (unitOL (sL1 $1 (InstD noExt (unLoc $1)))) } +decl_inst : at_decl_inst { sLL $1 $> (unitOL (sL1 $1 (InstD noExtField (unLoc $1)))) } | decl { sLL $1 $> (unitOL $1) } decls_inst :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) } -- Reversed @@ -1626,13 +1626,13 @@ binds :: { Located ([AddAnn],Located (HsLocalBinds GhcPs)) } -- No type declarations : decllist {% do { val_binds <- cvBindGroup (unLoc $ snd $ unLoc $1) ; return (sL1 $1 (fst $ unLoc $1 - ,sL1 $1 $ HsValBinds noExt val_binds)) } } + ,sL1 $1 $ HsValBinds noExtField val_binds)) } } | '{' dbinds '}' { sLL $1 $> ([moc $1,mcc $3] - ,sL1 $2 $ HsIPBinds noExt (IPBinds noExt (reverse $ unLoc $2))) } + ,sL1 $2 $ HsIPBinds noExtField (IPBinds noExtField (reverse $ unLoc $2))) } | vocurly dbinds close { cL (getLoc $2) ([] - ,sL1 $2 $ HsIPBinds noExt (IPBinds noExt (reverse $ unLoc $2))) } + ,sL1 $2 $ HsIPBinds noExtField (IPBinds noExtField (reverse $ unLoc $2))) } wherebinds :: { Located ([AddAnn],Located (HsLocalBinds GhcPs)) } @@ -1658,7 +1658,7 @@ rule :: { LRuleDecl GhcPs } : STRING rule_activation rule_foralls infixexp '=' exp {%runECP_P $4 >>= \ $4 -> runECP_P $6 >>= \ $6 -> - ams (sLL $1 $> $ HsRule { rd_ext = noExt + ams (sLL $1 $> $ HsRule { rd_ext = noExtField , rd_name = cL (gl $1) (getSTRINGs $1, getSTRING $1) , rd_act = (snd $2) `orElse` AlwaysActive , rd_tyvs = sndOf3 $3, rd_tmvs = thdOf3 $3 @@ -1735,7 +1735,7 @@ warnings :: { OrdList (LWarnDecl GhcPs) } -- SUP: TEMPORARY HACK, not checking for `module Foo' warning :: { OrdList (LWarnDecl GhcPs) } : namelist strings - {% amsu (sLL $1 $> (Warning noExt (unLoc $1) (WarningTxt (noLoc NoSourceText) $ snd $ unLoc $2))) + {% amsu (sLL $1 $> (Warning noExtField (unLoc $1) (WarningTxt (noLoc NoSourceText) $ snd $ unLoc $2))) (fst $ unLoc $2) } deprecations :: { OrdList (LWarnDecl GhcPs) } @@ -1750,7 +1750,7 @@ deprecations :: { OrdList (LWarnDecl GhcPs) } -- SUP: TEMPORARY HACK, not checking for `module Foo' deprecation :: { OrdList (LWarnDecl GhcPs) } : namelist strings - {% amsu (sLL $1 $> $ (Warning noExt (unLoc $1) (DeprecatedTxt (noLoc NoSourceText) $ snd $ unLoc $2))) + {% amsu (sLL $1 $> $ (Warning noExtField (unLoc $1) (DeprecatedTxt (noLoc NoSourceText) $ snd $ unLoc $2))) (fst $ unLoc $2) } strings :: { Located ([AddAnn],[Located StringLiteral]) } @@ -1768,19 +1768,19 @@ stringlist :: { Located (OrdList (Located StringLiteral)) } -- Annotations annotation :: { LHsDecl GhcPs } : '{-# ANN' name_var aexp '#-}' {% runECP_P $3 >>= \ $3 -> - ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt + ams (sLL $1 $> (AnnD noExtField $ HsAnnotation noExtField (getANN_PRAGs $1) (ValueAnnProvenance $2) $3)) [mo $1,mc $4] } | '{-# ANN' 'type' tycon aexp '#-}' {% runECP_P $4 >>= \ $4 -> - ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt + ams (sLL $1 $> (AnnD noExtField $ HsAnnotation noExtField (getANN_PRAGs $1) (TypeAnnProvenance $3) $4)) [mo $1,mj AnnType $2,mc $5] } | '{-# ANN' 'module' aexp '#-}' {% runECP_P $3 >>= \ $3 -> - ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt + ams (sLL $1 $> (AnnD noExtField $ HsAnnotation noExtField (getANN_PRAGs $1) ModuleAnnProvenance $3)) [mo $1,mj AnnModule $2,mc $4] } @@ -1866,12 +1866,12 @@ forall_vis_flag :: { (AddAnn, ForallVisFlag) } -- A ktype/ktypedoc is a ctype/ctypedoc, possibly with a kind annotation ktype :: { LHsType GhcPs } : ctype { $1 } - | ctype '::' kind {% ams (sLL $1 $> $ HsKindSig noExt $1 $3) + | ctype '::' kind {% ams (sLL $1 $> $ HsKindSig noExtField $1 $3) [mu AnnDcolon $2] } ktypedoc :: { LHsType GhcPs } : ctypedoc { $1 } - | ctypedoc '::' kind {% ams (sLL $1 $> $ HsKindSig noExt $1 $3) + | ctypedoc '::' kind {% ams (sLL $1 $> $ HsKindSig noExtField $1 $3) [mu AnnDcolon $2] } -- A ctype is a for-all type @@ -1882,15 +1882,15 @@ ctype :: { LHsType GhcPs } ams (sLL $1 $> $ HsForAllTy { hst_fvf = fv_flag , hst_bndrs = $2 - , hst_xforall = noExt + , hst_xforall = noExtField , hst_body = $4 }) [mu AnnForall $1,fv_ann] } | context '=>' ctype {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2) >> return (sLL $1 $> $ HsQualTy { hst_ctxt = $1 - , hst_xqual = noExt + , hst_xqual = noExtField , hst_body = $3 }) } - | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy noExt $1 $3)) + | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy noExtField $1 $3)) [mu AnnDcolon $2] } | type { $1 } @@ -1912,15 +1912,15 @@ ctypedoc :: { LHsType GhcPs } ams (sLL $1 $> $ HsForAllTy { hst_fvf = fv_flag , hst_bndrs = $2 - , hst_xforall = noExt + , hst_xforall = noExtField , hst_body = $4 }) [mu AnnForall $1,fv_ann] } | context '=>' ctypedoc {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2) >> return (sLL $1 $> $ HsQualTy { hst_ctxt = $1 - , hst_xqual = noExt + , hst_xqual = noExtField , hst_body = $3 }) } - | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy noExt $1 $3)) + | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy noExtField $1 $3)) [mu AnnDcolon $2] } | typedoc { $1 } @@ -1968,27 +1968,27 @@ is connected to the first type too. type :: { LHsType GhcPs } : btype { $1 } | btype '->' ctype {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations] - >> ams (sLL $1 $> $ HsFunTy noExt $1 $3) + >> ams (sLL $1 $> $ HsFunTy noExtField $1 $3) [mu AnnRarrow $2] } typedoc :: { LHsType GhcPs } : btype { $1 } - | btype docprev { sLL $1 $> $ HsDocTy noExt $1 $2 } - | docnext btype { sLL $1 $> $ HsDocTy noExt $2 $1 } + | btype docprev { sLL $1 $> $ HsDocTy noExtField $1 $2 } + | docnext btype { sLL $1 $> $ HsDocTy noExtField $2 $1 } | btype '->' ctypedoc {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations] - >> ams (sLL $1 $> $ HsFunTy noExt $1 $3) + >> ams (sLL $1 $> $ HsFunTy noExtField $1 $3) [mu AnnRarrow $2] } | btype docprev '->' ctypedoc {% ams $1 [mu AnnRarrow $3] -- See note [GADT decl discards annotations] >> ams (sLL $1 $> $ - HsFunTy noExt (cL (comb2 $1 $2) - (HsDocTy noExt $1 $2)) + HsFunTy noExtField (cL (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 noExt (cL (comb2 $1 $2) - (HsDocTy noExt $2 $1)) + HsFunTy noExtField (cL (comb2 $1 $2) + (HsDocTy noExtField $2 $1)) $4) [mu AnnRarrow $3] } @@ -2027,42 +2027,42 @@ tyapp :: { Located TyEl } | unpackedness { sL1 $1 $ TyElUnpackedness (unLoc $1) } atype :: { LHsType GhcPs } - : ntgtycon { sL1 $1 (HsTyVar noExt NotPromoted $1) } -- Not including unit tuples - | tyvar { sL1 $1 (HsTyVar noExt NotPromoted $1) } -- (See Note [Unit tuples]) + : ntgtycon { sL1 $1 (HsTyVar noExtField NotPromoted $1) } -- Not including unit tuples + | tyvar { sL1 $1 (HsTyVar noExtField NotPromoted $1) } -- (See Note [Unit tuples]) | '*' {% do { warnStarIsType (getLoc $1) - ; return $ sL1 $1 (HsStarTy noExt (isUnicode $1)) } } + ; return $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } } | '{' fielddecls '}' {% amms (checkRecordSyntax - (sLL $1 $> $ HsRecTy noExt $2)) + (sLL $1 $> $ HsRecTy noExtField $2)) -- Constructor sigs only [moc $1,mcc $3] } - | '(' ')' {% ams (sLL $1 $> $ HsTupleTy noExt + | '(' ')' {% ams (sLL $1 $> $ HsTupleTy noExtField HsBoxedOrConstraintTuple []) [mop $1,mcp $2] } | '(' ktype ',' comma_types1 ')' {% addAnnotation (gl $2) AnnComma (gl $3) >> - ams (sLL $1 $> $ HsTupleTy noExt + ams (sLL $1 $> $ HsTupleTy noExtField HsBoxedOrConstraintTuple ($2 : $4)) [mop $1,mcp $5] } - | '(#' '#)' {% ams (sLL $1 $> $ HsTupleTy noExt HsUnboxedTuple []) + | '(#' '#)' {% ams (sLL $1 $> $ HsTupleTy noExtField HsUnboxedTuple []) [mo $1,mc $2] } - | '(#' comma_types1 '#)' {% ams (sLL $1 $> $ HsTupleTy noExt HsUnboxedTuple $2) + | '(#' comma_types1 '#)' {% ams (sLL $1 $> $ HsTupleTy noExtField HsUnboxedTuple $2) [mo $1,mc $3] } - | '(#' bar_types2 '#)' {% ams (sLL $1 $> $ HsSumTy noExt $2) + | '(#' bar_types2 '#)' {% ams (sLL $1 $> $ HsSumTy noExtField $2) [mo $1,mc $3] } - | '[' ktype ']' {% ams (sLL $1 $> $ HsListTy noExt $2) [mos $1,mcs $3] } - | '(' ktype ')' {% ams (sLL $1 $> $ HsParTy noExt $2) [mop $1,mcp $3] } - | quasiquote { mapLoc (HsSpliceTy noExt) $1 } - | splice_untyped { mapLoc (HsSpliceTy noExt) $1 } + | '[' ktype ']' {% ams (sLL $1 $> $ HsListTy noExtField $2) [mos $1,mcs $3] } + | '(' ktype ')' {% ams (sLL $1 $> $ HsParTy noExtField $2) [mop $1,mcp $3] } + | quasiquote { mapLoc (HsSpliceTy noExtField) $1 } + | splice_untyped { mapLoc (HsSpliceTy noExtField) $1 } -- see Note [Promotion] for the followings - | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar noExt IsPromoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] } + | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar noExtField IsPromoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] } | SIMPLEQUOTE '(' ktype ',' comma_types1 ')' {% addAnnotation (gl $3) AnnComma (gl $4) >> - ams (sLL $1 $> $ HsExplicitTupleTy noExt ($3 : $5)) + ams (sLL $1 $> $ HsExplicitTupleTy noExtField ($3 : $5)) [mj AnnSimpleQuote $1,mop $2,mcp $6] } - | SIMPLEQUOTE '[' comma_types0 ']' {% ams (sLL $1 $> $ HsExplicitListTy noExt IsPromoted $3) + | SIMPLEQUOTE '[' comma_types0 ']' {% ams (sLL $1 $> $ HsExplicitListTy noExtField IsPromoted $3) [mj AnnSimpleQuote $1,mos $2,mcs $4] } - | SIMPLEQUOTE var {% ams (sLL $1 $> $ HsTyVar noExt IsPromoted $2) + | SIMPLEQUOTE var {% ams (sLL $1 $> $ HsTyVar noExtField IsPromoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] } -- Two or more [ty, ty, ty] must be a promoted list type, just as @@ -2071,11 +2071,11 @@ atype :: { LHsType GhcPs } -- so you have to quote those.) | '[' ktype ',' comma_types1 ']' {% addAnnotation (gl $2) AnnComma (gl $3) >> - ams (sLL $1 $> $ HsExplicitListTy noExt NotPromoted ($2 : $4)) + ams (sLL $1 $> $ HsExplicitListTy noExtField NotPromoted ($2 : $4)) [mos $1,mcs $5] } - | INTEGER { sLL $1 $> $ HsTyLit noExt $ HsNumTy (getINTEGERs $1) + | INTEGER { sLL $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1) (il_value (getINTEGER $1)) } - | STRING { sLL $1 $> $ HsTyLit noExt $ HsStrTy (getSTRINGs $1) + | STRING { sLL $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1) (getSTRING $1) } | '_' { sL1 $1 $ mkAnonWildCardTy } @@ -2111,8 +2111,8 @@ tv_bndrs :: { [LHsTyVarBndr GhcPs] } | {- empty -} { [] } tv_bndr :: { LHsTyVarBndr GhcPs } - : tyvar { sL1 $1 (UserTyVar noExt $1) } - | '(' tyvar '::' kind ')' {% ams (sLL $1 $> (KindedTyVar noExt $2 $4)) + : tyvar { sL1 $1 (UserTyVar noExtField $1) } + | '(' tyvar '::' kind ')' {% ams (sLL $1 $> (KindedTyVar noExtField $2 $4)) [mop $1,mu AnnDcolon $3 ,mcp $5] } @@ -2323,7 +2323,7 @@ fielddecl :: { LConDeclField GhcPs } -- A list because of f,g :: Int : maybe_docnext sig_vars '::' ctype maybe_docprev {% ams (cL (comb2 $2 $4) - (ConDeclField noExt (reverse (map (\ln@(dL->L l n) -> cL l $ FieldOcc noExt ln) (unLoc $2))) $4 ($1 `mplus` $5))) + (ConDeclField noExtField (reverse (map (\ln@(dL->L l n) -> cL l $ FieldOcc noExtField ln) (unLoc $2))) $4 ($1 `mplus` $5))) [mu AnnDcolon $3] } -- Reversed! @@ -2341,17 +2341,17 @@ derivings :: { HsDeriving GhcPs } deriving :: { LHsDerivingClause GhcPs } : 'deriving' deriv_clause_types {% let { full_loc = comb2 $1 $> } - in ams (cL full_loc $ HsDerivingClause noExt Nothing $2) + in ams (cL 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 noExt (Just $2) $3) + in ams (cL 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 noExt (Just $3) $2) + in ams (cL full_loc $ HsDerivingClause noExtField (Just $3) $2) [mj AnnDeriving $1] } deriv_clause_types :: { Located [LHsSigType GhcPs] } @@ -2389,7 +2389,7 @@ There's an awkward overlap with a type signature. Consider -} docdecl :: { LHsDecl GhcPs } - : docdecld { sL1 $1 (DocD noExt (unLoc $1)) } + : docdecld { sL1 $1 (DocD noExtField (unLoc $1)) } docdecld :: { LDocDecl } : docnext { sL1 $1 (DocCommentNext (unLoc $1)) } @@ -2415,7 +2415,7 @@ decl_no_th :: { LHsDecl GhcPs } amsL l [] >> return () } ; _ <- amsL l (ann ++ fst (unLoc $3) ++ [mj AnnBang $1]) ; - return $! (sL l $ ValD noExt r) } } + return $! (sL l $ ValD noExtField r) } } | infixexp_top opt_sig rhs {% runECP_P $1 >>= \ $1 -> do { (ann,r) <- checkValDef NoSrcStrict $1 (snd $2) $3; @@ -2429,7 +2429,7 @@ decl_no_th :: { LHsDecl GhcPs } (PatBind _ (dL->L lh _lhs) _rhs _) -> amsL lh (fst $2) >> return () } ; _ <- amsL l (ann ++ (fst $ unLoc $3)); - return $! (sL l $ ValD noExt r) } } + return $! (sL l $ ValD noExtField r) } } | pattern_synonym_decl { $1 } | docdecl { $1 } @@ -2445,10 +2445,10 @@ rhs :: { Located ([AddAnn],GRHSs GhcPs (LHsExpr GhcPs)) } : '=' exp wherebinds {% runECP_P $2 >>= \ $2 -> return $ sL (comb3 $1 $2 $3) ((mj AnnEqual $1 : (fst $ unLoc $3)) - ,GRHSs noExt (unguardedRHS (comb3 $1 $2 $3) $2) + ,GRHSs noExtField (unguardedRHS (comb3 $1 $2 $3) $2) (snd $ unLoc $3)) } | gdrhs wherebinds { sLL $1 $> (fst $ unLoc $2 - ,GRHSs noExt (reverse (unLoc $1)) + ,GRHSs noExtField (reverse (unLoc $1)) (snd $ unLoc $2)) } gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] } @@ -2457,7 +2457,7 @@ gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] } gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) } : '|' guardquals '=' exp {% runECP_P $4 >>= \ $4 -> - ams (sL (comb2 $1 $>) $ GRHS noExt (unLoc $2) $4) + ams (sL (comb2 $1 $>) $ GRHS noExtField (unLoc $2) $4) [mj AnnVbar $1,mj AnnEqual $3] } sigdecl :: { LHsDecl GhcPs } @@ -2467,70 +2467,70 @@ sigdecl :: { LHsDecl GhcPs } {% do { $1 <- runECP_P $1 ; v <- checkValSigLhs $1 ; _ <- amsL (comb2 $1 $>) [mu AnnDcolon $2] - ; return (sLL $1 $> $ SigD noExt $ - TypeSig noExt [v] (mkLHsSigWcType $3))} } + ; return (sLL $1 $> $ SigD noExtField $ + TypeSig noExtField [v] (mkLHsSigWcType $3))} } | var ',' sig_vars '::' sigtypedoc - {% do { let sig = TypeSig noExt ($1 : reverse (unLoc $3)) + {% do { let sig = TypeSig noExtField ($1 : reverse (unLoc $3)) (mkLHsSigWcType $5) ; addAnnotation (gl $1) AnnComma (gl $2) - ; ams ( sLL $1 $> $ SigD noExt sig ) + ; ams ( sLL $1 $> $ SigD noExtField sig ) [mu AnnDcolon $4] } } | infix prec ops {% checkPrecP $2 $3 >> - ams (sLL $1 $> $ SigD noExt - (FixSig noExt (FixitySig noExt (fromOL $ unLoc $3) + ams (sLL $1 $> $ SigD noExtField + (FixSig noExtField (FixitySig noExtField (fromOL $ unLoc $3) (Fixity (fst $ unLoc $2) (snd $ unLoc $2) (unLoc $1))))) [mj AnnInfix $1,mj AnnVal $2] } - | pattern_synonym_sig { sLL $1 $> . SigD noExt . unLoc $ $1 } + | pattern_synonym_sig { sLL $1 $> . SigD noExtField . unLoc $ $1 } | '{-# COMPLETE' con_list opt_tyconsig '#-}' {% let (dcolon, tc) = $3 in ams (sLL $1 $> - (SigD noExt (CompleteMatchSig noExt (getCOMPLETE_PRAGs $1) $2 tc))) + (SigD noExtField (CompleteMatchSig noExtField (getCOMPLETE_PRAGs $1) $2 tc))) ([ mo $1 ] ++ dcolon ++ [mc $4]) } -- This rule is for both INLINE and INLINABLE pragmas | '{-# INLINE' activation qvar '#-}' - {% ams ((sLL $1 $> $ SigD noExt (InlineSig noExt $3 + {% ams ((sLL $1 $> $ SigD noExtField (InlineSig noExtField $3 (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1) (snd $2))))) ((mo $1:fst $2) ++ [mc $4]) } | '{-# SCC' qvar '#-}' - {% ams (sLL $1 $> (SigD noExt (SCCFunSig noExt (getSCC_PRAGs $1) $2 Nothing))) + {% ams (sLL $1 $> (SigD noExtField (SCCFunSig noExtField (getSCC_PRAGs $1) $2 Nothing))) [mo $1, mc $3] } | '{-# SCC' qvar STRING '#-}' {% do { scc <- getSCC $3 ; let str_lit = StringLiteral (getSTRINGs $3) scc - ; ams (sLL $1 $> (SigD noExt (SCCFunSig noExt (getSCC_PRAGs $1) $2 (Just ( sL1 $3 str_lit))))) + ; ams (sLL $1 $> (SigD noExtField (SCCFunSig noExtField (getSCC_PRAGs $1) $2 (Just ( sL1 $3 str_lit))))) [mo $1, mc $4] } } | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}' {% ams ( let inl_prag = mkInlinePragma (getSPEC_PRAGs $1) (NoUserInline, FunLike) (snd $2) - in sLL $1 $> $ SigD noExt (SpecSig noExt $3 (fromOL $5) inl_prag)) + in sLL $1 $> $ SigD noExtField (SpecSig noExtField $3 (fromOL $5) inl_prag)) (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) } | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}' - {% ams (sLL $1 $> $ SigD noExt (SpecSig noExt $3 (fromOL $5) + {% ams (sLL $1 $> $ SigD noExtField (SpecSig noExtField $3 (fromOL $5) (mkInlinePragma (getSPEC_INLINE_PRAGs $1) (getSPEC_INLINE $1) (snd $2)))) (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) } | '{-# SPECIALISE' 'instance' inst_type '#-}' {% ams (sLL $1 $> - $ SigD noExt (SpecInstSig noExt (getSPEC_PRAGs $1) $3)) + $ SigD noExtField (SpecInstSig noExtField (getSPEC_PRAGs $1) $3)) [mo $1,mj AnnInstance $2,mc $4] } -- A minimal complete definition | '{-# MINIMAL' name_boolformula_opt '#-}' - {% ams (sLL $1 $> $ SigD noExt (MinimalSig noExt (getMINIMAL_PRAGs $1) $2)) + {% ams (sLL $1 $> $ SigD noExtField (MinimalSig noExtField (getMINIMAL_PRAGs $1) $2)) [mo $1,mc $3] } activation :: { ([AddAnn],Maybe Activation) } @@ -2565,25 +2565,25 @@ exp :: { ECP } | infixexp '-<' exp {% runECP_P $1 >>= \ $1 -> runECP_P $3 >>= \ $3 -> fmap ecpFromCmd $ - ams (sLL $1 $> $ HsCmdArrApp noExt $1 $3 + ams (sLL $1 $> $ HsCmdArrApp noExtField $1 $3 HsFirstOrderApp True) [mu Annlarrowtail $2] } | infixexp '>-' exp {% runECP_P $1 >>= \ $1 -> runECP_P $3 >>= \ $3 -> fmap ecpFromCmd $ - ams (sLL $1 $> $ HsCmdArrApp noExt $3 $1 + ams (sLL $1 $> $ HsCmdArrApp noExtField $3 $1 HsFirstOrderApp False) [mu Annrarrowtail $2] } | infixexp '-<<' exp {% runECP_P $1 >>= \ $1 -> runECP_P $3 >>= \ $3 -> fmap ecpFromCmd $ - ams (sLL $1 $> $ HsCmdArrApp noExt $1 $3 + ams (sLL $1 $> $ HsCmdArrApp noExtField $1 $3 HsHigherOrderApp True) [mu AnnLarrowtail $2] } | infixexp '>>-' exp {% runECP_P $1 >>= \ $1 -> runECP_P $3 >>= \ $3 -> fmap ecpFromCmd $ - ams (sLL $1 $> $ HsCmdArrApp noExt $3 $1 + ams (sLL $1 $> $ HsCmdArrApp noExtField $3 $1 HsHigherOrderApp False) [mu AnnRarrowtail $2] } | infixexp { $1 } @@ -2619,13 +2619,13 @@ exp10_top :: { ECP } | hpc_annot exp {% runECP_P $2 >>= \ $2 -> fmap ecpFromExp $ - ams (sLL $1 $> $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1) + ams (sLL $1 $> $ HsTickPragma noExtField (snd $ fst $ fst $ unLoc $1) (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2) (fst $ fst $ fst $ unLoc $1) } | '{-# CORE' STRING '#-}' exp {% runECP_P $4 >>= \ $4 -> fmap ecpFromExp $ - ams (sLL $1 $> $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) $4) + ams (sLL $1 $> $ HsCoreAnn noExtField (getCORE_PRAGs $1) (getStringLiteral $2) $4) [mo $1,mj AnnVal $2 ,mc $3] } -- hdaume: core annotation @@ -2635,7 +2635,7 @@ exp10 :: { ECP } : exp10_top { $1 } | scc_annot exp {% runECP_P $2 >>= \ $2 -> fmap ecpFromExp $ - ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2) + ams (sLL $1 $> $ HsSCC noExtField (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2) (fst $ fst $ unLoc $1) } optSemi :: { ([Located Token],Bool) } @@ -2686,11 +2686,11 @@ fexp :: { ECP } | fexp TYPEAPP atype {% runECP_P $1 >>= \ $1 -> runPV (checkExpBlockArguments $1) >>= \_ -> fmap ecpFromExp $ - ams (sLL $1 $> $ HsAppType noExt $1 (mkHsWildCardBndrs $3)) + ams (sLL $1 $> $ HsAppType noExtField $1 (mkHsWildCardBndrs $3)) [mj AnnAt $2] } | 'static' aexp {% runECP_P $2 >>= \ $2 -> fmap ecpFromExp $ - ams (sLL $1 $> $ HsStatic noExt $2) + ams (sLL $1 $> $ HsStatic noExtField $2) [mj AnnStatic $1] } | aexp { $1 } @@ -2709,7 +2709,7 @@ aexp :: { ECP } { ECP $ runECP_PV $5 >>= \ $5 -> amms (mkHsLamPV (comb2 $1 $>) (mkMatchGroup FromSource - [sLL $1 $> $ Match { m_ext = noExt + [sLL $1 $> $ Match { m_ext = noExtField , m_ctxt = LambdaExpr , m_pats = $2:$3 , m_grhss = unguardedGRHSs $5 }])) @@ -2722,7 +2722,7 @@ aexp :: { ECP } | '\\' 'lcase' altslist {% runPV $3 >>= \ $3 -> fmap ecpFromExp $ - ams (sLL $1 $> $ HsLamCase noExt + ams (sLL $1 $> $ HsLamCase noExtField (mkMatchGroup FromSource (snd $ unLoc $3))) (mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) } | 'if' exp optSemi 'then' exp optSemi 'else' exp @@ -2737,7 +2737,7 @@ aexp :: { ECP } ++(map (\l -> mj AnnSemi l) (fst $6))) } | 'if' ifgdpats {% hintMultiWayIf (getLoc $1) >>= \_ -> fmap ecpFromExp $ - ams (sLL $1 $> $ HsMultiIf noExt + ams (sLL $1 $> $ HsMultiIf noExtField (reverse $ snd $ unLoc $2)) (mj AnnIf $1:(fst $ unLoc $2)) } | 'case' exp 'of' altslist {% runECP_P $2 >>= \ $2 -> @@ -2760,7 +2760,7 @@ aexp :: { ECP } {% (checkPattern <=< runECP_P) $2 >>= \ p -> runECP_P $4 >>= \ $4@cmd -> fmap ecpFromExp $ - ams (sLL $1 $> $ HsProc noExt p (sLL $1 $> $ HsCmdTop noExt cmd)) + ams (sLL $1 $> $ HsProc noExtField p (sLL $1 $> $ HsCmdTop noExtField cmd)) -- TODO: is LL right here? [mj AnnProc $1,mu AnnRarrow $3] } @@ -2777,13 +2777,13 @@ aexp1 :: { ECP } aexp2 :: { ECP } : qvar { ECP $ mkHsVarPV $! $1 } | qcon { ECP $ mkHsVarPV $! $1 } - | ipvar { ecpFromExp $ sL1 $1 (HsIPVar noExt $! unLoc $1) } - | overloaded_label { ecpFromExp $ sL1 $1 (HsOverLabel noExt Nothing $! unLoc $1) } + | ipvar { ecpFromExp $ sL1 $1 (HsIPVar noExtField $! unLoc $1) } + | overloaded_label { ecpFromExp $ sL1 $1 (HsOverLabel noExtField Nothing $! unLoc $1) } | literal { ECP $ mkHsLitPV $! $1 } -- This will enable overloaded strings permanently. Normally the renamer turns HsString -- into HsOverLit when -foverloaded-strings is on. -- | STRING { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1) --- (getSTRING $1) noExt) } +-- (getSTRING $1) noExtField) } | INTEGER { ECP $ mkHsOverLitPV (sL1 $1 $ mkHsIntegral (getINTEGER $1)) } | RATIONAL { ECP $ mkHsOverLitPV (sL1 $1 $ mkHsFractional (getRATIONAL $1)) } @@ -2813,47 +2813,47 @@ aexp2 :: { ECP } -- Template Haskell Extension | splice_untyped { ECP $ mkHsSplicePV $1 } - | splice_typed { ecpFromExp $ mapLoc (HsSpliceE noExt) $1 } + | splice_typed { ecpFromExp $ mapLoc (HsSpliceE noExtField) $1 } - | SIMPLEQUOTE qvar {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] } - | SIMPLEQUOTE qcon {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] } - | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] } - | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] } + | SIMPLEQUOTE qvar {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] } + | SIMPLEQUOTE qcon {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] } + | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] } + | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] } | TH_TY_QUOTE {- nothing -} {% reportEmptyDoubleQuotes (getLoc $1) } | '[|' exp '|]' {% runECP_P $2 >>= \ $2 -> fmap ecpFromExp $ - ams (sLL $1 $> $ HsBracket noExt (ExpBr noExt $2)) + ams (sLL $1 $> $ HsBracket noExtField (ExpBr noExtField $2)) (if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3] else [mu AnnOpenEQ $1,mu AnnCloseQ $3]) } | '[||' exp '||]' {% runECP_P $2 >>= \ $2 -> fmap ecpFromExp $ - ams (sLL $1 $> $ HsBracket noExt (TExpBr noExt $2)) + ams (sLL $1 $> $ HsBracket noExtField (TExpBr noExtField $2)) (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) } | '[t|' ktype '|]' {% fmap ecpFromExp $ - ams (sLL $1 $> $ HsBracket noExt (TypBr noExt $2)) [mo $1,mu AnnCloseQ $3] } + ams (sLL $1 $> $ HsBracket noExtField (TypBr noExtField $2)) [mo $1,mu AnnCloseQ $3] } | '[p|' infixexp '|]' {% (checkPattern <=< runECP_P) $2 >>= \p -> fmap ecpFromExp $ - ams (sLL $1 $> $ HsBracket noExt (PatBr noExt p)) + ams (sLL $1 $> $ HsBracket noExtField (PatBr noExtField p)) [mo $1,mu AnnCloseQ $3] } | '[d|' cvtopbody '|]' {% fmap ecpFromExp $ - ams (sLL $1 $> $ HsBracket noExt (DecBrL noExt (snd $2))) + ams (sLL $1 $> $ HsBracket noExtField (DecBrL noExtField (snd $2))) (mo $1:mu AnnCloseQ $3:fst $2) } | quasiquote { ECP $ mkHsSplicePV $1 } -- arrow notation extension | '(|' aexp2 cmdargs '|)' {% runECP_P $2 >>= \ $2 -> fmap ecpFromCmd $ - ams (sLL $1 $> $ HsCmdArrForm noExt $2 Prefix + ams (sLL $1 $> $ HsCmdArrForm noExtField $2 Prefix Nothing (reverse $3)) [mu AnnOpenB $1,mu AnnCloseB $4] } splice_exp :: { LHsExpr GhcPs } - : splice_untyped { mapLoc (HsSpliceE noExt) $1 } - | splice_typed { mapLoc (HsSpliceE noExt) $1 } + : splice_untyped { mapLoc (HsSpliceE noExtField) $1 } + | splice_typed { mapLoc (HsSpliceE noExtField) $1 } splice_untyped :: { Located (HsSplice GhcPs) } : TH_ID_SPLICE {% ams (sL1 $1 $ mkUntypedSplice HasDollar - (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName + (sL1 $1 $ HsVar noExtField (sL1 $1 (mkUnqual varName (getTH_ID_SPLICE $1))))) [mj AnnThIdSplice $1] } | '$(' exp ')' {% runECP_P $2 >>= \ $2 -> @@ -2862,7 +2862,7 @@ splice_untyped :: { Located (HsSplice GhcPs) } splice_typed :: { Located (HsSplice GhcPs) } : TH_ID_TY_SPLICE {% ams (sL1 $1 $ mkTypedSplice HasDollar - (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName + (sL1 $1 $ HsVar noExtField (sL1 $1 (mkUnqual varName (getTH_ID_TY_SPLICE $1))))) [mj AnnThIdTySplice $1] } | '$$(' exp ')' {% runECP_P $2 >>= \ $2 -> @@ -2875,7 +2875,7 @@ cmdargs :: { [LHsCmdTop GhcPs] } acmd :: { LHsCmdTop GhcPs } : aexp2 {% runECP_P $1 >>= \ cmd -> - return (sL1 cmd $ HsCmdTop noExt cmd) } + return (sL1 cmd $ HsCmdTop noExtField cmd) } cvtopbody :: { ([AddAnn],[LHsDecl GhcPs]) } : '{' cvtopdecls0 '}' { ([mj AnnOpenC $1 @@ -2909,7 +2909,7 @@ texp :: { ECP } | infixexp qop {% runECP_P $1 >>= \ $1 -> runPV $2 >>= \ $2 -> return $ ecpFromExp $ - sLL $1 $> $ SectionL noExt $1 $2 } + sLL $1 $> $ SectionL noExtField $1 $2 } | qopm infixexp { ECP $ superInfixOp $ runECP_PV $2 >>= \ $2 -> @@ -2973,25 +2973,25 @@ 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 noExt Nothing (From $1)) + ams (cL 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 noExt Nothing (FromThen $1 $3)) + ams (cL 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 noExt Nothing (FromTo $1 $3)) + ams (cL 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 noExt Nothing (FromThenTo $1 $3 $5)) + ams (cL loc $ ArithSeq noExtField Nothing (FromThenTo $1 $3 $5)) [mj AnnComma $2,mj AnnDotdot $4] >>= ecpFromExp' } | texp '|' flattenedpquals @@ -3022,7 +3022,7 @@ flattenedpquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- We just had one thing in our "parallel" list so -- we simply return that thing directly - qss -> sL1 $1 [sL1 $1 $ ParStmt noExt [ParStmtBlock noExt qs [] noSyntaxExpr | + qss -> sL1 $1 [sL1 $1 $ ParStmt noExtField [ParStmtBlock noExtField qs [] noSyntaxExpr | qs <- qss] noExpr noSyntaxExpr] -- We actually found some actual parallel lists so @@ -3135,7 +3135,7 @@ alts1 :: { forall b. DisambECP b => PV (Located ([AddAnn],[LMatch GhcPs (Locat alt :: { forall b. DisambECP b => PV (LMatch GhcPs (Located b)) } : pat alt_rhs { $2 >>= \ $2 -> - ams (sLL $1 $> (Match { m_ext = noExt + ams (sLL $1 $> (Match { m_ext = noExtField , m_ctxt = CaseAlt , m_pats = [$1] , m_grhss = snd $ unLoc $2 })) @@ -3143,7 +3143,7 @@ alt :: { forall b. DisambECP b => PV (LMatch GhcPs (Located b)) } alt_rhs :: { forall b. DisambECP b => PV (Located ([AddAnn],GRHSs GhcPs (Located b))) } : ralt wherebinds { $1 >>= \alt -> - return $ sLL alt $> (fst $ unLoc $2, GRHSs noExt (unLoc alt) (snd $ unLoc $2)) } + return $ sLL alt $> (fst $ unLoc $2, GRHSs noExtField (unLoc alt) (snd $ unLoc $2)) } ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (Located b)]) } : '->' exp { runECP_PV $2 >>= \ $2 -> @@ -3170,7 +3170,7 @@ ifgdpats :: { Located ([AddAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) } gdpat :: { forall b. DisambECP b => PV (LGRHS GhcPs (Located b)) } : '|' guardquals '->' exp { runECP_PV $4 >>= \ $4 -> - ams (sL (comb2 $1 $>) $ GRHS noExt (unLoc $2) $4) + ams (sL (comb2 $1 $>) $ GRHS noExtField (unLoc $2) $4) [mj AnnVbar $1,mu AnnRarrow $3] } -- 'pat' recognises a pattern, including one with a bang at the top @@ -3264,7 +3264,7 @@ qual :: { forall b. DisambECP b => PV (LStmt GhcPs (Located b)) } [mu AnnLarrow $2] } | exp { runECP_PV $1 >>= \ $1 -> return $ sL1 $1 $ mkBodyStmt $1 } - | 'let' binds { ams (sLL $1 $> $ LetStmt noExt (snd $ unLoc $2)) + | 'let' binds { ams (sLL $1 $> $ LetStmt noExtField (snd $ unLoc $2)) (mj AnnLet $1:(fst $ unLoc $2)) } ----------------------------------------------------------------------------- @@ -3312,7 +3312,7 @@ dbinds :: { Located [LIPBind GhcPs] } dbind :: { LIPBind GhcPs } dbind : ipvar '=' exp {% runECP_P $3 >>= \ $3 -> - ams (sLL $1 $> (IPBind noExt (Left $1) $3)) + ams (sLL $1 $> (IPBind noExtField (Left $1) $3)) [mj AnnEqual $2] } ipvar :: { Located HsIPName } @@ -3489,8 +3489,8 @@ qtycon :: { Located RdrName } -- Qualified or unqualified | tycon { $1 } qtycondoc :: { LHsType GhcPs } -- Qualified or unqualified - : qtycon { sL1 $1 (HsTyVar noExt NotPromoted $1) } - | qtycon docprev { sLL $1 $> (HsDocTy noExt (sL1 $1 (HsTyVar noExt NotPromoted $1)) $2) } + : qtycon { sL1 $1 (HsTyVar noExtField NotPromoted $1) } + | qtycon docprev { sLL $1 $> (HsDocTy noExtField (sL1 $1 (HsTyVar noExtField NotPromoted $1)) $2) } tycon :: { Located RdrName } -- Unqualified : CONID { sL1 $1 $! mkUnqual tcClsName (getCONID $1) } @@ -3700,8 +3700,8 @@ literal :: { Located (HsLit GhcPs) } $ getPRIMCHAR $1 } | PRIMSTRING { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1) $ getPRIMSTRING $1 } - | PRIMFLOAT { sL1 $1 $ HsFloatPrim noExt $ getPRIMFLOAT $1 } - | PRIMDOUBLE { sL1 $1 $ HsDoublePrim noExt $ getPRIMDOUBLE $1 } + | PRIMFLOAT { sL1 $1 $ HsFloatPrim noExtField $ getPRIMFLOAT $1 } + | PRIMDOUBLE { sL1 $1 $ HsDoublePrim noExtField $ getPRIMDOUBLE $1 } ----------------------------------------------------------------------------- -- Layout diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index c479ab0e1c..b16858de56 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -160,10 +160,10 @@ import Data.Data ( dataTypeOf, fromConstr, dataTypeConstrs ) -- *** See Note [The Naming story] in HsDecls **** mkTyClD :: LTyClDecl (GhcPass p) -> LHsDecl (GhcPass p) -mkTyClD (dL->L loc d) = cL loc (TyClD noExt d) +mkTyClD (dL->L loc d) = cL loc (TyClD noExtField d) mkInstD :: LInstDecl (GhcPass p) -> LHsDecl (GhcPass p) -mkInstD (dL->L loc d) = cL loc (InstD noExt d) +mkInstD (dL->L loc d) = cL loc (InstD noExtField d) mkClassDecl :: SrcSpan -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs) @@ -178,7 +178,7 @@ mkClassDecl loc (dL->L _ (mcxt, tycl_hdr)) fds where_cls ; 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 = noExt, tcdCtxt = cxt + ; return (cL loc (ClassDecl { tcdCExt = noExtField, tcdCtxt = cxt , tcdLName = cls, tcdTyVars = tyvars , tcdFixity = fixity , tcdFDs = snd (unLoc fds) @@ -202,7 +202,7 @@ mkTyData loc new_or_data cType (dL->L _ (mcxt, tycl_hdr)) ; (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 = noExt, + ; return (cL loc (DataDecl { tcdDExt = noExtField, tcdLName = tc, tcdTyVars = tyvars, tcdFixity = fixity, tcdDataDefn = defn })) } @@ -217,7 +217,7 @@ mkDataDefn :: NewOrData mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv = do { checkDatatypeContext mcxt ; let cxt = fromMaybe (noLoc []) mcxt - ; return (HsDataDefn { dd_ext = noExt + ; return (HsDataDefn { dd_ext = noExtField , dd_ND = new_or_data, dd_cType = cType , dd_ctxt = cxt , dd_cons = data_cons @@ -234,7 +234,7 @@ 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 = noExt + ; return (cL loc (SynDecl { tcdSExt = noExtField , tcdLName = tc, tcdTyVars = tyvars , tcdFixity = fixity , tcdRhs = rhs })) } @@ -246,7 +246,7 @@ mkTyFamInstEqn :: Maybe [LHsTyVarBndr GhcPs] mkTyFamInstEqn bndrs lhs rhs = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs ; return (mkHsImplicitBndrs - (FamEqn { feqn_ext = noExt + (FamEqn { feqn_ext = noExtField , feqn_tycon = tc , feqn_bndrs = bndrs , feqn_pats = tparams @@ -268,8 +268,8 @@ mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr) = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr ; mapM_ (\a -> a 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 noExt (DataFamInstDecl (mkHsImplicitBndrs - (FamEqn { feqn_ext = noExt + ; return (cL loc (DataFamInstD noExtField (DataFamInstDecl (mkHsImplicitBndrs + (FamEqn { feqn_ext = noExtField , feqn_tycon = tc , feqn_bndrs = bndrs , feqn_pats = tparams @@ -280,7 +280,7 @@ mkTyFamInst :: SrcSpan -> TyFamInstEqn GhcPs -> P (LInstDecl GhcPs) mkTyFamInst loc eqn - = return (cL loc (TyFamInstD noExt (TyFamInstDecl eqn))) + = return (cL loc (TyFamInstD noExtField (TyFamInstDecl eqn))) mkFamDecl :: SrcSpan -> FamilyInfo GhcPs @@ -293,8 +293,8 @@ 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 noExt (FamilyDecl - { fdExt = noExt + ; return (cL loc (FamDecl noExtField (FamilyDecl + { fdExt = noExtField , fdInfo = info, fdLName = tc , fdTyVars = tyvars , fdFixity = fixity @@ -318,13 +318,13 @@ mkSpliceDecl :: LHsExpr GhcPs -> HsDecl GhcPs -- as spliced declaration. See #10945 mkSpliceDecl lexpr@(dL->L loc expr) | HsSpliceE _ splice@(HsUntypedSplice {}) <- expr - = SpliceD noExt (SpliceDecl noExt (cL loc splice) ExplicitSplice) + = SpliceD noExtField (SpliceDecl noExtField (cL loc splice) ExplicitSplice) | HsSpliceE _ splice@(HsQuasiQuote {}) <- expr - = SpliceD noExt (SpliceDecl noExt (cL loc splice) ExplicitSplice) + = SpliceD noExtField (SpliceDecl noExtField (cL loc splice) ExplicitSplice) | otherwise - = SpliceD noExt (SpliceDecl noExt (cL loc (mkUntypedSplice NoParens lexpr)) + = SpliceD noExtField (SpliceDecl noExtField (cL loc (mkUntypedSplice NoParens lexpr)) ImplicitSplice) mkRoleAnnotDecl :: SrcSpan @@ -333,7 +333,7 @@ mkRoleAnnotDecl :: SrcSpan -> P (LRoleAnnotDecl GhcPs) mkRoleAnnotDecl loc tycon roles = do { roles' <- mapM parse_role roles - ; return $ cL loc $ RoleAnnotDecl noExt tycon roles' } + ; return $ cL loc $ RoleAnnotDecl noExtField tycon roles' } where role_data_type = dataTypeOf (undefined :: Role) all_roles = map fromConstr $ dataTypeConstrs role_data_type @@ -387,7 +387,7 @@ cvBindGroup binding = do { (mbs, sigs, fam_ds, tfam_insts , dfam_insts, _) <- cvBindsAndSigs binding ; ASSERT( null fam_ds && null tfam_insts && null dfam_insts) - return $ ValBinds noExt mbs sigs } + return $ ValBinds noExtField mbs sigs } cvBindsAndSigs :: OrdList (LHsDecl GhcPs) -> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs] @@ -473,7 +473,7 @@ has_args ((dL->L _ (Match { m_pats = args })) : _) = not (null args) -- 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 _)) : _) = panic "has_args" +has_args ((dL->L _ (XMatch nec)) : _) = noExtCon nec has_args (_ : _) = panic "has_args:Impossible Match" -- due to #15884 {- ********************************************************************** @@ -588,7 +588,7 @@ mkPatSynMatchGroup (dL->L loc patsyn_name) (dL->L _ decls) = do { unless (name == patsyn_name) $ wrongNameBindingErr loc decl ; match <- case details of - PrefixCon pats -> return $ Match { m_ext = noExt + PrefixCon pats -> return $ Match { m_ext = noExtField , m_ctxt = ctxt, m_pats = pats , m_grhss = rhs } where @@ -596,7 +596,7 @@ mkPatSynMatchGroup (dL->L loc patsyn_name) (dL->L _ decls) = , mc_fixity = Prefix , mc_strictness = NoSrcStrict } - InfixCon p1 p2 -> return $ Match { m_ext = noExt + InfixCon p1 p2 -> return $ Match { m_ext = noExtField , m_ctxt = ctxt , m_pats = [p1, p2] , m_grhss = rhs } @@ -635,7 +635,7 @@ mkConDeclH98 :: Located RdrName -> Maybe [LHsTyVarBndr GhcPs] -> ConDecl GhcPs mkConDeclH98 name mb_forall mb_cxt args - = ConDeclH98 { con_ext = noExt + = ConDeclH98 { con_ext = noExtField , con_name = name , con_forall = noLoc $ isJust mb_forall , con_ex_tvs = mb_forall `orElse` [] @@ -647,7 +647,7 @@ mkGadtDecl :: [Located RdrName] -> LHsType GhcPs -- Always a HsForAllTy -> (ConDecl GhcPs, [AddAnn]) mkGadtDecl names ty - = (ConDeclGADT { con_g_ext = noExt + = (ConDeclGADT { con_g_ext = noExtField , con_names = names , con_forall = cL l $ isLHsForAllTy ty' , con_qvars = mkHsQTvs tvs @@ -809,9 +809,9 @@ checkTyVars pp_what equals_or_where tc tparms -- 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 noExt (cL lv 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 noExt (cL ltv tv))) + | isRdrTyVar tv = return (cL l (UserTyVar noExtField (cL ltv tv))) chk t@(dL->L loc _) = addFatalError loc $ vcat [ text "Unexpected type" <+> quotes (ppr t) @@ -853,16 +853,16 @@ data RuleTyTmVar = RuleTyTmVar (Located RdrName) (Maybe (LHsType GhcPs)) -- turns RuleTyTmVars into RuleBnrs - this is straightforward mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs] mkRuleBndrs = fmap (fmap cvt_one) - where cvt_one (RuleTyTmVar v Nothing) = RuleBndr noExt v + where cvt_one (RuleTyTmVar v Nothing) = RuleBndr noExtField v cvt_one (RuleTyTmVar v (Just sig)) = - RuleBndrSig noExt v (mkLHsSigWcType sig) + RuleBndrSig noExtField v (mkLHsSigWcType sig) -- turns RuleTyTmVars into HsTyVarBndrs - this is more interesting mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr GhcPs] mkRuleTyVarBndrs = fmap (fmap cvt_one) - where cvt_one (RuleTyTmVar v Nothing) = UserTyVar noExt (fmap tm_to_ty v) + where cvt_one (RuleTyTmVar v Nothing) = UserTyVar noExtField (fmap tm_to_ty v) cvt_one (RuleTyTmVar v (Just sig)) - = KindedTyVar noExt (fmap tm_to_ty v) sig + = KindedTyVar noExtField (fmap tm_to_ty v) sig -- takes something in namespace 'varName' to something in namespace 'tvName' tm_to_ty (Unqual occ) = Unqual (setOccNameSpace tvName occ) tm_to_ty _ = panic "mkRuleTyVarBndrs" @@ -1082,7 +1082,7 @@ checkAPat loc e0 = do nPlusKPatterns <- getBit NPlusKPatternsBit case e0 of PatBuilderPat p -> return p - PatBuilderVar x -> return (VarPat noExt x) + PatBuilderVar x -> return (VarPat noExtField x) -- Overloaded numeric patterns (e.g. f 0 x = x) -- Negation is recorded separately, so that the literal is zero or +ve @@ -1093,7 +1093,7 @@ checkAPat loc e0 = do -> do { hintBangPat loc e0 ; e' <- checkLPat e ; addAnnotation loc AnnBang lb - ; return (BangPat noExt e') } + ; return (BangPat noExtField e') } -- n+k patterns PatBuilderOpApp @@ -1109,7 +1109,7 @@ checkAPat loc e0 = do r <- checkLPat r return (ConPatIn (cL cl c) (InfixCon l r)) - PatBuilderPar e -> checkLPat e >>= (return . (ParPat noExt)) + PatBuilderPar e -> checkLPat e >>= (return . (ParPat noExtField)) _ -> patFail loc (ppr e0) placeHolderPunRhs :: DisambECP b => PV (Located b) @@ -1176,7 +1176,7 @@ checkFunBind strictness ann lhs_loc fun is_infix pats (dL->L rhs_span grhss) -- 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 = noExt + [cL match_span (Match { m_ext = noExtField , m_ctxt = FunRhs { mc_fun = fun , mc_fixity = is_infix @@ -1190,7 +1190,7 @@ makeFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> HsBind GhcPs -- Like HsUtils.mkFunBind, but we need to be able to set the fixity too makeFunBind fn ms - = FunBind { fun_ext = noExt, + = FunBind { fun_ext = noExtField, fun_id = fn, fun_matches = mkMatchGroup FromSource ms, fun_co_fn = idHsWrapper, @@ -1200,7 +1200,7 @@ checkPatBind :: LPat GhcPs -> Located (a,GRHSs GhcPs (LHsExpr GhcPs)) -> P ([AddAnn],HsBind GhcPs) checkPatBind lhs (dL->L _ (_,grhss)) - = return ([],PatBind noExt lhs grhss ([],[])) + = return ([],PatBind noExtField lhs grhss ([],[])) checkValSigLhs :: LHsExpr GhcPs -> P (Located RdrName) checkValSigLhs (dL->L _ (HsVar _ lrdr@(dL->L _ v))) @@ -1400,7 +1400,7 @@ pBangTy lt@(dL->L l1 _) xs = Nothing -> (False, lt, pure (), xs) Just (dL->L l2 strictMark, anns, xs') -> let bl = combineSrcSpans l1 l2 - bt = HsBangTy noExt strictMark lt + bt = HsBangTy noExtField strictMark lt in (True, cL bl bt, addAnnsAt bl anns, xs') -- | Merge a /reversed/ and /non-empty/ soup of operators and operands @@ -1433,7 +1433,7 @@ mergeOps all_xs = go (0 :: Int) [] id all_xs ; let a = ops_acc acc' strictMark = HsSrcBang unpkSrc unpk NoSrcStrict bl = combineSrcSpans l (getLoc a) - bt = HsBangTy noExt strictMark a + bt = HsBangTy noExtField strictMark a ; addAnnsAt bl anns ; return (cL bl bt) } else addFatalError l unpkError @@ -1841,8 +1841,8 @@ class DisambInfixOp b where mkHsInfixHolePV :: SrcSpan -> PV (Located b) instance p ~ GhcPs => DisambInfixOp (HsExpr p) where - mkHsVarOpPV v = return $ cL (getLoc v) (HsVar noExt v) - mkHsConOpPV v = return $ cL (getLoc v) (HsVar noExt v) + mkHsVarOpPV v = return $ cL (getLoc v) (HsVar noExtField v) + mkHsConOpPV v = return $ cL (getLoc v) (HsVar noExtField v) mkHsInfixHolePV l = return $ cL l hsHoleExpr instance DisambInfixOp RdrName where @@ -1973,25 +1973,25 @@ 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 noExt mg) - mkHsLetPV l bs e = return $ cL l (HsCmdLet noExt bs e) + mkHsLamPV l mg = return $ cL l (HsCmdLam noExtField mg) + mkHsLetPV l bs e = return $ cL 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 noExt c - return $ cL l $ HsCmdArrForm noExt op Infix Nothing [cmdArg c1, cmdArg c2] - mkHsCasePV l c mg = return $ cL l (HsCmdCase noExt c mg) + 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) type FunArg (HsCmd p) = HsExpr p superFunArg m = m mkHsAppPV l c e = do checkCmdBlockArguments c checkExpBlockArguments e - return $ cL l (HsCmdApp noExt c e) + return $ cL 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 noExt stmts) - mkHsParPV l c = return $ cL l (HsCmdPar noExt c) + 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) @@ -2027,36 +2027,36 @@ instance p ~ GhcPs => DisambECP (HsExpr p) where nest 2 (ppr c) ] return (cL l hsHoleExpr) ecpFromExp' = return - mkHsLamPV l mg = return $ cL l (HsLam noExt mg) - mkHsLetPV l bs c = return $ cL l (HsLet noExt bs c) + mkHsLamPV l mg = return $ cL l (HsLam noExtField mg) + mkHsLetPV l bs c = return $ cL l (HsLet noExtField bs c) type InfixOp (HsExpr p) = HsExpr p superInfixOp m = m mkHsOpAppPV l e1 op e2 = do - return $ cL l $ OpApp noExt e1 op e2 - mkHsCasePV l e mg = return $ cL l (HsCase noExt e mg) + return $ cL l $ OpApp noExtField e1 op e2 + mkHsCasePV l e mg = return $ cL 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 noExt e1 e2) + return $ cL 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 noExt DoExpr stmts) - mkHsParPV l e = return $ cL l (HsPar noExt e) - mkHsVarPV v@(getLoc -> l) = return $ cL l (HsVar noExt v) - mkHsLitPV (dL->L l a) = return $ cL l (HsLit noExt a) - mkHsOverLitPV (dL->L l a) = return $ cL l (HsOverLit noExt a) + 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 noExt a (mkLHsSigWcType sig)) - mkHsExplicitListPV l xs = return $ cL l (ExplicitList noExt Nothing xs) - mkHsSplicePV sp = return $ mapLoc (HsSpliceE noExt) sp + mkHsTySigPV l a sig = return $ cL l (ExprWithTySig noExtField a (mkLHsSigWcType sig)) + mkHsExplicitListPV l xs = return $ cL 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 noExt a noSyntaxExpr) - mkHsSectionR_PV l op e = return $ cL l (SectionR noExt op e) + mkHsNegAppPV l a = return $ cL l (NegApp noExtField a noSyntaxExpr) + mkHsSectionR_PV l op e = return $ cL l (SectionR noExtField op e) mkHsViewPatPV l a b = patSynErr l (ppr a <+> text "->" <+> ppr b) empty mkHsAsPatPV l v e = do opt_TypeApplications <- getBit TypeApplicationsBit @@ -2077,7 +2077,7 @@ patSynErr l e explanation = ; return (cL l hsHoleExpr) } hsHoleExpr :: HsExpr (GhcPass id) -hsHoleExpr = HsUnboundVar noExt (TrueExprHole (mkVarOcc "_")) +hsHoleExpr = HsUnboundVar noExtField (TrueExprHole (mkVarOcc "_")) -- | See Note [Ambiguous syntactic categories] and Note [PatBuilder] data PatBuilder p @@ -2130,16 +2130,16 @@ instance p ~ GhcPs => DisambECP (PatBuilder p) where mkHsVarPV v@(getLoc -> l) = return $ cL l (PatBuilderVar v) mkHsLitPV lit@(dL->L l a) = do checkUnboxedStringLitPat lit - return $ cL l (PatBuilderPat (LitPat noExt a)) + return $ cL l (PatBuilderPat (LitPat noExtField a)) mkHsOverLitPV (dL->L l a) = return $ cL l (PatBuilderOverLit a) - mkHsWildCardPV l = return $ cL l (PatBuilderPat (WildPat noExt)) + mkHsWildCardPV l = return $ cL l (PatBuilderPat (WildPat noExtField)) mkHsTySigPV l b sig = do p <- checkLPat b - return $ cL l (PatBuilderPat (SigPat noExt p (mkLHsSigWcType sig))) + return $ cL l (PatBuilderPat (SigPat noExtField p (mkLHsSigWcType sig))) mkHsExplicitListPV l xs = do ps <- traverse checkLPat xs - return (cL l (PatBuilderPat (ListPat noExt ps))) - mkHsSplicePV (dL->L l sp) = return $ cL l (PatBuilderPat (SplicePat noExt sp)) + return (cL l (PatBuilderPat (ListPat noExtField ps))) + mkHsSplicePV (dL->L l sp) = return $ cL l (PatBuilderPat (SplicePat noExtField sp)) mkHsRecordPV l _ a (fbinds, ddLoc) = do r <- mkPatRec a (mk_rec_fields fbinds ddLoc) checkRecordSyntax (cL l r) @@ -2153,13 +2153,13 @@ instance p ~ GhcPs => DisambECP (PatBuilder p) where | otherwise = patFail l (pprInfixOcc (unLoc op) <> ppr p) mkHsViewPatPV l a b = do p <- checkLPat b - return $ cL l (PatBuilderPat (ViewPat noExt a p)) + return $ cL l (PatBuilderPat (ViewPat noExtField a p)) mkHsAsPatPV l v e = do p <- checkLPat e - return $ cL l (PatBuilderPat (AsPat noExt v p)) + return $ cL l (PatBuilderPat (AsPat noExtField v p)) mkHsLazyPatPV l e = do p <- checkLPat e - return $ cL l (PatBuilderPat (LazyPat noExt p)) + return $ cL l (PatBuilderPat (LazyPat noExtField p)) mkSumOrTuplePV = mkSumOrTuplePat checkUnboxedStringLitPat :: Located (HsLit GhcPs) -> PV () @@ -2671,13 +2671,13 @@ mkRecConstrOrUpdate exp _ (fs,dd) mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs mkRdrRecordUpd exp flds - = RecordUpd { rupd_ext = noExt + = RecordUpd { rupd_ext = noExtField , rupd_expr = exp , rupd_flds = flds } mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs mkRdrRecordCon con flds - = RecordCon { rcon_ext = noExt, rcon_con_name = con, rcon_flds = flds } + = RecordCon { rcon_ext = noExtField, rcon_con_name = con, rcon_flds = flds } mk_rec_fields :: [LHsRecField id arg] -> Maybe SrcSpan -> HsRecFields id arg mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing } @@ -2686,9 +2686,9 @@ mk_rec_fields fs (Just s) = HsRecFields { rec_flds = fs mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs mk_rec_upd_field (HsRecField (dL->L loc (FieldOcc _ rdr)) arg pun) - = HsRecField (L loc (Unambiguous noExt rdr)) arg pun -mk_rec_upd_field (HsRecField (dL->L _ (XFieldOcc _)) _ _) - = panic "mk_rec_upd_field" + = HsRecField (L loc (Unambiguous noExtField rdr)) arg pun +mk_rec_upd_field (HsRecField (dL->L _ (XFieldOcc nec)) _ _) + = noExtCon nec mk_rec_upd_field (HsRecField _ _ _) = panic "mk_rec_upd_field: Impossible Match" -- due to #15884 @@ -2747,8 +2747,8 @@ mkImport cconv safety (L loc (StringLiteral esrc entity), v, ty) = funcTarget = CFunction (StaticTarget esrc entity' Nothing True) importSpec = CImport cconv safety Nothing funcTarget (cL loc esrc) - returnSpec spec = return $ ForD noExt $ ForeignImport - { fd_i_ext = noExt + returnSpec spec = return $ ForD noExtField $ ForeignImport + { fd_i_ext = noExtField , fd_name = v , fd_sig_ty = ty , fd_fi = spec @@ -2821,8 +2821,8 @@ 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) - = return $ ForD noExt $ - ForeignExport { fd_e_ext = noExt, fd_name = v, fd_sig_ty = 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) } where @@ -2855,11 +2855,11 @@ mkModuleImpExp (dL->L l specname) subs = case subs of ImpExpAbs | isVarNameSpace (rdrNameSpace name) - -> return $ IEVar noExt (cL l (ieNameFromSpec specname)) - | otherwise -> IEThingAbs noExt . cL l <$> nameT - ImpExpAll -> IEThingAll noExt . cL l <$> nameT + -> return $ IEVar noExtField (cL l (ieNameFromSpec specname)) + | otherwise -> IEThingAbs noExtField . cL l <$> nameT + ImpExpAll -> IEThingAll noExtField . cL l <$> nameT ImpExpList xs -> - (\newName -> IEThingWith noExt (cL l newName) + (\newName -> IEThingWith noExtField (cL l newName) NoIEWildcard (wrapped xs) []) <$> nameT ImpExpAllWith xs -> do allowed <- getBit PatternSynonymsBit @@ -2870,7 +2870,7 @@ mkModuleImpExp (dL->L l specname) subs = (findIndex isImpExpQcWildcard withs) ies = wrapped $ filter (not . isImpExpQcWildcard . unLoc) xs in (\newName - -> IEThingWith noExt (cL l newName) pos ies []) + -> IEThingWith noExtField (cL l newName) pos ies []) <$> nameT else addFatalError l (text "Illegal export form (use PatternSynonyms to enable)") @@ -3133,14 +3133,14 @@ mkSumOrTupleExpr :: SrcSpan -> Boxity -> SumOrTuple (HsExpr GhcPs) -> PV (LHsExp -- Tuple mkSumOrTupleExpr l boxity (Tuple es) = - return $ cL l (ExplicitTuple noExt (map toTupArg es) boxity) + return $ cL l (ExplicitTuple noExtField (map toTupArg es) boxity) where toTupArg :: Located (Maybe (LHsExpr GhcPs)) -> LHsTupArg GhcPs - toTupArg = mapLoc (maybe missingTupArg (Present noExt)) + toTupArg = mapLoc (maybe missingTupArg (Present noExtField)) -- Sum mkSumOrTupleExpr l Unboxed (Sum alt arity e) = - return $ cL l (ExplicitSum noExt alt arity e) + return $ cL l (ExplicitSum noExtField alt arity e) mkSumOrTupleExpr l Boxed a@Sum{} = addFatalError l (hang (text "Boxed sums not supported:") 2 (pprSumOrTuple Boxed a)) @@ -3150,7 +3150,7 @@ mkSumOrTuplePat :: SrcSpan -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> PV (Loc -- Tuple mkSumOrTuplePat l boxity (Tuple ps) = do ps' <- traverse toTupPat ps - return $ cL l (PatBuilderPat (TuplePat noExt ps' boxity)) + return $ cL l (PatBuilderPat (TuplePat noExtField ps' boxity)) where toTupPat :: Located (Maybe (Located (PatBuilder GhcPs))) -> PV (LPat GhcPs) toTupPat (dL -> L l p) = case p of @@ -3160,7 +3160,7 @@ mkSumOrTuplePat l boxity (Tuple ps) = do -- Sum mkSumOrTuplePat l Unboxed (Sum alt arity p) = do p' <- checkLPat p - return $ cL l (PatBuilderPat (SumPat noExt p' alt arity)) + return $ cL l (PatBuilderPat (SumPat noExtField p' alt arity)) mkSumOrTuplePat l Boxed a@Sum{} = addFatalError l (hang (text "Boxed sums not supported:") 2 (pprSumOrTuple Boxed a)) @@ -3173,7 +3173,7 @@ mkLHsOpTy x op y = mkLHsDocTy :: LHsType GhcPs -> LHsDocString -> LHsType GhcPs mkLHsDocTy t doc = let loc = getLoc t `combineSrcSpans` getLoc doc - in cL loc (HsDocTy noExt t doc) + in cL loc (HsDocTy noExtField t doc) mkLHsDocTyMaybe :: LHsType GhcPs -> Maybe LHsDocString -> LHsType GhcPs mkLHsDocTyMaybe t = maybe t (mkLHsDocTy t) diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs index 22f2cf3e9f..db21552221 100644 --- a/compiler/rename/RnBinds.hs +++ b/compiler/rename/RnBinds.hs @@ -215,19 +215,19 @@ rnLocalBindsAndThen (HsIPBinds x binds) thing_inside = do (thing, fvs_thing) <- thing_inside (HsIPBinds x binds') fv_binds return (thing, fvs_thing `plusFV` fv_binds) -rnLocalBindsAndThen (XHsLocalBindsLR _) _ = panic "rnLocalBindsAndThen" +rnLocalBindsAndThen (XHsLocalBindsLR nec) _ = noExtCon nec rnIPBinds :: HsIPBinds GhcPs -> RnM (HsIPBinds GhcRn, FreeVars) rnIPBinds (IPBinds _ ip_binds ) = do (ip_binds', fvs_s) <- mapAndUnzipM (wrapLocFstM rnIPBind) ip_binds - return (IPBinds noExt ip_binds', plusFVs fvs_s) -rnIPBinds (XHsIPBinds _) = panic "rnIPBinds" + return (IPBinds noExtField ip_binds', plusFVs fvs_s) +rnIPBinds (XHsIPBinds nec) = noExtCon nec rnIPBind :: IPBind GhcPs -> RnM (IPBind GhcRn, FreeVars) rnIPBind (IPBind _ ~(Left n) expr) = do (expr',fvExpr) <- rnLExpr expr - return (IPBind noExt (Left n) expr', fvExpr) -rnIPBind (XIPBind _) = panic "rnIPBind" + return (IPBind noExtField (Left n) expr', fvExpr) +rnIPBind (XIPBind nec) = noExtCon nec {- ************************************************************************ @@ -422,19 +422,19 @@ rnBindLHS name_maker _ bind@(PatBind { pat_lhs = pat }) rnBindLHS name_maker _ bind@(FunBind { fun_id = rdr_name }) = do { name <- applyNameMaker name_maker rdr_name ; return (bind { fun_id = name - , fun_ext = noExt }) } + , fun_ext = noExtField }) } rnBindLHS name_maker _ (PatSynBind x psb@PSB{ psb_id = rdrname }) | isTopRecNameMaker name_maker = do { addLocM checkConName rdrname ; name <- lookupLocatedTopBndrRn rdrname -- Should be in scope already - ; return (PatSynBind x psb{ psb_ext = noExt, psb_id = name }) } + ; return (PatSynBind x psb{ psb_ext = noExtField, psb_id = name }) } | otherwise -- Pattern synonym, not at top level = do { addErr localPatternSynonymErr -- Complain, but make up a fake -- name so that we can carry on ; name <- applyNameMaker name_maker rdrname - ; return (PatSynBind x psb{ psb_ext = noExt, psb_id = name }) } + ; return (PatSynBind x psb{ psb_ext = noExtField, psb_id = name }) } where localPatternSynonymErr :: SDoc localPatternSynonymErr @@ -629,7 +629,7 @@ makeMiniFixityEnv decls = foldlM add_one_sig emptyFsEnv decls add_one_sig env (L loc (FixitySig _ names fixity)) = foldlM add_one env [ (loc,name_loc,name,fixity) | L name_loc name <- names ] - add_one_sig _ (L _ (XFixitySig _)) = panic "makeMiniFixityEnv" + add_one_sig _ (L _ (XFixitySig nec)) = noExtCon nec add_one env (loc, name_loc, name,fixity) = do { -- this fixity decl is a duplicate iff @@ -740,7 +740,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name = hang (text "Illegal pattern synonym declaration") 2 (text "Use -XPatternSynonyms to enable this extension") -rnPatSynBind _ (XPatSynBind _) = panic "rnPatSynBind" +rnPatSynBind _ (XPatSynBind nec) = noExtCon nec {- Note [Renaming pattern synonym variables] @@ -895,7 +895,7 @@ rnMethodBindLHS _ cls (L loc bind@(FunBind { fun_id = name })) rest = setSrcSpan loc $ do do { sel_name <- wrapLocM (lookupInstDeclBndr cls (text "method")) name -- We use the selector name as the binder - ; let bind' = bind { fun_id = sel_name, fun_ext = noExt } + ; let bind' = bind { fun_id = sel_name, fun_ext = noExtField } ; return (L loc bind' `consBag` rest ) } -- Report error for all other forms of bindings @@ -959,13 +959,13 @@ renameSigs ctxt sigs renameSig :: HsSigCtxt -> Sig GhcPs -> RnM (Sig GhcRn, FreeVars) renameSig _ (IdSig _ x) - = return (IdSig noExt x, emptyFVs) -- Actually this never occurs + = return (IdSig noExtField x, emptyFVs) -- Actually this never occurs renameSig ctxt sig@(TypeSig _ vs ty) = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs ; let doc = TypeSigCtx (ppr_sig_bndrs vs) ; (new_ty, fvs) <- rnHsSigWcType BindUnlessForall doc ty - ; return (TypeSig noExt new_vs new_ty, fvs) } + ; return (TypeSig noExtField new_vs new_ty, fvs) } renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty) = do { defaultSigs_on <- xoptM LangExt.DefaultSignatures @@ -973,7 +973,7 @@ renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty) addErr (defaultSigErr sig) ; new_v <- mapM (lookupSigOccRn ctxt sig) vs ; (new_ty, fvs) <- rnHsSigType ty_ctxt ty - ; return (ClassOpSig noExt is_deflt new_v new_ty, fvs) } + ; return (ClassOpSig noExtField is_deflt new_v new_ty, fvs) } where (v1:_) = vs ty_ctxt = GenericCtx (text "a class method signature for" @@ -981,7 +981,7 @@ renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty) renameSig _ (SpecInstSig _ src ty) = do { (new_ty, fvs) <- rnHsSigType SpecInstSigCtx ty - ; return (SpecInstSig noExt src new_ty,fvs) } + ; return (SpecInstSig noExtField src new_ty,fvs) } -- {-# SPECIALISE #-} pragmas can refer to imported Ids -- so, in the top-level case (when mb_names is Nothing) @@ -992,7 +992,7 @@ renameSig ctxt sig@(SpecSig _ v tys inl) TopSigCtxt {} -> lookupLocatedOccRn v _ -> lookupSigOccRn ctxt sig v ; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys - ; return (SpecSig noExt new_v new_ty inl, fvs) } + ; return (SpecSig noExtField new_v new_ty inl, fvs) } where ty_ctxt = GenericCtx (text "a SPECIALISE signature for" <+> quotes (ppr v)) @@ -1002,27 +1002,27 @@ renameSig ctxt sig@(SpecSig _ v tys inl) renameSig ctxt sig@(InlineSig _ v s) = do { new_v <- lookupSigOccRn ctxt sig v - ; return (InlineSig noExt new_v s, emptyFVs) } + ; return (InlineSig noExtField new_v s, emptyFVs) } renameSig ctxt (FixSig _ fsig) = do { new_fsig <- rnSrcFixityDecl ctxt fsig - ; return (FixSig noExt new_fsig, emptyFVs) } + ; return (FixSig noExtField new_fsig, emptyFVs) } renameSig ctxt sig@(MinimalSig _ s (L l bf)) = do new_bf <- traverse (lookupSigOccRn ctxt sig) bf - return (MinimalSig noExt s (L l new_bf), emptyFVs) + return (MinimalSig noExtField s (L l new_bf), emptyFVs) renameSig ctxt sig@(PatSynSig _ vs ty) = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs ; (ty', fvs) <- rnHsSigType ty_ctxt ty - ; return (PatSynSig noExt new_vs ty', fvs) } + ; return (PatSynSig noExtField new_vs ty', fvs) } where ty_ctxt = GenericCtx (text "a pattern synonym signature for" <+> ppr_sig_bndrs vs) renameSig ctxt sig@(SCCFunSig _ st v s) = do { new_v <- lookupSigOccRn ctxt sig v - ; return (SCCFunSig noExt st new_v s, emptyFVs) } + ; return (SCCFunSig noExtField st new_v s, emptyFVs) } -- COMPLETE Sigs can refer to imported IDs which is why we use -- lookupLocatedOccRn rather than lookupSigOccRn @@ -1035,7 +1035,7 @@ renameSig _ctxt sig@(CompleteMatchSig _ s (L l bf) mty) -- Why 'any'? See Note [Orphan COMPLETE pragmas] addErrCtxt (text "In" <+> ppr sig) $ failWithTc orphanError - return (CompleteMatchSig noExt s (L l new_bf) new_mty, emptyFVs) + return (CompleteMatchSig noExtField s (L l new_bf) new_mty, emptyFVs) where orphanError :: SDoc orphanError = @@ -1043,7 +1043,7 @@ renameSig _ctxt sig@(CompleteMatchSig _ s (L l bf) mty) text "A COMPLETE pragma must mention at least one data constructor" $$ text "or pattern synonym defined in the same module." -renameSig _ (XSig _) = panic "renameSig" +renameSig _ (XSig nec) = noExtCon nec {- Note [Orphan COMPLETE pragmas] @@ -1070,7 +1070,7 @@ complexity of supporting them properly doesn't seem worthwhile. ppr_sig_bndrs :: [Located RdrName] -> SDoc ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs) -okHsSig :: HsSigCtxt -> LSig a -> Bool +okHsSig :: HsSigCtxt -> LSig (GhcPass a) -> Bool okHsSig ctxt (L _ sig) = case (sig, ctxt) of (ClassOpSig {}, ClsDeclCtxt {}) -> True @@ -1111,7 +1111,7 @@ okHsSig ctxt (L _ sig) (CompleteMatchSig {}, TopSigCtxt {} ) -> True (CompleteMatchSig {}, _) -> False - (XSig _, _) -> panic "okHsSig" + (XSig nec, _) -> noExtCon nec ------------------- findDupSigs :: [LSig GhcPs] -> [NonEmpty (Located RdrName, Sig GhcPs)] @@ -1167,7 +1167,7 @@ rnMatchGroup ctxt rnBody (MG { mg_alts = L _ ms, mg_origin = origin }) ; when (null ms && not empty_case_ok) (addErr (emptyCaseErr ctxt)) ; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt rnBody) ms ; return (mkMatchGroup origin new_ms, ms_fvs) } -rnMatchGroup _ _ (XMatchGroup {}) = panic "rnMatchGroup" +rnMatchGroup _ _ (XMatchGroup nec) = noExtCon nec rnMatch :: Outputable (body GhcPs) => HsMatchContext Name -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)) @@ -1187,9 +1187,9 @@ rnMatch' ctxt rnBody (Match { m_ctxt = mf, m_pats = pats, m_grhss = grhss }) (FunRhs { mc_fun = L _ funid }, FunRhs { mc_fun = L lf _ }) -> mf { mc_fun = L lf funid } _ -> ctxt - ; return (Match { m_ext = noExt, m_ctxt = mf', m_pats = pats' + ; return (Match { m_ext = noExtField, m_ctxt = mf', m_pats = pats' , m_grhss = grhss'}, grhss_fvs ) }} -rnMatch' _ _ (XMatch _) = panic "rnMatch'" +rnMatch' _ _ (XMatch nec) = noExtCon nec emptyCaseErr :: HsMatchContext Name -> SDoc emptyCaseErr ctxt = hang (text "Empty list of alternatives in" <+> pp_ctxt) @@ -1215,8 +1215,8 @@ rnGRHSs :: HsMatchContext Name rnGRHSs ctxt rnBody (GRHSs _ grhss (L l binds)) = rnLocalBindsAndThen binds $ \ binds' _ -> do (grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt rnBody) grhss - return (GRHSs noExt grhss' (L l binds'), fvGRHSs) -rnGRHSs _ _ (XGRHSs _) = panic "rnGRHSs" + return (GRHSs noExtField grhss' (L l binds'), fvGRHSs) +rnGRHSs _ _ (XGRHSs nec) = noExtCon nec rnGRHS :: HsMatchContext Name -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)) @@ -1236,7 +1236,7 @@ rnGRHS' ctxt rnBody (GRHS _ guards rhs) ; unless (pattern_guards_allowed || is_standard_guard guards') (addWarn NoReason (nonStdGuardErr guards')) - ; return (GRHS noExt guards' rhs', fvs) } + ; return (GRHS noExtField guards' rhs', fvs) } where -- Standard Haskell 1.4 guards are just a single boolean -- expression, rather than a list of qualifiers as in the @@ -1244,7 +1244,7 @@ rnGRHS' ctxt rnBody (GRHS _ guards rhs) is_standard_guard [] = True is_standard_guard [L _ (BodyStmt {})] = True is_standard_guard _ = False -rnGRHS' _ _ (XGRHS _) = panic "rnGRHS'" +rnGRHS' _ _ (XGRHS nec) = noExtCon nec {- ********************************************************* @@ -1267,8 +1267,8 @@ rnSrcFixityDecl sig_ctxt = rn_decl -- return a fixity sig for each (slightly odd) rn_decl (FixitySig _ fnames fixity) = do names <- concatMapM lookup_one fnames - return (FixitySig noExt names fixity) - rn_decl (XFixitySig _) = panic "rnSrcFixityDecl" + return (FixitySig noExtField names fixity) + rn_decl (XFixitySig nec) = noExtCon nec lookup_one :: Located RdrName -> RnM [Located Name] lookup_one (L name_loc rdr_name) diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 772122bb99..91cf8f22f4 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -1658,10 +1658,10 @@ lookupSyntaxNames :: [Name] -- Standard names lookupSyntaxNames std_names = do { rebindable_on <- xoptM LangExt.RebindableSyntax ; if not rebindable_on then - return (map (HsVar noExt . noLoc) std_names, emptyFVs) + return (map (HsVar noExtField . noLoc) std_names, emptyFVs) else do { usr_names <- mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names - ; return (map (HsVar noExt . noLoc) usr_names, mkFVs usr_names) } } + ; return (map (HsVar noExtField . noLoc) usr_names, mkFVs usr_names) } } -- Error messages diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 98d487df2d..eadb4bca03 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -100,7 +100,7 @@ finishHsVar (L l name) = do { this_mod <- getModule ; when (nameIsLocalOrFrom this_mod name) $ checkThLocalName name - ; return (HsVar noExt (L l name), unitFV name) } + ; return (HsVar noExtField (L l name), unitFV name) } rnUnboundVar :: RdrName -> RnM (HsExpr GhcRn, FreeVars) rnUnboundVar v @@ -112,11 +112,11 @@ rnUnboundVar v ; uv <- if startsWithUnderscore occ then return (TrueExprHole occ) else OutOfScope occ <$> getGlobalRdrEnv - ; return (HsUnboundVar noExt uv, emptyFVs) } + ; return (HsUnboundVar noExtField uv, emptyFVs) } else -- Fail immediately (qualified name) do { n <- reportUnboundName v - ; return (HsVar noExt (noLoc n), emptyFVs) } } + ; return (HsVar noExtField (noLoc n), emptyFVs) } } rnExpr (HsVar _ (L l v)) = do { opt_DuplicateRecordFields <- xoptM LangExt.DuplicateRecordFields @@ -126,14 +126,14 @@ rnExpr (HsVar _ (L l v)) Just (Left name) | name == nilDataConName -- Treat [] as an ExplicitList, so that -- OverloadedLists works correctly - -> rnExpr (ExplicitList noExt Nothing []) + -> rnExpr (ExplicitList noExtField Nothing []) | otherwise -> finishHsVar (L l name) ; Just (Right [s]) -> - return ( HsRecFld noExt (Unambiguous s (L l v) ), unitFV s) ; + return ( HsRecFld noExtField (Unambiguous s (L l v) ), unitFV s) ; Just (Right fs@(_:_:_)) -> - return ( HsRecFld noExt (Ambiguous noExt (L l v)) + return ( HsRecFld noExtField (Ambiguous noExtField (L l v)) , mkFVs fs); Just (Right []) -> panic "runExpr/HsVar" } } @@ -290,9 +290,9 @@ rnExpr (ExplicitTuple x tup_args boxity) where rnTupArg (L l (Present x e)) = do { (e',fvs) <- rnLExpr e ; return (L l (Present x e'), fvs) } - rnTupArg (L l (Missing _)) = return (L l (Missing noExt) + rnTupArg (L l (Missing _)) = return (L l (Missing noExtField) , emptyFVs) - rnTupArg (L _ (XTupArg {})) = panic "rnExpr.XTupArg" + rnTupArg (L _ (XTupArg nec)) = noExtCon nec rnExpr (ExplicitSum x alt arity expr) = do { (expr', fvs) <- rnLExpr expr @@ -304,18 +304,18 @@ rnExpr (RecordCon { rcon_con_name = con_id ; (flds, fvs) <- rnHsRecFields (HsRecFieldCon con_name) mk_hs_var rec_binds ; (flds', fvss) <- mapAndUnzipM rn_field flds ; let rec_binds' = HsRecFields { rec_flds = flds', rec_dotdot = dd } - ; return (RecordCon { rcon_ext = noExt + ; return (RecordCon { rcon_ext = noExtField , rcon_con_name = con_lname, rcon_flds = rec_binds' } , fvs `plusFV` plusFVs fvss `addOneFV` con_name) } where - mk_hs_var l n = HsVar noExt (L l n) + mk_hs_var l n = HsVar noExtField (L l n) rn_field (L l fld) = do { (arg', fvs) <- rnLExpr (hsRecFieldArg fld) ; return (L l (fld { hsRecFieldArg = arg' }), fvs) } rnExpr (RecordUpd { rupd_expr = expr, rupd_flds = rbinds }) = do { (expr', fvExpr) <- rnLExpr expr ; (rbinds', fvRbinds) <- rnHsRecUpdFields rbinds - ; return (RecordUpd { rupd_ext = noExt, rupd_expr = expr' + ; return (RecordUpd { rupd_ext = noExtField, rupd_expr = expr' , rupd_flds = rbinds' } , fvExpr `plusFV` fvRbinds) } @@ -323,7 +323,7 @@ rnExpr (ExprWithTySig _ expr pty) = do { (pty', fvTy) <- rnHsSigWcType BindUnlessForall ExprWithTySigCtx pty ; (expr', fvExpr) <- bindSigTyVarsFV (hsWcScopedTvs pty') $ rnLExpr expr - ; return (ExprWithTySig noExt expr' pty', fvExpr `plusFV` fvTy) } + ; return (ExprWithTySig noExtField expr' pty', fvExpr `plusFV` fvTy) } rnExpr (HsIf x _ p b1 b2) = do { (p', fvP) <- rnLExpr p @@ -444,7 +444,7 @@ rnCmdTop = wrapLocFstM rnCmdTop' ; return (HsCmdTop (cmd_names `zip` cmd_names') cmd', fvCmd `plusFV` cmd_fvs) } - rnCmdTop' (XCmdTop{}) = panic "rnCmdTop" + rnCmdTop' (XCmdTop nec) = noExtCon nec rnLCmd :: LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars) rnLCmd = wrapLocFstM rnCmd @@ -518,7 +518,7 @@ rnCmd (HsCmdDo x (L l stmts)) ; return ( HsCmdDo x (L l stmts'), fvs ) } rnCmd cmd@(HsCmdWrap {}) = pprPanic "rnCmd" (ppr cmd) -rnCmd cmd@(XCmd {}) = pprPanic "rnCmd" (ppr cmd) +rnCmd (XCmd nec) = noExtCon nec --------------------------------------------------- type CmdNeeds = FreeVars -- Only inhabitants are @@ -550,7 +550,7 @@ methodNamesCmd (HsCmdLam _ match) = methodNamesMatch match methodNamesCmd (HsCmdCase _ _ matches) = methodNamesMatch matches `addOneFV` choiceAName -methodNamesCmd (XCmd {}) = panic "methodNamesCmd" +methodNamesCmd (XCmd nec) = noExtCon nec --methodNamesCmd _ = emptyFVs -- Other forms can't occur in commands, but it's not convenient @@ -563,20 +563,20 @@ methodNamesMatch (MG { mg_alts = L _ ms }) = plusFVs (map do_one ms) where do_one (L _ (Match { m_grhss = grhss })) = methodNamesGRHSs grhss - do_one (L _ (XMatch _)) = panic "methodNamesMatch.XMatch" -methodNamesMatch (XMatchGroup _) = panic "methodNamesMatch" + do_one (L _ (XMatch nec)) = noExtCon nec +methodNamesMatch (XMatchGroup nec) = noExtCon nec ------------------------------------------------- -- gaw 2004 methodNamesGRHSs :: GRHSs GhcRn (LHsCmd GhcRn) -> FreeVars methodNamesGRHSs (GRHSs _ grhss _) = plusFVs (map methodNamesGRHS grhss) -methodNamesGRHSs (XGRHSs _) = panic "methodNamesGRHSs" +methodNamesGRHSs (XGRHSs nec) = noExtCon nec ------------------------------------------------- methodNamesGRHS :: Located (GRHS GhcRn (LHsCmd GhcRn)) -> CmdNeeds methodNamesGRHS (L _ (GRHS _ _ rhs)) = methodNamesLCmd rhs -methodNamesGRHS (L _ (XGRHS _)) = panic "methodNamesGRHS" +methodNamesGRHS (L _ (XGRHS nec)) = noExtCon nec --------------------------------------------------- methodNamesStmts :: [Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn))] -> FreeVars @@ -598,7 +598,7 @@ methodNamesStmt (TransStmt {}) = emptyFVs methodNamesStmt ApplicativeStmt{} = emptyFVs -- ParStmt and TransStmt can't occur in commands, but it's not -- convenient to error here so we just do what's convenient -methodNamesStmt (XStmtLR {}) = panic "methodNamesStmt" +methodNamesStmt (XStmtLR nec) = noExtCon nec {- ************************************************************************ @@ -811,7 +811,7 @@ rnStmt ctxt rnBody (L loc (LastStmt _ body noret _)) thing_inside -- #15607 ; (thing, fvs3) <- thing_inside [] - ; return (([(L loc (LastStmt noExt body' noret ret_op), fv_expr)] + ; return (([(L loc (LastStmt noExtField body' noret ret_op), fv_expr)] , thing), fv_expr `plusFV` fvs1 `plusFV` fvs3) } rnStmt ctxt rnBody (L loc (BodyStmt _ body _ _)) thing_inside @@ -826,7 +826,7 @@ rnStmt ctxt rnBody (L loc (BodyStmt _ body _ _)) thing_inside -- Here "gd" is a guard ; (thing, fvs3) <- thing_inside [] - ; return ( ([(L loc (BodyStmt noExt body' then_op guard_op), fv_expr)] + ; return ( ([(L loc (BodyStmt noExtField body' then_op guard_op), fv_expr)] , thing), fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) } rnStmt ctxt rnBody (L loc (BindStmt _ pat body _ _)) thing_inside @@ -838,7 +838,7 @@ rnStmt ctxt rnBody (L loc (BindStmt _ pat body _ _)) thing_inside ; rnPat (StmtCtxt ctxt) pat $ \ pat' -> do { (thing, fvs3) <- thing_inside (collectPatBinders pat') - ; return (( [( L loc (BindStmt noExt pat' body' bind_op fail_op) + ; return (( [( L loc (BindStmt noExtField pat' body' bind_op fail_op) , fv_expr )] , thing), fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) }} @@ -848,7 +848,7 @@ rnStmt ctxt rnBody (L loc (BindStmt _ pat body _ _)) thing_inside rnStmt _ _ (L loc (LetStmt _ (L l binds))) thing_inside = do { rnLocalBindsAndThen binds $ \binds' bind_fvs -> do { (thing, fvs) <- thing_inside (collectLocalBinders binds') - ; return ( ([(L loc (LetStmt noExt (L l binds')), bind_fvs)], thing) + ; return ( ([(L loc (LetStmt noExtField (L l binds')), bind_fvs)], thing) , fvs) } } rnStmt ctxt rnBody (L loc (RecStmt { recS_stmts = rec_stmts })) thing_inside @@ -886,7 +886,7 @@ rnStmt ctxt _ (L loc (ParStmt _ segs _ _)) thing_inside ; (bind_op, fvs2) <- lookupStmtName ctxt bindMName ; (return_op, fvs3) <- lookupStmtName ctxt returnMName ; ((segs', thing), fvs4) <- rnParallelStmts (ParStmtCtxt ctxt) return_op segs thing_inside - ; return (([(L loc (ParStmt noExt segs' mzip_op bind_op), fvs4)], thing) + ; return (([(L loc (ParStmt noExtField segs' mzip_op bind_op), fvs4)], thing) , fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) } rnStmt ctxt _ (L loc (TransStmt { trS_stmts = stmts, trS_by = by, trS_form = form @@ -919,7 +919,7 @@ rnStmt ctxt _ (L loc (TransStmt { trS_stmts = stmts, trS_by = by, trS_form = for -- See Note [TransStmt binder map] in HsExpr ; traceRn "rnStmt: implicitly rebound these used binders:" (ppr bndr_map) - ; return (([(L loc (TransStmt { trS_ext = noExt + ; return (([(L loc (TransStmt { trS_ext = noExtField , trS_stmts = stmts', trS_bndrs = bndr_map , trS_by = by', trS_using = using', trS_form = form , trS_ret = return_op, trS_bind = bind_op @@ -928,8 +928,8 @@ rnStmt ctxt _ (L loc (TransStmt { trS_stmts = stmts, trS_by = by, trS_form = for rnStmt _ _ (L _ ApplicativeStmt{}) _ = panic "rnStmt: ApplicativeStmt" -rnStmt _ _ (L _ XStmtLR{}) _ = - panic "rnStmt: XStmtLR" +rnStmt _ _ (L _ (XStmtLR nec)) _ = + noExtCon nec rnParallelStmts :: forall thing. HsStmtContext Name -> SyntaxExpr GhcRn @@ -960,7 +960,7 @@ rnParallelStmts ctxt return_op segs thing_inside ; let seg' = ParStmtBlock x stmts' used_bndrs return_op ; return ((seg':segs', thing), fvs) } - rn_segs _ _ (XParStmtBlock{}:_) = panic "rnParallelStmts" + rn_segs _ _ (XParStmtBlock nec:_) = noExtCon nec cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2 dupErr vs = addErr (text "Duplicate binding in parallel list comprehension for:" @@ -980,12 +980,12 @@ lookupStmtNamePoly ctxt name = do { rebindable_on <- xoptM LangExt.RebindableSyntax ; if rebindable_on then do { fm <- lookupOccRn (nameRdrName name) - ; return (HsVar noExt (noLoc fm), unitFV fm) } + ; return (HsVar noExtField (noLoc fm), unitFV fm) } else not_rebindable } | otherwise = not_rebindable where - not_rebindable = return (HsVar noExt (noLoc name), emptyFVs) + not_rebindable = return (HsVar noExtField (noLoc name), emptyFVs) -- | Is this a context where we respect RebindableSyntax? -- but ListComp are never rebindable @@ -1093,23 +1093,23 @@ rn_rec_stmt_lhs :: Outputable body => MiniFixityEnv -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)] rn_rec_stmt_lhs _ (L loc (BodyStmt _ body a b)) - = return [(L loc (BodyStmt noExt body a b), emptyFVs)] + = return [(L loc (BodyStmt noExtField body a b), emptyFVs)] rn_rec_stmt_lhs _ (L loc (LastStmt _ body noret a)) - = return [(L loc (LastStmt noExt body noret a), emptyFVs)] + = return [(L loc (LastStmt noExtField body noret a), emptyFVs)] rn_rec_stmt_lhs fix_env (L loc (BindStmt _ pat body a b)) = do -- should the ctxt be MDo instead? (pat', fv_pat) <- rnBindPat (localRecNameMaker fix_env) pat - return [(L loc (BindStmt noExt pat' body a b), fv_pat)] + return [(L loc (BindStmt noExtField pat' body a b), fv_pat)] rn_rec_stmt_lhs _ (L _ (LetStmt _ (L _ binds@(HsIPBinds {})))) = failWith (badIpBinds (text "an mdo expression") binds) rn_rec_stmt_lhs fix_env (L loc (LetStmt _ (L l (HsValBinds x binds)))) = do (_bound_names, binds') <- rnLocalValBindsLHS fix_env binds - return [(L loc (LetStmt noExt (L l (HsValBinds x binds'))), + return [(L loc (LetStmt noExtField (L l (HsValBinds x binds'))), -- Warning: this is bogus; see function invariant emptyFVs )] @@ -1129,10 +1129,10 @@ rn_rec_stmt_lhs _ stmt@(L _ (ApplicativeStmt {})) -- Shouldn't appear yet rn_rec_stmt_lhs _ (L _ (LetStmt _ (L _ (EmptyLocalBinds _)))) = panic "rn_rec_stmt LetStmt EmptyLocalBinds" -rn_rec_stmt_lhs _ (L _ (LetStmt _ (L _ (XHsLocalBindsLR _)))) - = panic "rn_rec_stmt LetStmt XHsLocalBindsLR" -rn_rec_stmt_lhs _ (L _ (XStmtLR _)) - = panic "rn_rec_stmt XStmtLR" +rn_rec_stmt_lhs _ (L _ (LetStmt _ (L _ (XHsLocalBindsLR nec)))) + = noExtCon nec +rn_rec_stmt_lhs _ (L _ (XStmtLR nec)) + = noExtCon nec rn_rec_stmts_lhs :: Outputable body => MiniFixityEnv -> [LStmt GhcPs body] @@ -1161,13 +1161,13 @@ rn_rec_stmt rnBody _ (L loc (LastStmt _ body noret _), _) = do { (body', fv_expr) <- rnBody body ; (ret_op, fvs1) <- lookupSyntaxName returnMName ; return [(emptyNameSet, fv_expr `plusFV` fvs1, emptyNameSet, - L loc (LastStmt noExt body' noret ret_op))] } + L loc (LastStmt noExtField body' noret ret_op))] } rn_rec_stmt rnBody _ (L loc (BodyStmt _ body _ _), _) = do { (body', fvs) <- rnBody body ; (then_op, fvs1) <- lookupSyntaxName thenMName ; return [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet, - L loc (BodyStmt noExt body' then_op noSyntaxExpr))] } + L loc (BodyStmt noExtField body' then_op noSyntaxExpr))] } rn_rec_stmt rnBody _ (L loc (BindStmt _ pat' body _ _), fv_pat) = do { (body', fv_expr) <- rnBody body @@ -1178,7 +1178,7 @@ rn_rec_stmt rnBody _ (L loc (BindStmt _ pat' body _ _), fv_pat) ; let bndrs = mkNameSet (collectPatBinders pat') fvs = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2 ; return [(bndrs, fvs, bndrs `intersectNameSet` fvs, - L loc (BindStmt noExt pat' body' bind_op fail_op))] } + L loc (BindStmt noExtField pat' body' bind_op fail_op))] } rn_rec_stmt _ _ (L _ (LetStmt _ (L _ binds@(HsIPBinds {}))), _) = failWith (badIpBinds (text "an mdo expression") binds) @@ -1188,7 +1188,7 @@ rn_rec_stmt _ all_bndrs (L loc (LetStmt _ (L l (HsValBinds x binds'))), _) -- fixities and unused are handled above in rnRecStmtsAndThen ; let fvs = allUses du_binds ; return [(duDefs du_binds, fvs, emptyNameSet, - L loc (LetStmt noExt (L l (HsValBinds x binds'))))] } + L loc (LetStmt noExtField (L l (HsValBinds x binds'))))] } -- no RecStmt case because they get flattened above when doing the LHSes rn_rec_stmt _ _ stmt@(L _ (RecStmt {}), _) @@ -1200,8 +1200,8 @@ rn_rec_stmt _ _ stmt@(L _ (ParStmt {}), _) -- Syntactically illegal in mdo rn_rec_stmt _ _ stmt@(L _ (TransStmt {}), _) -- Syntactically illegal in mdo = pprPanic "rn_rec_stmt: TransStmt" (ppr stmt) -rn_rec_stmt _ _ (L _ (LetStmt _ (L _ (XHsLocalBindsLR _))), _) - = panic "rn_rec_stmt: LetStmt XHsLocalBindsLR" +rn_rec_stmt _ _ (L _ (LetStmt _ (L _ (XHsLocalBindsLR nec))), _) + = noExtCon nec rn_rec_stmt _ _ (L _ (LetStmt _ (L _ (EmptyLocalBinds _))), _) = panic "rn_rec_stmt: LetStmt EmptyLocalBinds" @@ -1209,8 +1209,8 @@ rn_rec_stmt _ _ (L _ (LetStmt _ (L _ (EmptyLocalBinds _))), _) rn_rec_stmt _ _ stmt@(L _ (ApplicativeStmt {}), _) = pprPanic "rn_rec_stmt: ApplicativeStmt" (ppr stmt) -rn_rec_stmt _ _ stmt@(L _ (XStmtLR {}), _) - = pprPanic "rn_rec_stmt: XStmtLR" (ppr stmt) +rn_rec_stmt _ _ (L _ (XStmtLR nec), _) + = noExtCon nec rn_rec_stmts :: Outputable (body GhcPs) => (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)) @@ -1647,12 +1647,12 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BindStmt _ pat rhs _ _), _)) tail _tail_fvs | not (isStrictPattern pat), (False,tail') <- needJoin monad_names tail -- See Note [ApplicativeDo and strict patterns] - = mkApplicativeStmt ctxt [ApplicativeArgOne noExt pat rhs False] False tail' + = mkApplicativeStmt ctxt [ApplicativeArgOne noExtField pat rhs False] False tail' stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ _),_)) tail _tail_fvs | (False,tail') <- needJoin monad_names tail = mkApplicativeStmt ctxt - [ApplicativeArgOne noExt nlWildPatName rhs True] False tail' + [ApplicativeArgOne noExtField nlWildPatName rhs True] False tail' stmtTreeToStmts _monad_names _ctxt (StmtTreeOne (s,_)) tail _tail_fvs = return (s : tail, emptyNameSet) @@ -1671,9 +1671,9 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do return (stmts, unionNameSets (fvs:fvss)) where stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BindStmt _ pat exp _ _), _)) - = return (ApplicativeArgOne noExt pat exp False, emptyFVs) + = return (ApplicativeArgOne noExtField pat exp False, emptyFVs) stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ _), _)) = - return (ApplicativeArgOne noExt nlWildPatName exp True, emptyFVs) + return (ApplicativeArgOne noExtField nlWildPatName exp True, emptyFVs) stmtTreeArg ctxt tail_fvs tree = do let stmts = flattenStmtTree tree pvarset = mkNameSet (concatMap (collectStmtBinders.unLoc.fst) stmts) @@ -1688,8 +1688,8 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do return (unLoc tup, emptyNameSet) | otherwise -> do (ret,fvs) <- lookupStmtNamePoly ctxt returnMName - return (HsApp noExt (noLoc ret) tup, fvs) - return ( ApplicativeArgMany noExt stmts' mb_ret pat + return (HsApp noExtField (noLoc ret) tup, fvs) + return ( ApplicativeArgMany noExtField stmts' mb_ret pat , fvs1 `plusFV` fvs2) @@ -1832,7 +1832,7 @@ slurpIndependentStmts stmts = go [] [] emptyNameSet stmts -- an infinite loop (#14163). go lets indep bndrs ((L loc (BindStmt _ pat body bind_op fail_op), fvs): rest) | isEmptyNameSet (bndrs `intersectNameSet` fvs) && not (isStrictPattern pat) - = go lets ((L loc (BindStmt noExt pat body bind_op fail_op), fvs) : indep) + = go lets ((L loc (BindStmt noExtField pat body bind_op fail_op), fvs) : indep) bndrs' rest where bndrs' = bndrs `unionNameSet` mkNameSet (collectPatBinders pat) -- If we encounter a LetStmt that doesn't depend on a BindStmt in this @@ -1840,9 +1840,9 @@ slurpIndependentStmts stmts = go [] [] emptyNameSet stmts -- grouping more BindStmts. -- TODO: perhaps we shouldn't do this if there are any strict bindings, -- because we might be moving evaluation earlier. - go lets indep bndrs ((L loc (LetStmt noExt binds), fvs) : rest) + go lets indep bndrs ((L loc (LetStmt noExtField binds), fvs) : rest) | isEmptyNameSet (bndrs `intersectNameSet` fvs) - = go ((L loc (LetStmt noExt binds), fvs) : lets) indep bndrs rest + = go ((L loc (LetStmt noExtField binds), fvs) : lets) indep bndrs rest go _ [] _ _ = Nothing go _ [_] _ _ = Nothing go lets indep _ stmts = Just (reverse lets, reverse indep, stmts) @@ -1875,7 +1875,7 @@ mkApplicativeStmt ctxt args need_join body_stmts ; return (Just join_op, fvs) } else return (Nothing, emptyNameSet) - ; let applicative_stmt = noLoc $ ApplicativeStmt noExt + ; let applicative_stmt = noLoc $ ApplicativeStmt noExtField (zip (fmap_op : repeat ap_op) args) mb_join ; return ( applicative_stmt : body_stmts @@ -1889,7 +1889,7 @@ needJoin :: MonadNames needJoin _monad_names [] = (False, []) -- we're in an ApplicativeArg needJoin monad_names [L loc (LastStmt _ e _ t)] | Just arg <- isReturnApp monad_names e = - (False, [L loc (LastStmt noExt arg True t)]) + (False, [L loc (LastStmt noExtField arg True t)]) needJoin _monad_names stmts = (True, stmts) -- | @Just e@, if the expression is @return e@ or @return $ e@, @@ -1978,7 +1978,7 @@ checkStmt ctxt (L _ stmt) msg = sep [ text "Unexpected" <+> pprStmtCat stmt <+> ptext (sLit "statement") , text "in" <+> pprAStmtContext ctxt ] -pprStmtCat :: Stmt a body -> SDoc +pprStmtCat :: Stmt (GhcPass a) body -> SDoc pprStmtCat (TransStmt {}) = text "transform" pprStmtCat (LastStmt {}) = text "return expression" pprStmtCat (BodyStmt {}) = text "body" @@ -1987,7 +1987,7 @@ pprStmtCat (LetStmt {}) = text "let" pprStmtCat (RecStmt {}) = text "rec" pprStmtCat (ParStmt {}) = text "parallel" pprStmtCat (ApplicativeStmt {}) = panic "pprStmtCat: ApplicativeStmt" -pprStmtCat (XStmtLR {}) = panic "pprStmtCat: XStmtLR" +pprStmtCat (XStmtLR nec) = noExtCon nec ------------ emptyInvalid :: Validity -- Payload is the empty document @@ -2053,7 +2053,7 @@ okCompStmt dflags _ stmt RecStmt {} -> emptyInvalid LastStmt {} -> emptyInvalid -- Should not happen (dealt with by checkLastStmt) ApplicativeStmt {} -> emptyInvalid - XStmtLR{} -> panic "okCompStmt" + XStmtLR nec -> noExtCon nec --------- checkTupleSection :: [LHsTupArg GhcPs] -> RnM () @@ -2134,7 +2134,7 @@ getMonadFailOp (nlHsApp (noLoc $ syn_expr fromStringExpr) (noLoc $ syn_expr arg_syn_expr)) let failAfterFromStringExpr :: HsExpr GhcRn = - unLoc $ mkHsLam [noLoc $ VarPat noExt $ noLoc arg_name] body + unLoc $ mkHsLam [noLoc $ VarPat noExtField $ noLoc arg_name] body let failAfterFromStringSynExpr :: SyntaxExpr GhcRn = mkSyntaxExpr failAfterFromStringExpr return (failAfterFromStringSynExpr, failFvs `plusFV` fromStringFvs) diff --git a/compiler/rename/RnFixity.hs b/compiler/rename/RnFixity.hs index 1fa81c8fc2..665d87747b 100644 --- a/compiler/rename/RnFixity.hs +++ b/compiler/rename/RnFixity.hs @@ -211,4 +211,4 @@ lookupFieldFixityRn (Ambiguous _ lrdr) = get_ambiguous_fixity (unLoc lrdr) format_ambig (elt, fix) = hang (ppr fix) 2 (pprNameProvenance elt) -lookupFieldFixityRn (XAmbiguousFieldOcc{}) = panic "lookupFieldFixityRn" +lookupFieldFixityRn (XAmbiguousFieldOcc nec) = noExtCon nec diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 9a69423209..5bfc1a37d8 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -263,7 +263,7 @@ Running generateModules from #14693 with DEPTH=16, WIDTH=30 finishes in rnImportDecl :: Module -> LImportDecl GhcPs -> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage) rnImportDecl this_mod - (L loc decl@(ImportDecl { ideclExt = noExt + (L loc decl@(ImportDecl { ideclExt = noExtField , ideclName = loc_imp_mod_name , ideclPkgQual = mb_pkg , ideclSource = want_boot, ideclSafe = mod_safe @@ -376,11 +376,11 @@ rnImportDecl this_mod _ -> return () ) - let new_imp_decl = L loc (decl { ideclExt = noExt, ideclSafe = mod_safe' + let new_imp_decl = L loc (decl { ideclExt = noExtField, ideclSafe = mod_safe' , ideclHiding = new_imp_details }) return (new_imp_decl, gbl_env, imports, mi_hpc iface) -rnImportDecl _ (L _ (XImportDecl _)) = panic "rnImportDecl" +rnImportDecl _ (L _ (XImportDecl nec)) = noExtCon nec -- | Calculate the 'ImportAvails' induced by an import of a particular -- interface, but without 'imp_mods'. @@ -723,7 +723,7 @@ getLocalNonValBinders fixity_env = expectJust "getLocalNonValBinders/find_con_decl_fld" $ find (\ fl -> flLabel fl == lbl) flds where lbl = occNameFS (rdrNameOcc rdr) - find_con_decl_fld (L _ (XFieldOcc _)) = panic "getLocalNonValBinders" + find_con_decl_fld (L _ (XFieldOcc nec)) = noExtCon nec new_assoc :: Bool -> LInstDecl GhcPs -> RnM ([AvailInfo], [(Name, [FieldLabel])]) @@ -759,8 +759,8 @@ getLocalNonValBinders fixity_env (avails, fldss) <- mapAndUnzipM (new_loc_di overload_ok (Just cls_nm)) adts pure (avails, concat fldss) - new_assoc _ (L _ (ClsInstD _ (XClsInstDecl _))) = panic "new_assoc" - new_assoc _ (L _ (XInstDecl _)) = panic "new_assoc" + new_assoc _ (L _ (ClsInstD _ (XClsInstDecl nec))) = noExtCon nec + new_assoc _ (L _ (XInstDecl nec)) = noExtCon nec new_di :: Bool -> Maybe Name -> DataFamInstDecl GhcPs -> RnM (AvailInfo, [(Name, [FieldLabel])]) @@ -774,16 +774,16 @@ getLocalNonValBinders fixity_env -- main_name is not bound here! fld_env = mk_fld_env (feqn_rhs ti_decl) sub_names flds' ; return (avail, fld_env) } - new_di _ _ (DataFamInstDecl (XHsImplicitBndrs _)) = panic "new_di" + new_di _ _ (DataFamInstDecl (XHsImplicitBndrs nec)) = noExtCon nec new_loc_di :: Bool -> Maybe Name -> LDataFamInstDecl GhcPs -> RnM (AvailInfo, [(Name, [FieldLabel])]) new_loc_di overload_ok mb_cls (L _ d) = new_di overload_ok mb_cls d -getLocalNonValBinders _ (XHsGroup _) = panic "getLocalNonValBinders" +getLocalNonValBinders _ (XHsGroup nec) = noExtCon nec newRecordSelector :: Bool -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel newRecordSelector _ [] _ = error "newRecordSelector: datatype has no constructors!" -newRecordSelector _ _ (L _ (XFieldOcc _)) = panic "newRecordSelector" +newRecordSelector _ _ (L _ (XFieldOcc nec)) = noExtCon nec newRecordSelector overload_ok (dc:_) (L loc (FieldOcc _ (L _ fld))) = do { selName <- newTopSrcBinder $ L loc $ field ; return $ qualFieldLbl { flSelector = selName } } @@ -966,7 +966,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) case ie of IEVar _ (L l n) -> do (name, avail, _) <- lookup_name ie $ ieWrappedName n - return ([(IEVar noExt (L l (replaceWrappedName n name)), + return ([(IEVar noExtField (L l (replaceWrappedName n name)), trimAvail avail name)], []) IEThingAll _ (L l tc) -> do @@ -985,7 +985,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) | otherwise -> [] - renamed_ie = IEThingAll noExt (L l (replaceWrappedName tc name)) + renamed_ie = IEThingAll noExtField (L l (replaceWrappedName tc name)) sub_avails = case avail of Avail {} -> [] AvailTC name2 subs fs -> [(renamed_ie, AvailTC name2 (subs \\ [name]) fs)] @@ -1014,7 +1014,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) IEThingWith xt ltc@(L l rdr_tc) wc rdr_ns rdr_fs -> ASSERT2(null rdr_fs, ppr rdr_fs) do (name, avail, mb_parent) - <- lookup_name (IEThingAbs noExt ltc) (ieWrappedName rdr_tc) + <- lookup_name (IEThingAbs noExtField ltc) (ieWrappedName rdr_tc) let (ns,subflds) = case avail of AvailTC _ ns' subflds' -> (ns',subflds') @@ -1038,7 +1038,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) case mb_parent of -- non-associated ty/cls Nothing - -> return ([(IEThingWith noExt (L l name') wc childnames' + -> return ([(IEThingWith noExtField (L l name') wc childnames' childflds, AvailTC name (name:map unLoc childnames) (map unLoc childflds))], []) @@ -1047,10 +1047,10 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) -- childnames' = postrn_ies childnames -- associated ty Just parent - -> return ([(IEThingWith noExt (L l name') wc childnames' + -> return ([(IEThingWith noExtField (L l name') wc childnames' childflds, AvailTC name (map unLoc childnames) (map unLoc childflds)), - (IEThingWith noExt (L l name') wc childnames' + (IEThingWith noExtField (L l name') wc childnames' childflds, AvailTC parent [name] [])], []) @@ -1063,9 +1063,9 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) where mkIEThingAbs tc l (n, av, Nothing ) - = (IEThingAbs noExt (L l (replaceWrappedName tc n)), trimAvail av n) + = (IEThingAbs noExtField (L l (replaceWrappedName tc n)), trimAvail av n) mkIEThingAbs tc l (n, _, Just parent) - = (IEThingAbs noExt (L l (replaceWrappedName tc n)) + = (IEThingAbs noExtField (L l (replaceWrappedName tc n)) , AvailTC parent [n] []) handle_bad_import m = catchIELookup m $ \err -> case err of @@ -1394,7 +1394,7 @@ findImportUsage imports used_gres -- If you use 'signum' from Num, then the user may well have -- imported Num(signum). We don't want to complain that -- Num is not itself mentioned. Hence the two cases in add_unused_with. - unused_decl (L _ (XImportDecl _)) = panic "unused_decl" + unused_decl (L _ (XImportDecl nec)) = noExtCon nec {- Note [The ImportMap] @@ -1535,25 +1535,25 @@ getMinimalImports = mapM mk_minimal -- we want to say "T(..)", but if we're importing only a subset we want -- to say "T(A,B,C)". So we have to find out what the module exports. to_ie _ (Avail n) - = [IEVar noExt (to_ie_post_rn $ noLoc n)] + = [IEVar noExtField (to_ie_post_rn $ noLoc n)] to_ie _ (AvailTC n [m] []) - | n==m = [IEThingAbs noExt (to_ie_post_rn $ noLoc n)] + | n==m = [IEThingAbs noExtField (to_ie_post_rn $ noLoc n)] to_ie iface (AvailTC n ns fs) = case [(xs,gs) | AvailTC x xs gs <- mi_exports iface , x == n , x `elem` xs -- Note [Partial export] ] of - [xs] | all_used xs -> [IEThingAll noExt (to_ie_post_rn $ noLoc n)] + [xs] | all_used xs -> [IEThingAll noExtField (to_ie_post_rn $ noLoc n)] | otherwise -> - [IEThingWith noExt (to_ie_post_rn $ noLoc n) NoIEWildcard + [IEThingWith noExtField (to_ie_post_rn $ noLoc n) NoIEWildcard (map (to_ie_post_rn . noLoc) (filter (/= n) ns)) (map noLoc fs)] -- Note [Overloaded field import] _other | all_non_overloaded fs - -> map (IEVar noExt . to_ie_post_rn_var . noLoc) $ ns + -> map (IEVar noExtField . to_ie_post_rn_var . noLoc) $ ns ++ map flSelector fs | otherwise -> - [IEThingWith noExt (to_ie_post_rn $ noLoc n) NoIEWildcard + [IEThingWith noExtField (to_ie_post_rn $ noLoc n) NoIEWildcard (map (to_ie_post_rn . noLoc) (filter (/= n) ns)) (map noLoc fs)] where @@ -1718,7 +1718,7 @@ dodgyMsg kind tc ie text "but it has none" ] dodgyMsgInsert :: forall p . IdP (GhcPass p) -> IE (GhcPass p) -dodgyMsgInsert tc = IEThingAll noExt ii +dodgyMsgInsert tc = IEThingAll noExtField ii where ii :: LIEWrappedName (IdP (GhcPass p)) ii = noLoc (IEName $ noLoc tc) diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs index 4a08ab4761..150b1cd23f 100644 --- a/compiler/rename/RnPat.hs +++ b/compiler/rename/RnPat.hs @@ -384,7 +384,7 @@ rnLPatAndThen :: NameMaker -> LPat GhcPs -> CpsRn (LPat GhcRn) rnLPatAndThen nm lpat = wrapSrcSpanCps (rnPatAndThen nm) lpat rnPatAndThen :: NameMaker -> Pat GhcPs -> CpsRn (Pat GhcRn) -rnPatAndThen _ (WildPat _) = return (WildPat noExt) +rnPatAndThen _ (WildPat _) = return (WildPat noExtField) rnPatAndThen mk (ParPat x pat) = do { pat' <- rnLPatAndThen mk pat ; return (ParPat x pat') } rnPatAndThen mk (LazyPat x pat) = do { pat' <- rnLPatAndThen mk pat @@ -471,7 +471,7 @@ rnPatAndThen mk (ConPatIn con stuff) -- The pattern for the empty list needs to be replaced by an empty explicit list pattern when overloaded lists is turned on. = case unLoc con == nameRdrName (dataConName nilDataCon) of True -> do { ol_flag <- liftCps $ xoptM LangExt.OverloadedLists - ; if ol_flag then rnPatAndThen mk (ListPat noExt []) + ; if ol_flag then rnPatAndThen mk (ListPat noExtField []) else rnConPatAndThen mk con stuff} False -> rnConPatAndThen mk con stuff @@ -548,7 +548,7 @@ 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 noExt (cL l n) + mkVarPat l n = VarPat noExtField (cL l n) rn_field (dL->L l fld, n') = do { arg' <- rnLPatAndThen (nested_mk dd mk n') (hsRecFieldArg fld) ; return (cL l (fld { hsRecFieldArg = arg' })) } @@ -747,7 +747,7 @@ rnHsRecUpdFields flds then do { checkErr pun_ok (badPun (cL loc lbl)) -- Discard any module qualifier (#11662) ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl) - ; return (cL loc (HsVar noExt (cL loc arg_rdr))) } + ; return (cL loc (HsVar noExtField (cL loc arg_rdr))) } else return arg ; (arg'', fvs) <- rnLExpr arg' @@ -757,10 +757,10 @@ rnHsRecUpdFields flds Right _ -> fvs lbl' = case sel of Left sel_name -> - cL loc (Unambiguous sel_name (cL loc lbl)) + cL loc (Unambiguous sel_name (cL loc lbl)) Right [sel_name] -> - cL loc (Unambiguous sel_name (cL loc lbl)) - Right _ -> cL loc (Ambiguous noExt (cL loc lbl)) + cL loc (Unambiguous sel_name (cL loc lbl)) + Right _ -> cL loc (Ambiguous noExtField (cL loc lbl)) ; return (cL l (HsRecField { hsRecFieldLbl = lbl' , hsRecFieldArg = arg'' diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index e3c9576e94..2aa5afbbd2 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -197,7 +197,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, last_tcg_env <- getGblEnv ; -- (I) Compute the results and return - let {rn_group = HsGroup { hs_ext = noExt, + let {rn_group = HsGroup { hs_ext = noExtField, hs_valds = rn_val_decls, hs_splcds = rn_splice_decls, hs_tyclds = rn_tycl_decls, @@ -229,7 +229,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, traceRn "finish Dus" (ppr src_dus ) ; return (final_tcg_env, rn_group) }}}} -rnSrcDecls (XHsGroup _) = panic "rnSrcDecls" +rnSrcDecls (XHsGroup nec) = noExtCon nec addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv -- This function could be defined lower down in the module hierarchy, @@ -297,7 +297,7 @@ rnSrcWarnDecls bndr_set decls' = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLoc) rdr_names ; return [(rdrNameOcc rdr, txt) | (rdr, _) <- names] } - rn_deprec (XWarnDecl _) = panic "rnSrcWarnDecls" + rn_deprec (XWarnDecl nec) = noExtCon nec what = text "deprecation" @@ -331,9 +331,9 @@ rnAnnDecl ann@(HsAnnotation _ s provenance expr) do { (provenance', provenance_fvs) <- rnAnnProvenance provenance ; (expr', expr_fvs) <- setStage (Splice Untyped) $ rnLExpr expr - ; return (HsAnnotation noExt s provenance' expr', + ; return (HsAnnotation noExtField s provenance' expr', provenance_fvs `plusFV` expr_fvs) } -rnAnnDecl (XAnnDecl _) = panic "rnAnnDecl" +rnAnnDecl (XAnnDecl nec) = noExtCon nec rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars) @@ -352,10 +352,10 @@ rnAnnProvenance provenance = do rnDefaultDecl :: DefaultDecl GhcPs -> RnM (DefaultDecl GhcRn, FreeVars) rnDefaultDecl (DefaultDecl _ tys) = do { (tys', fvs) <- rnLHsTypes doc_str tys - ; return (DefaultDecl noExt tys', fvs) } + ; return (DefaultDecl noExtField tys', fvs) } where doc_str = DefaultDeclCtx -rnDefaultDecl (XDefaultDecl _) = panic "rnDefaultDecl" +rnDefaultDecl (XDefaultDecl nec) = noExtCon nec {- ********************************************************* @@ -375,14 +375,14 @@ rnHsForeignDecl (ForeignImport { fd_name = name, fd_sig_ty = ty, fd_fi = spec }) ; let unitId = thisPackage $ hsc_dflags topEnv spec' = patchForeignImport unitId spec - ; return (ForeignImport { fd_i_ext = noExt + ; return (ForeignImport { fd_i_ext = noExtField , fd_name = name', fd_sig_ty = ty' , fd_fi = spec' }, fvs) } rnHsForeignDecl (ForeignExport { fd_name = name, fd_sig_ty = ty, fd_fe = spec }) = do { name' <- lookupLocatedOccRn name ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) ty - ; return (ForeignExport { fd_e_ext = noExt + ; return (ForeignExport { fd_e_ext = noExtField , fd_name = name', fd_sig_ty = ty' , fd_fe = spec } , fvs `addOneFV` unLoc name') } @@ -390,7 +390,7 @@ rnHsForeignDecl (ForeignExport { fd_name = name, fd_sig_ty = ty, fd_fe = spec }) -- we add it to the free-variable list. It might, for example, -- be imported from another module -rnHsForeignDecl (XForeignDecl _) = panic "rnHsForeignDecl" +rnHsForeignDecl (XForeignDecl nec) = noExtCon nec -- | For Windows DLLs we need to know what packages imported symbols are from -- to generate correct calls. Imported symbols are tagged with the current @@ -425,19 +425,19 @@ patchCCallTarget unitId callTarget = rnSrcInstDecl :: InstDecl GhcPs -> RnM (InstDecl GhcRn, FreeVars) rnSrcInstDecl (TyFamInstD { tfid_inst = tfi }) = do { (tfi', fvs) <- rnTyFamInstDecl NonAssocTyFamEqn tfi - ; return (TyFamInstD { tfid_ext = noExt, tfid_inst = tfi' }, fvs) } + ; return (TyFamInstD { tfid_ext = noExtField, tfid_inst = tfi' }, fvs) } rnSrcInstDecl (DataFamInstD { dfid_inst = dfi }) = do { (dfi', fvs) <- rnDataFamInstDecl NonAssocTyFamEqn dfi - ; return (DataFamInstD { dfid_ext = noExt, dfid_inst = dfi' }, fvs) } + ; return (DataFamInstD { dfid_ext = noExtField, dfid_inst = dfi' }, fvs) } rnSrcInstDecl (ClsInstD { cid_inst = cid }) = do { traceRn "rnSrcIstDecl {" (ppr cid) ; (cid', fvs) <- rnClsInstDecl cid ; traceRn "rnSrcIstDecl end }" empty - ; return (ClsInstD { cid_d_ext = noExt, cid_inst = cid' }, fvs) } + ; return (ClsInstD { cid_d_ext = noExtField, cid_inst = cid' }, fvs) } -rnSrcInstDecl (XInstDecl _) = panic "rnSrcInstDecl" +rnSrcInstDecl (XInstDecl nec) = noExtCon nec -- | Warn about non-canonical typeclass instance declarations -- @@ -647,7 +647,7 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds ; let all_fvs = meth_fvs `plusFV` more_fvs `plusFV` inst_fvs - ; return (ClsInstDecl { cid_ext = noExt + ; return (ClsInstDecl { cid_ext = noExtField , cid_poly_ty = inst_ty', cid_binds = mbinds' , cid_sigs = uprags', cid_tyfam_insts = ats' , cid_overlap_mode = oflag @@ -663,7 +663,7 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds -- the instance context after renaming. This is a bit -- strange, but should not matter (and it would be more work -- to remove the context). -rnClsInstDecl (XClsInstDecl _) = panic "rnClsInstDecl" +rnClsInstDecl (XClsInstDecl nec) = noExtCon nec rnFamInstEqn :: HsDocContext -> AssocTyFamInfo @@ -745,15 +745,15 @@ rnFamInstEqn doc atfi rhs_kvars ; return (HsIB { hsib_ext = all_imp_var_names -- Note [Wildcards in family instances] , hsib_body - = FamEqn { feqn_ext = noExt + = FamEqn { feqn_ext = noExtField , feqn_tycon = tycon' , feqn_bndrs = bndrs' <$ mb_bndrs , feqn_pats = pats' , feqn_fixity = fixity , feqn_rhs = payload' } }, all_fvs) } -rnFamInstEqn _ _ _ (HsIB _ (XFamEqn _)) _ = panic "rnFamInstEqn" -rnFamInstEqn _ _ _ (XHsImplicitBndrs _) _ = panic "rnFamInstEqn" +rnFamInstEqn _ _ _ (HsIB _ (XFamEqn nec)) _ = noExtCon nec +rnFamInstEqn _ _ _ (XHsImplicitBndrs nec) _ = noExtCon nec rnTyFamInstDecl :: AssocTyFamInfo -> TyFamInstDecl GhcPs @@ -801,8 +801,8 @@ rnTyFamInstEqn atfi ctf_info withHsDocContext (TyFamilyCtx fam_rdr_name) $ wrongTyFamName fam_name tycon' ; pure (eqn', fvs) } -rnTyFamInstEqn _ _ (HsIB _ (XFamEqn _)) = panic "rnTyFamInstEqn" -rnTyFamInstEqn _ _ (XHsImplicitBndrs _) = panic "rnTyFamInstEqn" +rnTyFamInstEqn _ _ (HsIB _ (XFamEqn nec)) = noExtCon nec +rnTyFamInstEqn _ _ (XHsImplicitBndrs nec) = noExtCon nec rnTyFamDefltDecl :: Name -> TyFamDefltDecl GhcPs @@ -819,10 +819,10 @@ rnDataFamInstDecl atfi (DataFamInstDecl { dfid_eqn = eqn@(HsIB { hsib_body = ; (eqn', fvs) <- rnFamInstEqn (TyDataCtx tycon) atfi rhs_kvs eqn rnDataDefn ; return (DataFamInstDecl { dfid_eqn = eqn' }, fvs) } -rnDataFamInstDecl _ (DataFamInstDecl (HsIB _ (XFamEqn _))) - = panic "rnDataFamInstDecl" -rnDataFamInstDecl _ (DataFamInstDecl (XHsImplicitBndrs _)) - = panic "rnDataFamInstDecl" +rnDataFamInstDecl _ (DataFamInstDecl (HsIB _ (XFamEqn nec))) + = noExtCon nec +rnDataFamInstDecl _ (DataFamInstDecl (XHsImplicitBndrs nec)) + = noExtCon nec -- Renaming of the associated types in instances. @@ -974,10 +974,10 @@ rnSrcDerivDecl (DerivDecl _ ty mds overlap) rnAndReportFloatingViaTvs strat_tvs loc ppr_via_ty "instance" $ rnHsSigWcType BindUnlessForall DerivDeclCtx ty ; warnNoDerivStrat mds' loc - ; return (DerivDecl noExt ty' mds' overlap, fvs) } + ; return (DerivDecl noExtField ty' mds' overlap, fvs) } where loc = getLoc $ hsib_body $ hswc_body ty -rnSrcDerivDecl (XDerivDecl _) = panic "rnSrcDerivDecl" +rnSrcDerivDecl (XDerivDecl nec) = noExtCon nec standaloneDerivErr :: SDoc standaloneDerivErr @@ -996,10 +996,10 @@ rnHsRuleDecls :: RuleDecls GhcPs -> RnM (RuleDecls GhcRn, FreeVars) rnHsRuleDecls (HsRules { rds_src = src , rds_rules = rules }) = do { (rn_rules,fvs) <- rnList rnHsRuleDecl rules - ; return (HsRules { rds_ext = noExt + ; return (HsRules { rds_ext = noExtField , rds_src = src , rds_rules = rn_rules }, fvs) } -rnHsRuleDecls (XRuleDecls _) = panic "rnHsRuleDecls" +rnHsRuleDecls (XRuleDecls nec) = noExtCon nec rnHsRuleDecl :: RuleDecl GhcPs -> RnM (RuleDecl GhcRn, FreeVars) rnHsRuleDecl (HsRule { rd_name = rule_name @@ -1028,9 +1028,9 @@ rnHsRuleDecl (HsRule { rd_name = rule_name where get_var (RuleBndrSig _ v _) = v get_var (RuleBndr _ v) = v - get_var (XRuleBndr _) = panic "rnHsRuleDecl" + get_var (XRuleBndr nec) = noExtCon nec in_rule = text "in the rule" <+> pprFullRuleName rule_name -rnHsRuleDecl (XRuleDecl _) = panic "rnHsRuleDecl" +rnHsRuleDecl (XRuleDecl nec) = noExtCon nec bindRuleTmVars :: HsDocContext -> Maybe ty_bndrs -> [LRuleBndr GhcPs] -> [Name] @@ -1042,13 +1042,13 @@ bindRuleTmVars doc tyvs vars names thing_inside where go ((dL->L l (RuleBndr _ (dL->L loc _))) : vars) (n : ns) thing_inside = go vars ns $ \ vars' -> - thing_inside (cL l (RuleBndr noExt (cL loc n)) : vars') + thing_inside (cL l (RuleBndr noExtField (cL loc n)) : vars') go ((dL->L l (RuleBndrSig _ (dL->L loc _) bsig)) : vars) (n : ns) thing_inside = rnHsSigWcTypeScoped bind_free_tvs doc bsig $ \ bsig' -> go vars ns $ \ vars' -> - thing_inside (cL l (RuleBndrSig noExt (cL loc n) bsig') : vars') + thing_inside (cL l (RuleBndrSig noExtField (cL loc n) bsig') : vars') go [] [] thing_inside = thing_inside [] go vars names _ = pprPanic "bindRuleVars" (ppr vars $$ ppr names) @@ -1305,7 +1305,7 @@ rnTyClDecls tycl_ds first_group | null init_inst_ds = [] - | otherwise = [TyClGroup { group_ext = noExt + | otherwise = [TyClGroup { group_ext = noExtField , group_tyclds = [] , group_roles = [] , group_instds = init_inst_ds }] @@ -1337,7 +1337,7 @@ rnTyClDecls tycl_ds bndrs = map (tcdName . unLoc) tycl_ds (inst_ds, inst_map') = getInsts bndrs inst_map (roles, role_env') = getRoleAnnots bndrs role_env - group = TyClGroup { group_ext = noExt + group = TyClGroup { group_ext = noExtField , group_tyclds = tycl_ds , group_roles = roles , group_instds = inst_ds } @@ -1404,8 +1404,8 @@ rnRoleAnnots tc_names role_annots tycon' <- lookupSigCtxtOccRn (RoleAnnotCtxt tc_names) (text "role annotation") tycon - ; return $ RoleAnnotDecl noExt tycon' roles } - rn_role_annot1 (XRoleAnnotDecl _) = panic "rnRoleAnnots" + ; return $ RoleAnnotDecl noExtField tycon' roles } + rn_role_annot1 (XRoleAnnotDecl nec) = noExtCon nec dupRoleAnnotErr :: NonEmpty (LRoleAnnotDecl GhcPs) -> RnM () dupRoleAnnotErr list @@ -1523,7 +1523,7 @@ rnTyClDecl :: TyClDecl GhcPs -- in a class decl rnTyClDecl (FamDecl { tcdFam = decl }) = do { (decl', fvs) <- rnFamDecl Nothing decl - ; return (FamDecl noExt decl', fvs) } + ; return (FamDecl noExtField decl', fvs) } rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdFixity = fixity, tcdRhs = rhs }) @@ -1628,7 +1628,7 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls, where cls_doc = ClassDeclCtx lcls -rnTyClDecl (XTyClDecl _) = panic "rnTyClDecl" +rnTyClDecl (XTyClDecl nec) = noExtCon nec -- Does the data type declaration include a CUSK? dataDeclHasCUSK :: LHsQTyVars pass -> NewOrData -> Bool -> Bool -> RnM Bool @@ -1696,7 +1696,7 @@ rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType ; let all_fvs = fvs1 `plusFV` fvs3 `plusFV` con_fvs `plusFV` sig_fvs - ; return ( HsDataDefn { dd_ext = noExt + ; return ( HsDataDefn { dd_ext = noExtField , dd_ND = new_or_data, dd_cType = cType , dd_ctxt = context', dd_kindSig = m_sig' , dd_cons = condecls' @@ -1714,7 +1714,7 @@ rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType multipleDerivClausesErr ; (ds', fvs) <- mapFvRn (rnLHsDerivingClause doc) ds ; return (cL loc ds', fvs) } -rnDataDefn _ (XHsDataDefn _) = panic "rnDataDefn" +rnDataDefn _ (XHsDataDefn nec) = noExtCon nec warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) -> SrcSpan @@ -1743,14 +1743,14 @@ rnLHsDerivingClause :: HsDocContext -> LHsDerivingClause GhcPs -> RnM (LHsDerivingClause GhcRn, FreeVars) rnLHsDerivingClause doc (dL->L loc (HsDerivingClause - { deriv_clause_ext = noExt + { deriv_clause_ext = noExtField , deriv_clause_strategy = dcs , deriv_clause_tys = (dL->L loc' dct) })) = do { (dcs', dct', fvs) <- rnLDerivStrategy doc dcs $ \strat_tvs ppr_via_ty -> mapFvRn (rn_deriv_ty strat_tvs ppr_via_ty) dct ; warnNoDerivStrat dcs' loc - ; pure ( cL loc (HsDerivingClause { deriv_clause_ext = noExt + ; pure ( cL loc (HsDerivingClause { deriv_clause_ext = noExtField , deriv_clause_strategy = dcs' , deriv_clause_tys = cL loc' dct' }) , fvs ) } @@ -1760,9 +1760,9 @@ rnLHsDerivingClause doc rn_deriv_ty strat_tvs ppr_via_ty deriv_ty@(HsIB {hsib_body = dL->L loc _}) = rnAndReportFloatingViaTvs strat_tvs loc ppr_via_ty "class" $ rnHsSigType doc deriv_ty - rn_deriv_ty _ _ (XHsImplicitBndrs _) = panic "rn_deriv_ty" -rnLHsDerivingClause _ (dL->L _ (XHsDerivingClause _)) - = panic "rnLHsDerivingClause" + rn_deriv_ty _ _ (XHsImplicitBndrs nec) = noExtCon nec +rnLHsDerivingClause _ (dL->L _ (XHsDerivingClause nec)) + = noExtCon nec rnLHsDerivingClause _ _ = panic "rnLHsDerivingClause: Impossible Match" -- due to #15884 @@ -1905,7 +1905,7 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars injectivity ; return ( (tyvars', res_sig', injectivity') , fv_kind ) } ; (info', fv2) <- rn_info tycon' info - ; return (FamilyDecl { fdExt = noExt + ; return (FamilyDecl { fdExt = noExtField , fdLName = tycon', fdTyVars = tyvars' , fdFixity = fixity , fdInfo = info', fdResultSig = res_sig' @@ -1928,16 +1928,16 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars = return (ClosedTypeFamily Nothing, emptyFVs) rn_info _ OpenTypeFamily = return (OpenTypeFamily, emptyFVs) rn_info _ DataFamily = return (DataFamily, emptyFVs) -rnFamDecl _ (XFamilyDecl _) = panic "rnFamDecl" +rnFamDecl _ (XFamilyDecl nec) = noExtCon nec rnFamResultSig :: HsDocContext -> FamilyResultSig GhcPs -> RnM (FamilyResultSig GhcRn, FreeVars) rnFamResultSig _ (NoSig _) - = return (NoSig noExt, emptyFVs) + = return (NoSig noExtField, emptyFVs) rnFamResultSig doc (KindSig _ kind) = do { (rndKind, ftvs) <- rnLHsKind doc kind - ; return (KindSig noExt rndKind, ftvs) } + ; return (KindSig noExtField rndKind, ftvs) } rnFamResultSig doc (TyVarSig _ tvbndr) = do { -- `TyVarSig` tells us that user named the result of a type family by -- writing `= tyvar` or `= (tyvar :: kind)`. In such case we want to @@ -1959,8 +1959,8 @@ rnFamResultSig doc (TyVarSig _ tvbndr) ; bindLHsTyVarBndr doc Nothing -- This might be a lie, but it's used for -- scoping checks that are irrelevant here tvbndr $ \ tvbndr' -> - return (TyVarSig noExt tvbndr', unitFV (hsLTyVarName tvbndr')) } -rnFamResultSig _ (XFamilyResultSig _) = panic "rnFamResultSig" + return (TyVarSig noExtField tvbndr', unitFV (hsLTyVarName tvbndr')) } +rnFamResultSig _ (XFamilyResultSig nec) = noExtCon nec -- Note [Renaming injectivity annotation] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2111,7 +2111,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs [ text "ex_tvs:" <+> ppr ex_tvs , text "new_ex_dqtvs':" <+> ppr new_ex_tvs ]) - ; return (decl { con_ext = noExt + ; return (decl { con_ext = noExtField , con_name = new_name, con_ex_tvs = new_ex_tvs , con_mb_cxt = new_context, con_args = new_args , con_doc = mb_doc' }, @@ -2164,13 +2164,13 @@ rnConDecl decl@(ConDeclGADT { con_names = names , hsq_explicit = explicit_tkvs } ; traceRn "rnConDecl2" (ppr names $$ ppr implicit_tkvs $$ ppr explicit_tkvs) - ; return (decl { con_g_ext = noExt, con_names = new_names + ; return (decl { con_g_ext = noExtField, con_names = new_names , con_qvars = new_qtvs, con_mb_cxt = new_cxt , con_args = args', con_res_ty = res_ty' , con_doc = mb_doc' }, all_fvs) } } -rnConDecl (XConDecl _) = panic "rnConDecl" +rnConDecl (XConDecl nec) = noExtCon nec rnMbContext :: HsDocContext -> Maybe (LHsContext GhcPs) @@ -2232,7 +2232,7 @@ extendPatSynEnv val_decls local_fix_env thing = do { bnd_name <- newTopSrcBinder (cL bind_loc n) let rnames = map recordPatSynSelectorId as mkFieldOcc :: Located RdrName -> LFieldOcc GhcPs - mkFieldOcc (dL->L l name) = cL l (FieldOcc noExt (cL l name)) + mkFieldOcc (dL->L l name) = cL l (FieldOcc noExtField (cL l name)) field_occs = map mkFieldOcc rnames flds <- mapM (newRecordSelector False [bnd_name]) field_occs return ((bnd_name, flds): names) @@ -2365,13 +2365,13 @@ add gp@(HsGroup {hs_ruleds = ts}) l (RuleD _ d) ds = addl (gp { hs_ruleds = cL l d : ts }) ds add gp l (DocD _ d) ds = addl (gp { hs_docs = (cL l d) : (hs_docs gp) }) ds -add (HsGroup {}) _ (SpliceD _ (XSpliceDecl _)) _ = panic "RnSource.add" -add (HsGroup {}) _ (XHsDecl _) _ = panic "RnSource.add" -add (XHsGroup _) _ _ _ = panic "RnSource.add" +add (HsGroup {}) _ (SpliceD _ (XSpliceDecl nec)) _ = noExtCon nec +add (HsGroup {}) _ (XHsDecl nec) _ = noExtCon nec +add (XHsGroup nec) _ _ _ = noExtCon nec add_tycld :: LTyClDecl (GhcPass p) -> [TyClGroup (GhcPass p)] -> [TyClGroup (GhcPass p)] -add_tycld d [] = [TyClGroup { group_ext = noExt +add_tycld d [] = [TyClGroup { group_ext = noExtField , group_tyclds = [d] , group_roles = [] , group_instds = [] @@ -2379,11 +2379,11 @@ add_tycld d [] = [TyClGroup { group_ext = noExt ] add_tycld d (ds@(TyClGroup { group_tyclds = tyclds }):dss) = ds { group_tyclds = d : tyclds } : dss -add_tycld _ (XTyClGroup _: _) = panic "add_tycld" +add_tycld _ (XTyClGroup nec: _) = noExtCon nec add_instd :: LInstDecl (GhcPass p) -> [TyClGroup (GhcPass p)] -> [TyClGroup (GhcPass p)] -add_instd d [] = [TyClGroup { group_ext = noExt +add_instd d [] = [TyClGroup { group_ext = noExtField , group_tyclds = [] , group_roles = [] , group_instds = [d] @@ -2391,11 +2391,11 @@ add_instd d [] = [TyClGroup { group_ext = noExt ] add_instd d (ds@(TyClGroup { group_instds = instds }):dss) = ds { group_instds = d : instds } : dss -add_instd _ (XTyClGroup _: _) = panic "add_instd" +add_instd _ (XTyClGroup nec: _) = noExtCon nec add_role_annot :: LRoleAnnotDecl (GhcPass p) -> [TyClGroup (GhcPass p)] -> [TyClGroup (GhcPass p)] -add_role_annot d [] = [TyClGroup { group_ext = noExt +add_role_annot d [] = [TyClGroup { group_ext = noExtField , group_tyclds = [] , group_roles = [d] , group_instds = [] @@ -2403,7 +2403,7 @@ add_role_annot d [] = [TyClGroup { group_ext = noExt ] add_role_annot d (tycls@(TyClGroup { group_roles = roles }) : rest) = tycls { group_roles = d : roles } : rest -add_role_annot _ (XTyClGroup _: _) = panic "add_role_annot" +add_role_annot _ (XTyClGroup nec: _) = noExtCon nec add_bind :: LHsBind a -> HsValBinds a -> HsValBinds a add_bind b (ValBinds x bs sigs) = ValBinds x (bs `snocBag` b) sigs diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index 5766080fef..9c3e317958 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -104,7 +104,7 @@ rnBracket e br_body ; (body', fvs_e) <- setStage (Brack cur_stage RnPendingTyped) $ rn_bracket cur_stage br_body - ; return (HsBracket noExt body', fvs_e) } + ; return (HsBracket noExtField body', fvs_e) } False -> do { traceRn "Renaming untyped TH bracket" empty ; ps_var <- newMutVar [] @@ -112,7 +112,7 @@ rnBracket e br_body setStage (Brack cur_stage (RnPendingUntyped ps_var)) $ rn_bracket cur_stage br_body ; pendings <- readMutVar ps_var - ; return (HsRnBracketOut noExt body' pendings, fvs_e) } + ; return (HsRnBracketOut noExtField body' pendings, fvs_e) } } rn_bracket :: ThStage -> HsBracket GhcPs -> RnM (HsBracket GhcRn, FreeVars) @@ -180,7 +180,7 @@ rn_bracket _ (DecBrG {}) = panic "rn_bracket: unexpected DecBrG" rn_bracket _ (TExpBr x e) = do { (e', fvs) <- rnLExpr e ; return (TExpBr x e', fvs) } -rn_bracket _ (XBracket {}) = panic "rn_bracket: unexpected XBracket" +rn_bracket _ (XBracket nec) = noExtCon nec quotationCtxtDoc :: HsBracket GhcPs -> SDoc quotationCtxtDoc br_body @@ -303,7 +303,7 @@ runRnSplice flavour run_meta ppr_res splice HsTypedSplice {} -> pprPanic "runRnSplice" (ppr splice) HsSpliced {} -> pprPanic "runRnSplice" (ppr splice) HsSplicedT {} -> pprPanic "runRnSplice" (ppr splice) - XSplice {} -> pprPanic "runRnSplice" (ppr splice) + XSplice nec -> noExtCon nec -- Typecheck the expression ; meta_exp_ty <- tcMetaTy meta_ty_name @@ -352,8 +352,8 @@ makePending _ splice@(HsSpliced {}) = pprPanic "makePending" (ppr splice) makePending _ splice@(HsSplicedT {}) = pprPanic "makePending" (ppr splice) -makePending _ splice@(XSplice {}) - = pprPanic "makePending" (ppr splice) +makePending _ (XSplice nec) + = noExtCon nec ------------------ mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString @@ -361,13 +361,13 @@ mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString -- Return the expression (quoter "...quote...") -- which is what we must run in a quasi-quote mkQuasiQuoteExpr flavour quoter q_span quote - = cL q_span $ HsApp noExt (cL q_span - $ HsApp noExt (cL q_span (HsVar noExt (cL q_span quote_selector))) - quoterExpr) + = cL q_span $ HsApp noExtField (cL q_span + $ HsApp noExtField (cL q_span (HsVar noExtField (cL q_span quote_selector))) + quoterExpr) quoteExpr where - quoterExpr = cL q_span $! HsVar noExt $! (cL q_span quoter) - quoteExpr = cL q_span $! HsLit noExt $! HsString NoSourceText quote + quoterExpr = cL q_span $! HsVar noExtField $! (cL q_span quoter) + quoteExpr = cL q_span $! HsLit noExtField $! HsString NoSourceText quote quote_selector = case flavour of UntypedExpSplice -> quoteExpName UntypedPatSplice -> quotePatName @@ -404,7 +404,7 @@ rnSplice (HsQuasiQuote x splice_name quoter q_loc quote) rnSplice splice@(HsSpliced {}) = pprPanic "rnSplice" (ppr splice) rnSplice splice@(HsSplicedT {}) = pprPanic "rnSplice" (ppr splice) -rnSplice splice@(XSplice {}) = pprPanic "rnSplice" (ppr splice) +rnSplice (XSplice nec) = noExtCon nec --------------------- rnSpliceExpr :: HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars) @@ -413,7 +413,7 @@ rnSpliceExpr splice where pend_expr_splice :: HsSplice GhcRn -> (PendingRnSplice, HsExpr GhcRn) pend_expr_splice rn_splice - = (makePending UntypedExpSplice rn_splice, HsSpliceE noExt rn_splice) + = (makePending UntypedExpSplice rn_splice, HsSpliceE noExtField rn_splice) run_expr_splice :: HsSplice GhcRn -> RnM (HsExpr GhcRn, FreeVars) run_expr_splice rn_splice @@ -426,7 +426,7 @@ rnSpliceExpr splice , isLocalGRE gre] lcl_names = mkNameSet (localRdrEnvElts lcl_rdr) - ; return (HsSpliceE noExt rn_splice, lcl_names `plusFV` gbl_names) } + ; return (HsSpliceE noExtField rn_splice, lcl_names `plusFV` gbl_names) } | otherwise -- Run it here, see Note [Running splices in the Renamer] = do { traceRn "rnSpliceExpr: untyped expression splice" empty @@ -434,8 +434,8 @@ rnSpliceExpr splice runRnSplice UntypedExpSplice runMetaE ppr rn_splice ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr) -- See Note [Delaying modFinalizers in untyped splices]. - ; return ( HsPar noExt $ HsSpliceE noExt - . HsSpliced noExt (ThModFinalizers mod_finalizers) + ; return ( HsPar noExtField $ HsSpliceE noExtField + . HsSpliced noExtField (ThModFinalizers mod_finalizers) . HsSplicedExpr <$> lexpr3 , fvs) @@ -538,7 +538,7 @@ rnSpliceType splice where pend_type_splice rn_splice = ( makePending UntypedTypeSplice rn_splice - , HsSpliceTy noExt rn_splice) + , HsSpliceTy noExtField rn_splice) run_type_splice rn_splice = do { traceRn "rnSpliceType: untyped type splice" empty @@ -548,8 +548,9 @@ rnSpliceType splice ; checkNoErrs $ rnLHsType doc hs_ty2 } -- checkNoErrs: see Note [Renamer errors] -- See Note [Delaying modFinalizers in untyped splices]. - ; return ( HsParTy noExt $ HsSpliceTy noExt - . HsSpliced noExt (ThModFinalizers mod_finalizers) + ; return ( HsParTy noExtField + $ HsSpliceTy noExtField + . HsSpliced noExtField (ThModFinalizers mod_finalizers) . HsSplicedTy <$> hs_ty3 , fvs @@ -608,7 +609,7 @@ rnSplicePat splice (PendingRnSplice, Either b (Pat GhcRn)) pend_pat_splice rn_splice = (makePending UntypedPatSplice rn_splice - , Right (SplicePat noExt rn_splice)) + , Right (SplicePat noExtField rn_splice)) run_pat_splice :: HsSplice GhcRn -> RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars) @@ -617,8 +618,8 @@ rnSplicePat splice ; (pat, mod_finalizers) <- runRnSplice UntypedPatSplice runMetaP ppr rn_splice -- See Note [Delaying modFinalizers in untyped splices]. - ; return ( Left $ ParPat noExt $ ((SplicePat noExt) - . HsSpliced noExt (ThModFinalizers mod_finalizers) + ; return ( Left $ ParPat noExtField $ ((SplicePat noExtField) + . HsSpliced noExtField (ThModFinalizers mod_finalizers) . HsSplicedPat) `onHasSrcSpan` pat , emptyFVs @@ -633,10 +634,10 @@ rnSpliceDecl (SpliceDecl _ (dL->L loc splice) flg) where pend_decl_splice rn_splice = ( makePending UntypedDeclSplice rn_splice - , SpliceDecl noExt (cL loc rn_splice) flg) + , SpliceDecl noExtField (cL loc rn_splice) flg) - run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice) -rnSpliceDecl (XSpliceDecl _) = panic "rnSpliceDecl" + run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice) +rnSpliceDecl (XSpliceDecl nec) = noExtCon nec rnTopSpliceDecls :: HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars) -- Declaration splice at the very top level of the module diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 4b4d519324..80b03d3f25 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -137,10 +137,10 @@ rn_hs_sig_wc_type scoping ctxt , hsib_body = hs_ty' } ; (res, fvs2) <- thing_inside sig_ty' ; return (res, fvs1 `plusFV` fvs2) } } -rn_hs_sig_wc_type _ _ (HsWC _ (XHsImplicitBndrs _)) _ - = panic "rn_hs_sig_wc_type" -rn_hs_sig_wc_type _ _ (XHsWildCardBndrs _) _ - = panic "rn_hs_sig_wc_type" +rn_hs_sig_wc_type _ _ (HsWC _ (XHsImplicitBndrs nec)) _ + = noExtCon nec +rn_hs_sig_wc_type _ _ (XHsWildCardBndrs nec) _ + = noExtCon nec rnHsWcType :: HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeVars) rnHsWcType ctxt (HsWC { hswc_body = hs_ty }) @@ -149,7 +149,7 @@ rnHsWcType ctxt (HsWC { hswc_body = hs_ty }) ; (wcs, hs_ty', fvs) <- rnWcBody ctxt nwc_rdrs hs_ty ; let sig_ty' = HsWC { hswc_ext = wcs, hswc_body = hs_ty' } ; return (sig_ty', fvs) } -rnHsWcType _ (XHsWildCardBndrs _) = panic "rnHsWcType" +rnHsWcType _ (XHsWildCardBndrs nec) = noExtCon nec rnWcBody :: HsDocContext -> [Located RdrName] -> LHsType GhcPs -> RnM ([Name], LHsType GhcRn, FreeVars) @@ -174,7 +174,7 @@ rnWcBody ctxt nwc_rdrs hs_ty , hst_body = hs_body }) = bindLHsTyVarBndrs (rtke_ctxt env) (Just $ inTypeDoc hs_ty) Nothing tvs $ \ tvs' -> do { (hs_body', fvs) <- rn_lty env hs_body - ; return (HsForAllTy { hst_fvf = fvf, hst_xforall = noExt + ; return (HsForAllTy { hst_fvf = fvf, hst_xforall = noExtField , hst_bndrs = tvs', hst_body = hs_body' } , fvs) } @@ -184,16 +184,16 @@ rnWcBody ctxt nwc_rdrs hs_ty , (dL->L lx (HsWildCardTy _)) <- ignoreParens hs_ctxt_last = do { (hs_ctxt1', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt1 ; setSrcSpan lx $ checkExtraConstraintWildCard env hs_ctxt1 - ; let hs_ctxt' = hs_ctxt1' ++ [cL lx (HsWildCardTy noExt)] + ; let hs_ctxt' = hs_ctxt1' ++ [cL lx (HsWildCardTy noExtField)] ; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty - ; return (HsQualTy { hst_xqual = noExt + ; return (HsQualTy { hst_xqual = noExtField , hst_ctxt = cL cx hs_ctxt', hst_body = hs_ty' } , fvs1 `plusFV` fvs2) } | otherwise = do { (hs_ctxt', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt ; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty - ; return (HsQualTy { hst_xqual = noExt + ; return (HsQualTy { hst_xqual = noExtField , hst_ctxt = cL cx hs_ctxt' , hst_body = hs_ty' } , fvs1 `plusFV` fvs2) } @@ -307,7 +307,7 @@ rnHsSigType ctx (HsIB { hsib_body = hs_ty }) ; return ( HsIB { hsib_ext = vars , hsib_body = body' } , fvs ) } } -rnHsSigType _ (XHsImplicitBndrs _) = panic "rnHsSigType" +rnHsSigType _ (XHsImplicitBndrs nec) = noExtCon nec rnImplicitBndrs :: Bool -- True <=> bring into scope any free type variables -- E.g. f :: forall a. a->b @@ -487,7 +487,7 @@ rnHsTyKi env ty@(HsForAllTy { hst_fvf = fvf, hst_bndrs = tyvars ; bindLHsTyVarBndrs (rtke_ctxt env) (Just $ inTypeDoc ty) Nothing tyvars $ \ tyvars' -> do { (tau', fvs) <- rnLHsTyKi env tau - ; return ( HsForAllTy { hst_fvf = fvf, hst_xforall = noExt + ; return ( HsForAllTy { hst_fvf = fvf, hst_xforall = noExtField , hst_bndrs = tyvars' , hst_body = tau' } , fvs) } } @@ -495,7 +495,7 @@ rnHsTyKi env ty@(HsQualTy { hst_ctxt = lctxt, hst_body = tau }) = do { checkPolyKinds env ty -- See Note [QualTy in kinds] ; (ctxt', fvs1) <- rnTyKiContext env lctxt ; (tau', fvs2) <- rnLHsTyKi env tau - ; return (HsQualTy { hst_xqual = noExt, hst_ctxt = ctxt' + ; return (HsQualTy { hst_xqual = noExtField, hst_ctxt = ctxt' , hst_body = tau' } , fvs1 `plusFV` fvs2) } @@ -508,7 +508,7 @@ rnHsTyKi env (HsTyVar _ ip (dL->L loc rdr_name)) -- Any type variable at the kind level is illegal without the use -- of PolyKinds (see #14710) ; name <- rnTyVar env rdr_name - ; return (HsTyVar noExt ip (cL loc name), unitFV name) } + ; return (HsTyVar noExtField ip (cL loc name), unitFV name) } rnHsTyKi env ty@(HsOpTy _ ty1 l_op ty2) = setSrcSpan (getLoc l_op) $ @@ -516,23 +516,23 @@ rnHsTyKi env ty@(HsOpTy _ ty1 l_op ty2) ; fix <- lookupTyFixityRn l_op' ; (ty1', fvs2) <- rnLHsTyKi env ty1 ; (ty2', fvs3) <- rnLHsTyKi env ty2 - ; res_ty <- mkHsOpTyRn (\t1 t2 -> HsOpTy noExt t1 l_op' t2) + ; res_ty <- mkHsOpTyRn (\t1 t2 -> HsOpTy noExtField t1 l_op' t2) (unLoc l_op') fix ty1' ty2' ; return (res_ty, plusFVs [fvs1, fvs2, fvs3]) } rnHsTyKi env (HsParTy _ ty) = do { (ty', fvs) <- rnLHsTyKi env ty - ; return (HsParTy noExt ty', fvs) } + ; return (HsParTy noExtField ty', fvs) } rnHsTyKi env (HsBangTy _ b ty) = do { (ty', fvs) <- rnLHsTyKi env ty - ; return (HsBangTy noExt b ty', fvs) } + ; return (HsBangTy noExtField b ty', fvs) } rnHsTyKi env ty@(HsRecTy _ flds) = do { let ctxt = rtke_ctxt env ; fls <- get_fields ctxt ; (flds', fvs) <- rnConDeclFields ctxt fls flds - ; return (HsRecTy noExt flds', fvs) } + ; return (HsRecTy noExtField flds', fvs) } where get_fields (ConDeclCtx names) = concatMapM (lookupConstructorFields . unLoc) names @@ -549,7 +549,7 @@ rnHsTyKi env (HsFunTy _ ty1 ty2) -- when we find return :: forall m. Monad m -> forall a. a -> m a -- Check for fixity rearrangements - ; res_ty <- mkHsOpTyRn (HsFunTy noExt) funTyConName funTyFixity ty1' ty2' + ; res_ty <- mkHsOpTyRn (HsFunTy noExtField) funTyConName funTyFixity ty1' ty2' ; return (res_ty, fvs1 `plusFV` fvs2) } rnHsTyKi env listTy@(HsListTy _ ty) @@ -557,7 +557,7 @@ rnHsTyKi env listTy@(HsListTy _ ty) ; when (not data_kinds && isRnKindLevel env) (addErr (dataKindsErr env listTy)) ; (ty', fvs) <- rnLHsTyKi env ty - ; return (HsListTy noExt ty', fvs) } + ; return (HsListTy noExtField ty', fvs) } rnHsTyKi env t@(HsKindSig _ ty k) = do { checkPolyKinds env t @@ -565,7 +565,7 @@ rnHsTyKi env t@(HsKindSig _ ty k) ; unless kind_sigs_ok (badKindSigErr (rtke_ctxt env) ty) ; (ty', fvs1) <- rnLHsTyKi env ty ; (k', fvs2) <- rnLHsTyKi (env { rtke_level = KindLevel }) k - ; return (HsKindSig noExt ty' k', fvs1 `plusFV` fvs2) } + ; return (HsKindSig noExtField ty' k', fvs1 `plusFV` fvs2) } -- Unboxed tuples are allowed to have poly-typed arguments. These -- sometimes crop up as a result of CPR worker-wrappering dictionaries. @@ -574,14 +574,14 @@ rnHsTyKi env tupleTy@(HsTupleTy _ tup_con tys) ; when (not data_kinds && isRnKindLevel env) (addErr (dataKindsErr env tupleTy)) ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys - ; return (HsTupleTy noExt tup_con tys', fvs) } + ; return (HsTupleTy noExtField tup_con tys', fvs) } rnHsTyKi env sumTy@(HsSumTy _ tys) = do { data_kinds <- xoptM LangExt.DataKinds ; when (not data_kinds && isRnKindLevel env) (addErr (dataKindsErr env sumTy)) ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys - ; return (HsSumTy noExt tys', fvs) } + ; return (HsSumTy noExtField tys', fvs) } -- Ensure that a type-level integer is nonnegative (#8306, #8412) rnHsTyKi env tyLit@(HsTyLit _ t) @@ -589,7 +589,7 @@ rnHsTyKi env tyLit@(HsTyLit _ t) ; unless data_kinds (addErr (dataKindsErr env tyLit)) ; when (negLit t) (addErr negLitErr) ; checkPolyKinds env tyLit - ; return (HsTyLit noExt t, emptyFVs) } + ; return (HsTyLit noExtField t, emptyFVs) } where negLit (HsStrTy _ _) = False negLit (HsNumTy _ i) = i < 0 @@ -598,7 +598,7 @@ rnHsTyKi env tyLit@(HsTyLit _ t) rnHsTyKi env (HsAppTy _ ty1 ty2) = do { (ty1', fvs1) <- rnLHsTyKi env ty1 ; (ty2', fvs2) <- rnLHsTyKi env ty2 - ; return (HsAppTy noExt ty1' ty2', fvs1 `plusFV` fvs2) } + ; return (HsAppTy noExtField ty1' ty2', fvs1 `plusFV` fvs2) } rnHsTyKi env (HsAppKindTy l ty k) = do { kind_app <- xoptM LangExt.TypeApplications @@ -610,10 +610,10 @@ rnHsTyKi env (HsAppKindTy l ty k) rnHsTyKi env t@(HsIParamTy _ n ty) = do { notInKinds env t ; (ty', fvs) <- rnLHsTyKi env ty - ; return (HsIParamTy noExt n ty', fvs) } + ; return (HsIParamTy noExtField n ty', fvs) } rnHsTyKi _ (HsStarTy _ isUni) - = return (HsStarTy noExt isUni, emptyFVs) + = return (HsStarTy noExtField isUni, emptyFVs) rnHsTyKi _ (HsSpliceTy _ sp) = rnSpliceType sp @@ -621,7 +621,7 @@ rnHsTyKi _ (HsSpliceTy _ sp) rnHsTyKi env (HsDocTy _ ty haddock_doc) = do { (ty', fvs) <- rnLHsTyKi env ty ; haddock_doc' <- rnLHsDoc haddock_doc - ; return (HsDocTy noExt ty' haddock_doc', fvs) } + ; return (HsDocTy noExtField ty' haddock_doc', fvs) } rnHsTyKi _ (XHsType (NHsCoreTy ty)) = return (XHsType (NHsCoreTy ty), emptyFVs) @@ -633,18 +633,18 @@ rnHsTyKi env ty@(HsExplicitListTy _ ip tys) ; data_kinds <- xoptM LangExt.DataKinds ; unless data_kinds (addErr (dataKindsErr env ty)) ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys - ; return (HsExplicitListTy noExt ip tys', fvs) } + ; return (HsExplicitListTy noExtField ip tys', fvs) } rnHsTyKi env ty@(HsExplicitTupleTy _ tys) = do { checkPolyKinds env ty ; data_kinds <- xoptM LangExt.DataKinds ; unless data_kinds (addErr (dataKindsErr env ty)) ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys - ; return (HsExplicitTupleTy noExt tys', fvs) } + ; return (HsExplicitTupleTy noExtField tys', fvs) } rnHsTyKi env (HsWildCardTy _) = do { checkAnonWildCard env - ; return (HsWildCardTy noExt, emptyFVs) } + ; return (HsWildCardTy noExtField, emptyFVs) } -------------- rnTyVar :: RnTyKiEnv -> RdrName -> RnM Name @@ -1000,7 +1000,7 @@ bindLHsTyVarBndr doc mb_assoc (dL->L loc (KindedTyVar x lrdr@(dL->L lv _) kind)) $ thing_inside (cL loc (KindedTyVar x (cL lv tv_nm) kind')) ; return (b, fvs1 `plusFV` fvs2) } -bindLHsTyVarBndr _ _ (dL->L _ (XTyVarBndr{})) _ = panic "bindLHsTyVarBndr" +bindLHsTyVarBndr _ _ (dL->L _ (XTyVarBndr nec)) _ = noExtCon nec bindLHsTyVarBndr _ _ _ _ = panic "bindLHsTyVarBndr: Impossible Match" -- due to #15884 @@ -1042,7 +1042,7 @@ rnField fl_env env (dL->L l (ConDeclField _ names ty haddock_doc)) = do { let new_names = map (fmap lookupField) names ; (new_ty, fvs) <- rnLHsTyKi env ty ; new_haddock_doc <- rnMbLHsDoc haddock_doc - ; return (cL l (ConDeclField noExt new_names new_ty new_haddock_doc) + ; return (cL l (ConDeclField noExtField new_names new_ty new_haddock_doc) , fvs) } where lookupField :: FieldOcc GhcPs -> FieldOcc GhcRn @@ -1051,8 +1051,8 @@ rnField fl_env env (dL->L l (ConDeclField _ names ty haddock_doc)) where lbl = occNameFS $ rdrNameOcc rdr fl = expectJust "rnField" $ lookupFsEnv fl_env lbl - lookupField (XFieldOcc{}) = panic "rnField" -rnField _ _ (dL->L _ (XConDeclField _)) = panic "rnField" + lookupField (XFieldOcc nec) = noExtCon nec +rnField _ _ (dL->L _ (XConDeclField nec)) = noExtCon nec rnField _ _ _ = panic "rnField: Impossible Match" -- due to #15884 @@ -1088,15 +1088,15 @@ mkHsOpTyRn :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> RnM (HsType GhcRn) -mkHsOpTyRn mk1 pp_op1 fix1 ty1 (dL->L loc2 (HsOpTy noExt ty21 op2 ty22)) +mkHsOpTyRn mk1 pp_op1 fix1 ty1 (dL->L loc2 (HsOpTy noExtField ty21 op2 ty22)) = do { fix2 <- lookupTyFixityRn op2 ; mk_hs_op_ty mk1 pp_op1 fix1 ty1 - (\t1 t2 -> HsOpTy noExt t1 op2 t2) + (\t1 t2 -> HsOpTy noExtField t1 op2 t2) (unLoc op2) fix2 ty21 ty22 loc2 } mkHsOpTyRn mk1 pp_op1 fix1 ty1 (dL->L loc2 (HsFunTy _ ty21 ty22)) = mk_hs_op_ty mk1 pp_op1 fix1 ty1 - (HsFunTy noExt) funTyConName funTyFixity ty21 ty22 loc2 + (HsFunTy noExtField) funTyConName funTyFixity ty21 ty22 loc2 mkHsOpTyRn mk1 _ _ ty1 ty2 -- Default case, no rearrangment = return (mk1 ty1 ty2) @@ -1148,7 +1148,7 @@ mkOpAppRn e1@(dL->L _ (NegApp _ neg_arg neg_name)) op2 fix2 e2 | associate_right = do new_e <- mkOpAppRn neg_arg op2 fix2 e2 - return (NegApp noExt (cL loc' new_e) neg_name) + return (NegApp noExtField (cL loc' new_e) neg_name) where loc' = combineLocs neg_arg e2 (nofix_error, associate_right) = compareFixity negateFixity fix2 @@ -1210,7 +1210,7 @@ mkNegAppRn :: LHsExpr (GhcPass id) -> SyntaxExpr (GhcPass id) -> RnM (HsExpr (GhcPass id)) mkNegAppRn neg_arg neg_name = ASSERT( not_op_app (unLoc neg_arg) ) - return (NegApp noExt neg_arg neg_name) + return (NegApp noExtField neg_arg neg_name) not_op_app :: HsExpr id -> Bool not_op_app (OpApp {}) = False @@ -1234,7 +1234,7 @@ mkOpFormRn a1@(dL->L loc | associate_right = do new_c <- mkOpFormRn a12 op2 fix2 a2 - return (HsCmdArrForm noExt op1 f (Just fix1) + return (HsCmdArrForm noExtField op1 f (Just fix1) [a11, cL loc (HsCmdTop [] (cL loc new_c))]) -- TODO: locs are wrong where @@ -1242,7 +1242,7 @@ mkOpFormRn a1@(dL->L loc -- Default case mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment - = return (HsCmdArrForm noExt op Infix (Just fix) [arg1, arg2]) + = return (HsCmdArrForm noExtField op Infix (Just fix) [arg1, arg2]) -------------------------------------- @@ -1296,7 +1296,7 @@ checkPrecMatch op (MG { mg_alts = (dL->L _ ms) }) -- but the second eqn has no args (an error, but not discovered -- until the type checker). So we don't want to crash on the -- second eqn. -checkPrecMatch _ (XMatchGroup {}) = panic "checkPrecMatch" +checkPrecMatch _ (XMatchGroup nec) = noExtCon nec checkPrec :: Name -> Pat GhcRn -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) () checkPrec op (ConPatIn op1 (InfixCon _ _)) right = do @@ -1677,7 +1677,7 @@ extractRdrKindSigVars (dL->L _ resultSig) extractDataDefnKindVars :: HsDataDefn GhcPs -> FreeKiTyVarsNoDups extractDataDefnKindVars (HsDataDefn { dd_kindSig = ksig }) = maybe [] extractHsTyRdrTyVars ksig -extractDataDefnKindVars (XHsDataDefn _) = panic "extractDataDefnKindVars" +extractDataDefnKindVars (XHsDataDefn nec) = noExtCon nec extract_lctxt :: LHsContext GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups diff --git a/compiler/simplStg/StgLiftLams/Transformation.hs b/compiler/simplStg/StgLiftLams/Transformation.hs index 7b37bac91e..bef39a1856 100644 --- a/compiler/simplStg/StgLiftLams/Transformation.hs +++ b/compiler/simplStg/StgLiftLams/Transformation.hs @@ -107,12 +107,12 @@ liftRhs mb_former_fvs rhs@(StgRhsCon ccs con args) liftRhs Nothing (StgRhsClosure _ ccs upd infos body) = do -- This RHS wasn't lifted. withSubstBndrs (map binderInfoBndr infos) $ \bndrs' -> - StgRhsClosure noExtSilent ccs upd bndrs' <$> liftExpr body + StgRhsClosure noExtFieldSilent ccs upd bndrs' <$> liftExpr body liftRhs (Just former_fvs) (StgRhsClosure _ ccs upd infos body) = do -- This RHS was lifted. Insert extra binders for @former_fvs@. withSubstBndrs (map binderInfoBndr infos) $ \bndrs' -> do let bndrs'' = dVarSetElems former_fvs ++ bndrs' - StgRhsClosure noExtSilent ccs upd bndrs'' <$> liftExpr body + StgRhsClosure noExtFieldSilent ccs upd bndrs'' <$> liftExpr body liftArgs :: InStgArg -> LiftM OutStgArg liftArgs a@(StgLitArg _) = pure a @@ -142,13 +142,13 @@ liftExpr (StgLet scope bind body) body' <- liftExpr body case mb_bind' of Nothing -> pure body' -- withLiftedBindPairs decided to lift it and already added floats - Just bind' -> pure (StgLet noExtSilent bind' body') + Just bind' -> pure (StgLet noExtFieldSilent bind' body') liftExpr (StgLetNoEscape scope bind body) = withLiftedBind NotTopLevel bind scope $ \mb_bind' -> do body' <- liftExpr body case mb_bind' of Nothing -> pprPanic "stgLiftLams" (text "Should never decide to lift LNEs") - Just bind' -> pure (StgLetNoEscape noExtSilent bind' body') + Just bind' -> pure (StgLetNoEscape noExtFieldSilent bind' body') liftAlt :: LlStgAlt -> LiftM OutStgAlt liftAlt (con, infos, rhs) = withSubstBndrs (map binderInfoBndr infos) $ \bndrs' -> diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs index dae1e351eb..7a530009fe 100644 --- a/compiler/stgSyn/CoreToStg.hs +++ b/compiler/stgSyn/CoreToStg.hs @@ -644,8 +644,8 @@ coreToStgLet bind body = do -- Compute the new let-expression let - new_let | isJoinBind bind = StgLetNoEscape noExtSilent bind2 body2 - | otherwise = StgLet noExtSilent bind2 body2 + new_let | isJoinBind bind = StgLetNoEscape noExtFieldSilent bind2 body2 + | otherwise = StgLet noExtFieldSilent bind2 body2 return new_let where @@ -688,7 +688,7 @@ mkTopStgRhs :: DynFlags -> Module -> CollectedCCs mkTopStgRhs dflags this_mod ccs bndr rhs | StgLam bndrs body <- rhs = -- StgLam can't have empty arguments, so not CAF - ( StgRhsClosure noExtSilent + ( StgRhsClosure noExtFieldSilent dontCareCCS ReEntrant (toList bndrs) body @@ -704,13 +704,13 @@ mkTopStgRhs dflags this_mod ccs bndr rhs -- Otherwise it's a CAF, see Note [Cost-centre initialization plan]. | gopt Opt_AutoSccsOnIndividualCafs dflags - = ( StgRhsClosure noExtSilent + = ( StgRhsClosure noExtFieldSilent caf_ccs upd_flag [] rhs , collectCC caf_cc caf_ccs ccs ) | otherwise - = ( StgRhsClosure noExtSilent + = ( StgRhsClosure noExtFieldSilent all_cafs_ccs upd_flag [] rhs , ccs ) @@ -738,14 +738,14 @@ mkTopStgRhs dflags this_mod ccs bndr rhs mkStgRhs :: Id -> StgExpr -> StgRhs mkStgRhs bndr rhs | StgLam bndrs body <- rhs - = StgRhsClosure noExtSilent + = StgRhsClosure noExtFieldSilent currentCCS ReEntrant (toList bndrs) body | isJoinId bndr -- must be a nullary join point = ASSERT(idJoinArity bndr == 0) - StgRhsClosure noExtSilent + StgRhsClosure noExtFieldSilent currentCCS ReEntrant -- ignored for LNE [] rhs @@ -754,7 +754,7 @@ mkStgRhs bndr rhs = StgRhsCon currentCCS con args | otherwise - = StgRhsClosure noExtSilent + = StgRhsClosure noExtFieldSilent currentCCS upd_flag [] rhs where diff --git a/compiler/stgSyn/StgSyn.hs b/compiler/stgSyn/StgSyn.hs index e6a1205399..f7dae5dbe2 100644 --- a/compiler/stgSyn/StgSyn.hs +++ b/compiler/stgSyn/StgSyn.hs @@ -25,7 +25,7 @@ module StgSyn ( GenStgAlt, AltType(..), StgPass(..), BinderP, XRhsClosure, XLet, XLetNoEscape, - NoExtSilent, noExtSilent, + NoExtFieldSilent, noExtFieldSilent, OutputablePass, UpdateFlag(..), isUpdatable, @@ -450,19 +450,19 @@ data StgPass | LiftLams | CodeGen --- | Like 'HsExpression.NoExt', but with an 'Outputable' instance that returns --- 'empty'. -data NoExtSilent = NoExtSilent +-- | Like 'HsExtension.NoExtField', but with an 'Outputable' instance that +-- returns 'empty'. +data NoExtFieldSilent = NoExtFieldSilent deriving (Data, Eq, Ord) -instance Outputable NoExtSilent where +instance Outputable NoExtFieldSilent where ppr _ = empty -- | Used when constructing a term with an unused extension point that should -- not appear in pretty-printed output at all. -noExtSilent :: NoExtSilent -noExtSilent = NoExtSilent --- TODO: Maybe move this to HsExtensions? I'm not sure about the implications +noExtFieldSilent :: NoExtFieldSilent +noExtFieldSilent = NoExtFieldSilent +-- TODO: Maybe move this to HsExtension? I'm not sure about the implications -- on build time... -- TODO: Do we really want to the extension point type families to have a closed @@ -472,17 +472,17 @@ type instance BinderP 'Vanilla = Id type instance BinderP 'CodeGen = Id type family XRhsClosure (pass :: StgPass) -type instance XRhsClosure 'Vanilla = NoExtSilent +type instance XRhsClosure 'Vanilla = NoExtFieldSilent -- | Code gen needs to track non-global free vars type instance XRhsClosure 'CodeGen = DIdSet type family XLet (pass :: StgPass) -type instance XLet 'Vanilla = NoExtSilent -type instance XLet 'CodeGen = NoExtSilent +type instance XLet 'Vanilla = NoExtFieldSilent +type instance XLet 'CodeGen = NoExtFieldSilent type family XLetNoEscape (pass :: StgPass) -type instance XLetNoEscape 'Vanilla = NoExtSilent -type instance XLetNoEscape 'CodeGen = NoExtSilent +type instance XLetNoEscape 'Vanilla = NoExtFieldSilent +type instance XLetNoEscape 'CodeGen = NoExtFieldSilent stgRhsArity :: StgRhs -> Int stgRhsArity (StgRhsClosure _ _ _ bndrs _) diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index 28794aaafa..1ec85b22d1 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -103,7 +103,7 @@ newMethodFromName origin name ty_args ; wrap <- ASSERT( not (isForAllTy ty) && isSingleton theta ) instCall origin ty_args theta - ; return (mkHsWrap wrap (HsVar noExt (noLoc id))) } + ; return (mkHsWrap wrap (HsVar noExtField (noLoc id))) } {- ************************************************************************ @@ -534,7 +534,7 @@ newOverloadedLit = newNonTrivialOverloadedLit orig lit res_ty where orig = LiteralOrigin lit -newOverloadedLit XOverLit{} _ = panic "newOverloadedLit" +newOverloadedLit (XOverLit nec) _ = noExtCon nec -- Does not handle things that 'shortCutLit' can handle. See also -- newOverloadedLit in TcUnify @@ -566,7 +566,7 @@ mkOverLit (HsIntegral i) mkOverLit (HsFractional r) = do { rat_ty <- tcMetaTy rationalTyConName - ; return (HsRat noExt r rat_ty) } + ; return (HsRat noExtField r rat_ty) } mkOverLit (HsIsString src s) = return (HsString src s) diff --git a/compiler/typecheck/TcAnnotations.hs b/compiler/typecheck/TcAnnotations.hs index 60f21ccce7..00c1958106 100644 --- a/compiler/typecheck/TcAnnotations.hs +++ b/compiler/typecheck/TcAnnotations.hs @@ -66,7 +66,7 @@ tcAnnotation (L loc ann@(HsAnnotation _ _ provenance expr)) = do where safeHsErr = vcat [ text "Annotations are not compatible with Safe Haskell." , text "See https://gitlab.haskell.org/ghc/ghc/issues/10826" ] -tcAnnotation (L _ (XAnnDecl _)) = panic "tcAnnotation" +tcAnnotation (L _ (XAnnDecl nec)) = noExtCon nec annProvenanceToTarget :: Module -> AnnProvenance Name -> AnnTarget Name diff --git a/compiler/typecheck/TcArrows.hs b/compiler/typecheck/TcArrows.hs index 763684bb75..c5e3ca99b2 100644 --- a/compiler/typecheck/TcArrows.hs +++ b/compiler/typecheck/TcArrows.hs @@ -126,7 +126,7 @@ tcCmdTop env (L loc (HsCmdTop names cmd)) cmd_ty@(cmd_stk, res_ty) do { cmd' <- tcCmd env cmd cmd_ty ; names' <- mapM (tcSyntaxName ProcOrigin (cmd_arr env)) names ; return (L loc $ HsCmdTop (CmdTopTc cmd_stk res_ty names') cmd') } -tcCmdTop _ (L _ XCmdTop{}) _ = panic "tcCmdTop" +tcCmdTop _ (L _ (XCmdTop nec)) _ = noExtCon nec ---------------------------------------- tcCmd :: CmdEnv -> LHsCmd GhcRn -> CmdType -> TcM (LHsCmd GhcTcId) @@ -254,7 +254,7 @@ tc_cmd env tcPats LambdaExpr pats (map mkCheckExpType arg_tys) $ tc_grhss grhss cmd_stk' (mkCheckExpType res_ty) - ; let match' = L mtch_loc (Match { m_ext = noExt + ; let match' = L mtch_loc (Match { m_ext = noExtField , m_ctxt = LambdaExpr, m_pats = pats' , m_grhss = grhss' }) arg_tys = map hsLPatType pats' @@ -271,14 +271,14 @@ tc_cmd env = do { (binds', grhss') <- tcLocalBinds binds $ mapM (wrapLocM (tc_grhs stk_ty res_ty)) grhss ; return (GRHSs x grhss' (L l binds')) } - tc_grhss (XGRHSs _) _ _ = panic "tc_grhss" + tc_grhss (XGRHSs nec) _ _ = noExtCon nec tc_grhs stk_ty res_ty (GRHS x guards body) = do { (guards', rhs') <- tcStmtsAndThen pg_ctxt tcGuardStmt guards res_ty $ \ res_ty -> tcCmd env body (stk_ty, checkingExpType "tc_grhs" res_ty) ; return (GRHS x guards' rhs') } - tc_grhs _ _ (XGRHS _) = panic "tc_grhs" + tc_grhs _ _ (XGRHS nec) = noExtCon nec ------------------------------------------- -- Do notation @@ -323,7 +323,7 @@ tc_cmd env cmd@(HsCmdArrForm x expr f fixity cmd_args) (cmd_stk, res_ty) ; cmd' <- tcCmdTop env' cmd (stk_ty, res_ty) ; return (cmd', mkCmdArrTy env' (mkPairTy alphaTy stk_ty) res_ty) } -tc_cmd _ (XCmd {}) _ = panic "tc_cmd" +tc_cmd _ (XCmd nec) _ = noExtCon nec ----------------------------------------------------------------- -- Base case for illegal commands diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 6539c0d3e2..fcf871f75f 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -360,17 +360,17 @@ tcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside ; ip_id <- newDict ipClass [ p, ty ] ; expr' <- tcMonoExpr expr (mkCheckExpType ty) ; let d = toDict ipClass p ty `fmap` expr' - ; return (ip_id, (IPBind noExt (Right ip_id) d)) } + ; return (ip_id, (IPBind noExtField (Right ip_id) d)) } tc_ip_bind _ (IPBind _ (Right {}) _) = panic "tc_ip_bind" - tc_ip_bind _ (XIPBind _) = panic "tc_ip_bind" + tc_ip_bind _ (XIPBind nec) = noExtCon nec -- Coerces a `t` into a dictionry for `IP "x" t`. -- co : t -> IP "x" t toDict ipClass x ty = mkHsWrap $ mkWpCastR $ wrapIP $ mkClassPred ipClass [x,ty] -tcLocalBinds (HsIPBinds _ (XHsIPBinds _ )) _ = panic "tcLocalBinds" -tcLocalBinds (XHsLocalBindsLR _) _ = panic "tcLocalBinds" +tcLocalBinds (HsIPBinds _ (XHsIPBinds nec)) _ = noExtCon nec +tcLocalBinds (XHsLocalBindsLR nec) _ = noExtCon nec {- Note [Implicit parameter untouchables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -726,14 +726,14 @@ tcPolyCheck prag_fn , fun_ext = placeHolderNamesTc , fun_tick = tick } - export = ABE { abe_ext = noExt - , abe_wrap = idHsWrapper + export = ABE { abe_ext = noExtField + , abe_wrap = idHsWrapper , abe_poly = poly_id , abe_mono = mono_id , abe_prags = SpecPrags spec_prags } abs_bind = cL loc $ - AbsBinds { abs_ext = noExt + AbsBinds { abs_ext = noExtField , abs_tvs = skol_tvs , abs_ev_vars = ev_vars , abs_ev_binds = [ev_binds] @@ -816,7 +816,7 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list ; loc <- getSrcSpanM ; let poly_ids = map abe_poly exports abs_bind = cL loc $ - AbsBinds { abs_ext = noExt + AbsBinds { abs_ext = noExtField , abs_tvs = qtvs , abs_ev_vars = givens, abs_ev_binds = [ev_binds] , abs_exports = exports, abs_binds = binds' @@ -877,7 +877,7 @@ mkExport prag_fn insoluble qtvs theta ; when warn_missing_sigs $ localSigWarn Opt_WarnMissingLocalSignatures poly_id mb_sig - ; return (ABE { abe_ext = noExt + ; return (ABE { abe_ext = noExtField , abe_wrap = wrap -- abe_wrap :: idType poly_id ~ (forall qtvs. theta => mono_ty) , abe_poly = poly_id diff --git a/compiler/typecheck/TcClassDcl.hs b/compiler/typecheck/TcClassDcl.hs index f085e07f14..f4d89e517e 100644 --- a/compiler/typecheck/TcClassDcl.hs +++ b/compiler/typecheck/TcClassDcl.hs @@ -284,12 +284,12 @@ tcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn tcPolyCheck no_prag_fn local_dm_sig (L bind_loc lm_bind) - ; let export = ABE { abe_ext = noExt + ; let export = ABE { abe_ext = noExtField , abe_poly = global_dm_id , abe_mono = local_dm_id , abe_wrap = idHsWrapper , abe_prags = IsDefaultMethod } - full_bind = AbsBinds { abs_ext = noExt + full_bind = AbsBinds { abs_ext = noExtField , abs_tvs = tyvars , abs_ev_vars = [this_dict] , abs_exports = [export] diff --git a/compiler/typecheck/TcDefaults.hs b/compiler/typecheck/TcDefaults.hs index d091e9c156..926eca1ac0 100644 --- a/compiler/typecheck/TcDefaults.hs +++ b/compiler/typecheck/TcDefaults.hs @@ -66,7 +66,7 @@ tcDefaults [L locn (DefaultDecl _ mono_tys)] tcDefaults decls@(L locn (DefaultDecl _ _) : _) = setSrcSpan locn $ failWithTc (dupDefaultDeclErr decls) -tcDefaults (L _ (XDefaultDecl _):_) = panic "tcDefaults" +tcDefaults (L _ (XDefaultDecl nec):_) = noExtCon nec tc_default_ty :: [Class] -> LHsType GhcRn -> TcM Type @@ -100,8 +100,8 @@ dupDefaultDeclErr (L _ (DefaultDecl _ _) : dup_things) where pp (L locn (DefaultDecl _ _)) = text "here was another default declaration" <+> ppr locn - pp (L _ (XDefaultDecl _)) = panic "dupDefaultDeclErr" -dupDefaultDeclErr (L _ (XDefaultDecl _) : _) = panic "dupDefaultDeclErr" + pp (L _ (XDefaultDecl nec)) = noExtCon nec +dupDefaultDeclErr (L _ (XDefaultDecl nec) : _) = noExtCon nec dupDefaultDeclErr [] = panic "dupDefaultDeclErr []" badDefaultTy :: Type -> [Class] -> SDoc diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 224a6a713a..4ab9fa69d3 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -329,7 +329,7 @@ renameDeriv is_boot inst_infos bagBinds -- before renaming the instances themselves ; traceTc "rnd" (vcat (map (\i -> pprInstInfoDetails i $$ text "") inst_infos)) ; (aux_binds, aux_sigs) <- mapAndUnzipBagM return bagBinds - ; let aux_val_binds = ValBinds noExt aux_binds (bagToList aux_sigs) + ; let aux_val_binds = ValBinds noExtField aux_binds (bagToList aux_sigs) ; rn_aux_lhs <- rnTopBindsLHS emptyFsEnv aux_val_binds ; let bndrs = collectHsValBinders rn_aux_lhs ; envs <- extendGlobalRdrEnvRn (map avail bndrs) emptyFsEnv ; @@ -680,7 +680,7 @@ deriveStandalone (L loc (DerivDecl _ deriv_ty mbl_deriv_strat overlap_mode)) bale_out $ text "The last argument of the instance must be a data or newtype application" } -deriveStandalone (L _ (XDerivDecl _)) = panic "deriveStandalone" +deriveStandalone (L _ (XDerivDecl nec)) = noExtCon nec -- Typecheck the type in a standalone deriving declaration. -- @@ -716,7 +716,7 @@ tcStandaloneDerivInstType ctxt = L (getLoc deriv_ty_body) $ HsForAllTy { hst_fvf = ForallInvis , hst_bndrs = tvs - , hst_xforall = noExt + , hst_xforall = noExtField , hst_body = rho }} let (tvs, _theta, cls, inst_tys) = tcSplitDFunTy dfun_ty pure (tvs, InferContext (Just wc_span), cls, inst_tys) @@ -725,10 +725,10 @@ tcStandaloneDerivInstType ctxt let (tvs, theta, cls, inst_tys) = tcSplitDFunTy dfun_ty pure (tvs, SupplyContext theta, cls, inst_tys) -tcStandaloneDerivInstType _ (HsWC _ (XHsImplicitBndrs _)) - = panic "tcStandaloneDerivInstType" -tcStandaloneDerivInstType _ (XHsWildCardBndrs _) - = panic "tcStandaloneDerivInstType" +tcStandaloneDerivInstType _ (HsWC _ (XHsImplicitBndrs nec)) + = noExtCon nec +tcStandaloneDerivInstType _ (XHsWildCardBndrs nec) + = noExtCon nec warnUselessTypeable :: TcM () warnUselessTypeable diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index f0be9a83ab..533f137385 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -706,18 +706,18 @@ tcAddDataFamConPlaceholders inst_decls thing_inside get_cons (L _ (DataFamInstD { dfid_inst = fid })) = get_fi_cons fid get_cons (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fids } })) = concatMap (get_fi_cons . unLoc) fids - get_cons (L _ (ClsInstD _ (XClsInstDecl _))) = panic "get_cons" - get_cons (L _ (XInstDecl _)) = panic "get_cons" + get_cons (L _ (ClsInstD _ (XClsInstDecl nec))) = noExtCon nec + get_cons (L _ (XInstDecl nec)) = noExtCon nec get_fi_cons :: DataFamInstDecl GhcRn -> [Name] get_fi_cons (DataFamInstDecl { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = HsDataDefn { dd_cons = cons } }}}) = map unLoc $ concatMap (getConNames . unLoc) cons get_fi_cons (DataFamInstDecl { dfid_eqn = HsIB { hsib_body = - FamEqn { feqn_rhs = XHsDataDefn _ }}}) - = panic "get_fi_cons" - get_fi_cons (DataFamInstDecl (HsIB _ (XFamEqn _))) = panic "get_fi_cons" - get_fi_cons (DataFamInstDecl (XHsImplicitBndrs _)) = panic "get_fi_cons" + FamEqn { feqn_rhs = XHsDataDefn nec }}}) + = noExtCon nec + get_fi_cons (DataFamInstDecl (HsIB _ (XFamEqn nec))) = noExtCon nec + get_fi_cons (DataFamInstDecl (XHsImplicitBndrs nec)) = noExtCon nec tcAddPatSynPlaceholders :: [PatSynBind GhcRn GhcRn] -> TcM a -> TcM a diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 891f3ad8c3..e8d5ee6baa 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -211,7 +211,7 @@ tcExpr e@(HsIPVar _ x) res_ty ; ipClass <- tcLookupClass ipClassName ; ip_var <- emitWantedEvVar origin (mkClassPred ipClass [ip_name, ip_ty]) ; tcWrapResult e - (fromDict ipClass ip_name ip_ty (HsVar noExt (noLoc ip_var))) + (fromDict ipClass ip_name ip_ty (HsVar noExtField (noLoc ip_var))) ip_ty res_ty } where -- Coerces a dictionary for `IP "x" t` into `t`. @@ -230,7 +230,7 @@ tcExpr e@(HsOverLabel _ mb_fromLabel l) res_ty ; loc <- getSrcSpanM ; var <- emitWantedEvVar origin pred ; tcWrapResult e - (fromDict pred (HsVar noExt (L loc var))) + (fromDict pred (HsVar noExtField (L loc var))) alpha res_ty } } where -- Coerces a dictionary for `IsLabel "x" t` into `t`, @@ -240,9 +240,9 @@ tcExpr e@(HsOverLabel _ mb_fromLabel l) res_ty lbl = mkStrLitTy l applyFromLabel loc fromLabel = - HsAppType noExt - (L loc (HsVar noExt (L loc fromLabel))) - (mkEmptyWildCardBndrs (L loc (HsTyLit noExt (HsStrTy NoSourceText l)))) + HsAppType noExtField + (L loc (HsVar noExtField (L loc fromLabel))) + (mkEmptyWildCardBndrs (L loc (HsTyLit noExtField (HsStrTy NoSourceText l)))) tcExpr (HsLam x match) res_ty = do { (match', wrap) <- tcMatchLambda herald match_ctxt match res_ty @@ -271,7 +271,7 @@ tcExpr e@(ExprWithTySig _ expr sig_ty) res_ty ; sig_info <- checkNoErrs $ -- Avoid error cascade tcUserTypeSig loc sig_ty Nothing ; (expr', poly_ty) <- tcExprSig expr sig_info - ; let expr'' = ExprWithTySig noExt expr' sig_ty + ; let expr'' = ExprWithTySig noExtField expr' sig_ty ; tcWrapResult e expr'' poly_ty res_ty } {- @@ -361,7 +361,7 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty ; arg2_ty <- readExpType arg2_exp_ty ; op_id <- tcLookupId op_name ; let op' = L loc (mkHsWrap (mkWpTyApps [arg1_ty, arg2_ty]) - (HsVar noExt (L lv op_id))) + (HsVar noExtField (L lv op_id))) ; return $ OpApp fix arg1' op' arg2' } | (L loc (HsVar _ (L lv op_name))) <- op @@ -399,7 +399,7 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty ; let op' = L loc (mkHsWrap (mkWpTyApps [ getRuntimeRep op_res_ty , arg2_sigma , op_res_ty]) - (HsVar noExt (L lv op_id))) + (HsVar noExtField (L lv op_id))) -- arg1' :: arg1_ty -- wrap_arg1 :: arg1_ty "->" (arg2_sigma -> op_res_ty) -- op' :: (a2_ty -> op_res_ty) -> a2_ty -> op_res_ty @@ -413,7 +413,7 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty -- See Note [Disambiguating record fields] = do { sig_tc_ty <- tcHsSigWcType ExprSigCtxt sig_ty ; sel_name <- disambiguateSelector lbl sig_tc_ty - ; let op' = L loc (HsRecFld noExt (Unambiguous sel_name lbl)) + ; let op' = L loc (HsRecFld noExtField (Unambiguous sel_name lbl)) ; tcExpr (OpApp fix arg1 op' arg2) res_ty } @@ -636,7 +636,7 @@ tcExpr (HsStatic fvs expr) res_ty [p_ty] ; let wrap = mkWpTyApps [expr_ty] ; loc <- getSrcSpanM - ; return $ mkHsWrapCo co $ HsApp noExt + ; return $ mkHsWrapCo co $ HsApp noExtField (L loc $ mkHsWrap wrap fromStaticPtr) (L loc (HsStatic fvs expr')) } @@ -1096,7 +1096,7 @@ wrapHsArgs :: (NoGhcTc (GhcPass id) ~ GhcRn) wrapHsArgs f [] = f wrapHsArgs f (HsValArg a : args) = wrapHsArgs (mkHsApp f a) args wrapHsArgs f (HsTypeArg _ t : args) = wrapHsArgs (mkHsAppType f t) args -wrapHsArgs f (HsArgPar sp : args) = wrapHsArgs (L sp $ HsPar noExt f) args +wrapHsArgs f (HsArgPar sp : args) = wrapHsArgs (L sp $ HsPar noExtField f) args isHsValArg :: HsArg tm ty -> Bool isHsValArg (HsValArg {}) = True @@ -1164,7 +1164,7 @@ tcApp m_herald fun@(L loc (HsVar _ (L _ fun_id))) args res_ty ; let [alpha, beta] = mkTemplateTyVars [liftedTypeKind, tYPE rep] seq_ty = mkSpecForAllTys [alpha,beta] (mkTyVarTy alpha `mkVisFunTy` mkTyVarTy beta `mkVisFunTy` mkTyVarTy beta) - seq_fun = L loc (HsVar noExt (L loc seqId)) + seq_fun = L loc (HsVar noExtField (L loc seqId)) -- seq_ty = forall (a:*) (b:TYPE r). a -> b -> b -- where 'r' is a meta type variable ; tcFunApp m_herald fun seq_fun seq_ty args res_ty } @@ -1419,7 +1419,7 @@ tcTupArgs args tys go (L l (Missing {}), arg_ty) = return (L l (Missing arg_ty)) go (L l (Present x expr), arg_ty) = do { expr' <- tcPolyExpr expr arg_ty ; return (L l (Present x expr')) } - go (L _ (XTupArg{}), _) = panic "tcTupArgs" + go (L _ (XTupArg nec), _) = noExtCon nec --------------------------- -- See TcType.SyntaxOpType also for commentary @@ -1721,14 +1721,14 @@ tcCheckId :: Name -> ExpRhoType -> TcM (HsExpr GhcTcId) tcCheckId name res_ty = do { (expr, actual_res_ty) <- tcInferId name ; traceTc "tcCheckId" (vcat [ppr name, ppr actual_res_ty, ppr res_ty]) - ; addFunResCtxt False (HsVar noExt (noLoc name)) actual_res_ty res_ty $ - tcWrapResultO (OccurrenceOf name) (HsVar noExt (noLoc name)) expr + ; addFunResCtxt False (HsVar noExtField (noLoc name)) actual_res_ty res_ty $ + tcWrapResultO (OccurrenceOf name) (HsVar noExtField (noLoc name)) expr actual_res_ty res_ty } tcCheckRecSelId :: HsExpr GhcRn -> AmbiguousFieldOcc GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId) tcCheckRecSelId rn_expr f@(Unambiguous _ (L _ lbl)) res_ty = do { (expr, actual_res_ty) <- tcInferRecSelId f - ; addFunResCtxt False (HsRecFld noExt f) actual_res_ty res_ty $ + ; addFunResCtxt False (HsRecFld noExtField f) actual_res_ty res_ty $ tcWrapResultO (OccurrenceOfRecSel lbl) rn_expr expr actual_res_ty res_ty } tcCheckRecSelId rn_expr (Ambiguous _ lbl) res_ty = case tcSplitFunTy_maybe =<< checkingExpType_maybe res_ty of @@ -1736,7 +1736,7 @@ tcCheckRecSelId rn_expr (Ambiguous _ lbl) res_ty Just (arg, _) -> do { sel_name <- disambiguateSelector lbl arg ; tcCheckRecSelId rn_expr (Unambiguous sel_name lbl) res_ty } -tcCheckRecSelId _ (XAmbiguousFieldOcc _) _ = panic "tcCheckRecSelId" +tcCheckRecSelId _ (XAmbiguousFieldOcc nec) _ = noExtCon nec ------------------------ tcInferRecSelId :: AmbiguousFieldOcc GhcRn -> TcM (HsExpr GhcTcId, TcRhoType) @@ -1745,7 +1745,7 @@ tcInferRecSelId (Unambiguous sel (L _ lbl)) ; return (expr', ty) } tcInferRecSelId (Ambiguous _ lbl) = ambiguousSelector lbl -tcInferRecSelId (XAmbiguousFieldOcc _) = panic "tcInferRecSelId" +tcInferRecSelId (XAmbiguousFieldOcc nec) = noExtCon nec ------------------------ tcInferId :: Name -> TcM (HsExpr GhcTcId, TcSigmaType) @@ -1774,7 +1774,7 @@ tc_infer_assert assert_name = do { assert_error_id <- tcLookupId assertErrorName ; (wrap, id_rho) <- topInstantiate (OccurrenceOf assert_name) (idType assert_error_id) - ; return (mkHsWrap wrap (HsVar noExt (noLoc assert_error_id)), id_rho) + ; return (mkHsWrap wrap (HsVar noExtField (noLoc assert_error_id)), id_rho) } tc_infer_id :: RdrName -> Name -> TcM (HsExpr GhcTcId, TcSigmaType) @@ -1800,12 +1800,12 @@ tc_infer_id lbl id_name _ -> failWithTc $ ppr thing <+> text "used where a value identifier was expected" } where - return_id id = return (HsVar noExt (noLoc id), idType id) + return_id id = return (HsVar noExtField (noLoc id), idType id) return_data_con con -- For data constructors, must perform the stupid-theta check | null stupid_theta - = return (HsConLikeOut noExt (RealDataCon con), con_ty) + = return (HsConLikeOut noExtField (RealDataCon con), con_ty) | otherwise -- See Note [Instantiating stupid theta] @@ -1816,7 +1816,7 @@ tc_infer_id lbl id_name rho' = substTy subst rho ; wrap <- instCall (OccurrenceOf id_name) tys' theta' ; addDataConStupidTheta con tys' - ; return ( mkHsWrap wrap (HsConLikeOut noExt (RealDataCon con)) + ; return ( mkHsWrap wrap (HsConLikeOut noExtField (RealDataCon con)) , rho') } where @@ -1844,8 +1844,8 @@ tcUnboundId rn_expr unbound res_ty ; let ev = mkLocalId name ty ; can <- newHoleCt (ExprHole unbound) ev ty ; emitInsoluble can - ; tcWrapResultO (UnboundOccurrenceOf occ) rn_expr (HsVar noExt (noLoc ev)) - ty res_ty } + ; tcWrapResultO (UnboundOccurrenceOf occ) rn_expr (HsVar noExtField (noLoc ev)) + ty res_ty } {- @@ -1941,7 +1941,7 @@ tcTagToEnum loc fun_name args res_ty (mk_error ty' doc2) ; arg' <- tcMonoExpr arg (mkCheckExpType intPrimTy) - ; let fun' = L loc (mkHsWrap (WpTyApp rep_ty) (HsVar noExt (L loc fun))) + ; let fun' = L loc (mkHsWrap (WpTyApp rep_ty) (HsVar noExtField (L loc fun))) rep_ty = mkTyConApp rep_tc rep_args out_args = concat [ pars1 @@ -1970,7 +1970,7 @@ too_many_args fun args where pp (HsValArg e) = ppr e pp (HsTypeArg _ (HsWC { hswc_body = L _ t })) = pprHsType t - pp (HsTypeArg _ (XHsWildCardBndrs _)) = panic "too_many_args" + pp (HsTypeArg _ (XHsWildCardBndrs nec)) = noExtCon nec pp (HsArgPar _) = empty @@ -2030,7 +2030,7 @@ checkCrossStageLifting top_lvl id (Brack _ (TcPending ps_var lie_var)) ; lift <- if isStringTy id_ty then do { sid <- tcLookupId THNames.liftStringName -- See Note [Lifting strings] - ; return (HsVar noExt (noLoc sid)) } + ; return (HsVar noExtField (noLoc sid)) } else setConstraintVar lie_var $ -- Put the 'lift' constraint into the right LIE @@ -2446,7 +2446,7 @@ tcRecordField con_like flds_w_tys (L loc (FieldOcc sel_name lbl)) rhs ; return Nothing } where field_lbl = occNameFS $ rdrNameOcc (unLoc lbl) -tcRecordField _ _ (L _ (XFieldOcc _)) _ = panic "tcRecordField" +tcRecordField _ _ (L _ (XFieldOcc nec)) _ = noExtCon nec checkMissingFields :: ConLike -> HsRecordBinds GhcRn -> TcM () diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index b02494b634..2ed1483fab 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -448,7 +448,7 @@ gen_Ord_binds loc tycon = do , mkHsCaseAlt nlWildPat (gtResult op) ] where tag = get_tag data_con - tag_lit = noLoc (HsLit noExt (HsIntPrim NoSourceText (toInteger tag))) + tag_lit = noLoc (HsLit noExtField (HsIntPrim NoSourceText (toInteger tag))) mkInnerEqAlt :: OrdOp -> DataCon -> LMatch GhcPs (LHsExpr GhcPs) -- First argument 'a' known to be built with K @@ -615,7 +615,7 @@ gen_Enum_binds loc tycon = do (nlHsApp (nlHsVar (tag2con_RDR dflags tycon)) (nlHsApps plus_RDR [ nlHsVarApps intDataCon_RDR [ah_RDR] - , nlHsLit (HsInt noExt + , nlHsLit (HsInt noExtField (mkIntegralLit (-1 :: Int)))])) to_enum dflags @@ -776,7 +776,7 @@ gen_Ix_binds loc tycon = do enum_index dflags = mk_easy_FunBind loc unsafeIndex_RDR - [noLoc (AsPat noExt (noLoc c_RDR) + [noLoc (AsPat noExtField (noLoc c_RDR) (nlTuplePat [a_Pat, nlWildPat] Boxed)), d_Pat] ( untag_Expr dflags tycon [(a_RDR, ah_RDR)] ( @@ -1148,7 +1148,7 @@ gen_Show_binds get_fixity loc tycon | otherwise = ([a_Pat, con_pat], showParen_Expr (genOpApp a_Expr ge_RDR (nlHsLit - (HsInt noExt (mkIntegralLit con_prec_plus_one)))) + (HsInt noExtField (mkIntegralLit con_prec_plus_one)))) (nlHsPar (nested_compose_Expr show_thingies))) where data_con_RDR = getRdrName data_con @@ -1241,7 +1241,7 @@ mk_showString_app str = nlHsApp (nlHsVar showString_RDR) (nlHsLit (mkHsString st -- | showsPrec :: Show a => Int -> a -> ShowS mk_showsPrec_app :: Integer -> LHsExpr GhcPs -> LHsExpr GhcPs mk_showsPrec_app p x - = nlHsApps showsPrec_RDR [nlHsLit (HsInt noExt (mkIntegralLit p)), x] + = nlHsApps showsPrec_RDR [nlHsLit (HsInt noExtField (mkIntegralLit p)), x] -- | shows :: Show a => a -> ShowS mk_shows_app :: LHsExpr GhcPs -> LHsExpr GhcPs @@ -1338,7 +1338,7 @@ gen_data dflags data_type_name constr_names loc rep_tc genDataTyCon :: DerivStuff genDataTyCon -- $dT = DerivHsBind (mkHsVarBind loc data_type_name rhs, - L loc (TypeSig noExt [L loc data_type_name] sig_ty)) + L loc (TypeSig noExtField [L loc data_type_name] sig_ty)) sig_ty = mkLHsSigWcType (nlHsTyVar dataType_RDR) rhs = nlHsVar mkDataType_RDR @@ -1348,7 +1348,7 @@ gen_data dflags data_type_name constr_names loc rep_tc genDataDataCon :: DataCon -> RdrName -> DerivStuff genDataDataCon dc constr_name -- $cT1 etc = DerivHsBind (mkHsVarBind loc constr_name rhs, - L loc (TypeSig noExt [L loc constr_name] sig_ty)) + L loc (TypeSig noExtField [L loc constr_name] sig_ty)) where sig_ty = mkLHsSigWcType (nlHsTyVar constr_RDR) rhs = nlHsApps mkConstr_RDR constr_args @@ -1573,8 +1573,8 @@ gen_Lift_binds loc tycon = (listToBag [lift_bind, liftTyped_bind], emptyBag) liftTyped_bind = mkFunBindEC 1 loc liftTyped_RDR (nlHsApp pure_Expr) (map (pats_etc mk_texp) data_cons) - mk_exp = ExpBr NoExt - mk_texp = TExpBr NoExt + mk_exp = ExpBr noExtField + mk_texp = TExpBr noExtField data_cons = tyConDataCons tycon pats_etc mk_bracket data_con @@ -1584,7 +1584,7 @@ gen_Lift_binds loc tycon = (listToBag [lift_bind, liftTyped_bind], emptyBag) data_con_RDR = getRdrName data_con con_arity = dataConSourceArity data_con as_needed = take con_arity as_RDRs - lift_Expr = noLoc (HsBracket NoExt (mk_bracket br_body)) + lift_Expr = noLoc (HsBracket noExtField (mk_bracket br_body)) br_body = nlHsApps (Exact (dataConName data_con)) (map nlHsVar as_needed) @@ -1861,12 +1861,12 @@ gen_Newtype_binds loc cls inst_tvs inst_tys rhs_ty underlying_inst_tys = changeLast inst_tys rhs_ty nlHsAppType :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs -nlHsAppType e s = noLoc (HsAppType noExt e hs_ty) +nlHsAppType e s = noLoc (HsAppType noExtField e hs_ty) where hs_ty = mkHsWildCardBndrs $ parenthesizeHsType appPrec (typeToLHsType s) nlExprWithTySig :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs -nlExprWithTySig e s = noLoc $ ExprWithTySig noExt (parenthesizeHsExpr sigPrec e) hs_ty +nlExprWithTySig e s = noLoc $ ExprWithTySig noExtField (parenthesizeHsExpr sigPrec e) hs_ty where hs_ty = mkLHsSigWcType (typeToLHsType s) @@ -1916,7 +1916,7 @@ genAuxBindSpec :: DynFlags -> SrcSpan -> AuxBindSpec -> (LHsBind GhcPs, LSig GhcPs) genAuxBindSpec dflags loc (DerivCon2Tag tycon) = (mkFunBindSE 0 loc rdr_name eqns, - L loc (TypeSig noExt [L loc rdr_name] sig_ty)) + L loc (TypeSig noExtField [L loc rdr_name] sig_ty)) where rdr_name = con2tag_RDR dflags tycon @@ -1942,7 +1942,7 @@ genAuxBindSpec dflags loc (DerivTag2Con tycon) = (mkFunBindSE 0 loc rdr_name [([nlConVarPat intDataCon_RDR [a_RDR]], nlHsApp (nlHsVar tagToEnum_RDR) a_Expr)], - L loc (TypeSig noExt [L loc rdr_name] sig_ty)) + L loc (TypeSig noExtField [L loc rdr_name] sig_ty)) where sig_ty = mkLHsSigWcType $ L loc $ XHsType $ NHsCoreTy $ mkSpecForAllTys (tyConTyVars tycon) $ @@ -1952,7 +1952,7 @@ genAuxBindSpec dflags loc (DerivTag2Con tycon) genAuxBindSpec dflags loc (DerivMaxTag tycon) = (mkHsVarBind loc rdr_name rhs, - L loc (TypeSig noExt [L loc rdr_name] sig_ty)) + L loc (TypeSig noExtField [L loc rdr_name] sig_ty)) where rdr_name = maxtag_RDR dflags tycon sig_ty = mkLHsSigWcType (L loc (XHsType (NHsCoreTy intTy))) diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index 52783e7210..7dbd4d9fee 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -135,15 +135,15 @@ hsLitType (HsInteger _ _ ty) = ty hsLitType (HsRat _ _ ty) = ty hsLitType (HsFloatPrim _ _) = floatPrimTy hsLitType (HsDoublePrim _ _) = doublePrimTy -hsLitType (XLit p) = pprPanic "hsLitType" (ppr p) +hsLitType (XLit nec) = noExtCon nec -- Overloaded literals. Here mainly because it uses isIntTy etc shortCutLit :: DynFlags -> OverLitVal -> TcType -> Maybe (HsExpr GhcTcId) shortCutLit dflags (HsIntegral int@(IL src neg i)) ty - | isIntTy ty && inIntRange dflags i = Just (HsLit noExt (HsInt noExt int)) + | isIntTy ty && inIntRange dflags i = Just (HsLit noExtField (HsInt noExtField int)) | isWordTy ty && inWordRange dflags i = Just (mkLit wordDataCon (HsWordPrim src i)) - | isIntegerTy ty = Just (HsLit noExt (HsInteger src i ty)) + | isIntegerTy ty = Just (HsLit noExtField (HsInteger src i ty)) | otherwise = shortCutLit dflags (HsFractional (integralFractionalLit neg i)) ty -- The 'otherwise' case is important -- Consider (3 :: Float). Syntactically it looks like an IntLit, @@ -152,16 +152,16 @@ shortCutLit dflags (HsIntegral int@(IL src neg i)) ty -- literals, compiled without -O shortCutLit _ (HsFractional f) ty - | isFloatTy ty = Just (mkLit floatDataCon (HsFloatPrim noExt f)) - | isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim noExt f)) + | isFloatTy ty = Just (mkLit floatDataCon (HsFloatPrim noExtField f)) + | isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim noExtField f)) | otherwise = Nothing shortCutLit _ (HsIsString src s) ty - | isStringTy ty = Just (HsLit noExt (HsString src s)) + | isStringTy ty = Just (HsLit noExtField (HsString src s)) | otherwise = Nothing mkLit :: DataCon -> HsLit GhcTc -> HsExpr GhcTc -mkLit con lit = HsApp noExt (nlHsDataCon con) (nlHsLit lit) +mkLit con lit = HsApp noExtField (nlHsDataCon con) (nlHsLit lit) ------------------------------ hsOverLitName :: OverLitVal -> Name @@ -389,7 +389,7 @@ zonkTopBndrs ids = initZonkEnv $ \ ze -> zonkIdBndrs ze ids zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTcId -> TcM (FieldOcc GhcTc) zonkFieldOcc env (FieldOcc sel lbl) = fmap ((flip FieldOcc) lbl) $ zonkIdBndr env sel -zonkFieldOcc _ (XFieldOcc _) = panic "zonkFieldOcc" +zonkFieldOcc _ (XFieldOcc nec) = noExtCon nec zonkEvBndrsX :: ZonkEnv -> [EvVar] -> TcM (ZonkEnv, [Var]) zonkEvBndrsX = mapAccumLM zonkEvBndrX @@ -532,12 +532,12 @@ zonkLocalBinds env (HsIPBinds x (IPBinds dict_binds binds )) = do = do n' <- mapIPNameTc (zonkIdBndr env) n e' <- zonkLExpr env e return (IPBind x n' e') - zonk_ip_bind (XIPBind _) = panic "zonkLocalBinds : XCIPBind" + zonk_ip_bind (XIPBind nec) = noExtCon nec -zonkLocalBinds _ (HsIPBinds _ (XHsIPBinds _)) - = panic "zonkLocalBinds" -- Not in typechecker output -zonkLocalBinds _ (XHsLocalBindsLR _) - = panic "zonkLocalBinds" -- Not in typechecker output +zonkLocalBinds _ (HsIPBinds _ (XHsIPBinds nec)) + = noExtCon nec +zonkLocalBinds _ (XHsLocalBindsLR nec) + = noExtCon nec --------------------------------------------- zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTcId -> TcM (ZonkEnv, LHsBinds GhcTc) @@ -597,7 +597,7 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs ; new_val_binds <- mapBagM (zonk_val_bind env3) val_binds ; new_exports <- mapM (zonk_export env3) exports ; return (new_val_binds, new_exports) } - ; return (AbsBinds { abs_ext = noExt + ; return (AbsBinds { abs_ext = noExtField , abs_tvs = new_tyvars, abs_ev_vars = new_evs , abs_ev_binds = new_ev_binds , abs_exports = new_exports, abs_binds = new_val_bind @@ -633,7 +633,7 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs , abe_poly = new_poly_id , abe_mono = zonkIdOcc env mono_id , abe_prags = new_prags }) - zonk_export _ (XABExport _) = panic "zonk_bind: XABExport" + zonk_export _ (XABExport nec) = noExtCon nec zonk_bind env (PatSynBind x bind@(PSB { psb_id = (dL->L loc id) , psb_args = details @@ -649,8 +649,8 @@ zonk_bind env (PatSynBind x bind@(PSB { psb_id = (dL->L loc id) , psb_def = lpat' , psb_dir = dir' } } -zonk_bind _ (PatSynBind _ (XPatSynBind _)) = panic "zonk_bind" -zonk_bind _ (XHsBindsLR _) = panic "zonk_bind" +zonk_bind _ (PatSynBind _ (XPatSynBind nec)) = noExtCon nec +zonk_bind _ (XHsBindsLR nec) = noExtCon nec zonkPatSynDetails :: ZonkEnv -> HsPatSynDetails (Located TcId) @@ -704,7 +704,7 @@ zonkMatchGroup env zBody (MG { mg_alts = (dL->L l ms) ; return (MG { mg_alts = cL l ms' , mg_ext = MatchGroupTc arg_tys' res_ty' , mg_origin = origin }) } -zonkMatchGroup _ _ (XMatchGroup {}) = panic "zonkMatchGroup" +zonkMatchGroup _ _ (XMatchGroup nec) = noExtCon nec zonkMatch :: ZonkEnv -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc))) @@ -715,7 +715,7 @@ zonkMatch env zBody (dL->L loc match@(Match { m_pats = pats = do { (env1, new_pats) <- zonkPats env pats ; new_grhss <- zonkGRHSs env1 zBody grhss ; return (cL loc (match { m_pats = new_pats, m_grhss = new_grhss })) } -zonkMatch _ _ (dL->L _ (XMatch _)) = panic "zonkMatch" +zonkMatch _ _ (dL->L _ (XMatch nec)) = noExtCon nec zonkMatch _ _ _ = panic "zonkMatch: Impossible Match" -- due to #15884 @@ -732,10 +732,10 @@ zonkGRHSs env zBody (GRHSs x grhss (dL->L l binds)) = do = do (env2, new_guarded) <- zonkStmts new_env zonkLExpr guarded new_rhs <- zBody env2 rhs return (GRHS xx new_guarded new_rhs) - zonk_grhs (XGRHS _) = panic "zonkGRHSs" + zonk_grhs (XGRHS nec) = noExtCon nec new_grhss <- mapM (wrapLocM zonk_grhs) grhss return (GRHSs x new_grhss (cL l new_binds)) -zonkGRHSs _ _ (XGRHSs _) = panic "zonkGRHSs" +zonkGRHSs _ _ (XGRHSs nec) = noExtCon nec {- ************************************************************************ @@ -841,7 +841,7 @@ zonkExpr env (ExplicitTuple x tup_args boxed) ; return (cL l (Present x e')) } zonk_tup_arg (dL->L l (Missing t)) = do { t' <- zonkTcTypeToTypeX env t ; return (cL l (Missing t')) } - zonk_tup_arg (dL->L _ (XTupArg{})) = panic "zonkExpr.XTupArg" + zonk_tup_arg (dL->L _ (XTupArg nec)) = noExtCon nec zonk_tup_arg _ = panic "zonk_tup_arg: Impossible Match" -- due to #15884 @@ -877,7 +877,7 @@ zonkExpr env (HsMultiIf ty alts) = do { (env', guard') <- zonkStmts env zonkLExpr guard ; expr' <- zonkLExpr env' expr ; return $ GRHS x guard' expr' } - zonk_alt (XGRHS _) = panic "zonkExpr.HsMultiIf" + zonk_alt (XGRHS nec) = noExtCon nec zonkExpr env (HsLet x (dL->L l binds) expr) = do (new_env, new_binds) <- zonkLocalBinds env binds @@ -921,7 +921,7 @@ zonkExpr env (RecordUpd { rupd_flds = rbinds zonkExpr env (ExprWithTySig _ e ty) = do { e' <- zonkLExpr env e - ; return (ExprWithTySig noExt e' ty) } + ; return (ExprWithTySig noExtField e' ty) } zonkExpr env (ArithSeq expr wit info) = do (env1, new_wit) <- zonkWit env wit @@ -1057,7 +1057,7 @@ zonkCmd env (HsCmdDo ty (dL->L l stmts)) new_ty <- zonkTcTypeToTypeX env ty return (HsCmdDo new_ty (cL l new_stmts)) -zonkCmd _ (XCmd{}) = panic "zonkCmd" +zonkCmd _ (XCmd nec) = noExtCon nec @@ -1077,7 +1077,7 @@ zonk_cmd_top env (HsCmdTop (CmdTopTc stack_tys ty ids) cmd) -- rules for arrows return (HsCmdTop (CmdTopTc new_stack_tys new_ty new_ids) new_cmd) -zonk_cmd_top _ (XCmdTop {}) = panic "zonk_cmd_top" +zonk_cmd_top _ (XCmdTop nec) = noExtCon nec ------------------------------------------------------------------------- zonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper) @@ -1110,7 +1110,7 @@ zonkOverLit env lit@(OverLit {ol_ext = OverLitTc r ty, ol_witness = e }) ; e' <- zonkExpr env e ; return (lit { ol_witness = e', ol_ext = OverLitTc r ty' }) } -zonkOverLit _ XOverLit{} = panic "zonkOverLit" +zonkOverLit _ (XOverLit nec) = noExtCon nec ------------------------------------------------------------------------- zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTcId -> TcM (ArithSeqInfo GhcTc) @@ -1166,7 +1166,7 @@ zonkStmt env _ (ParStmt bind_ty stmts_w_bndrs mzip_op bind_op) ; (env3, new_return) <- zonkSyntaxExpr env2 return_op ; return (ParStmtBlock x new_stmts (zonkIdOccs env3 bndrs) new_return) } - zonk_branch _ (XParStmtBlock{}) = panic "zonkStmt" + zonk_branch _ (XParStmtBlock nec) = noExtCon nec zonkStmt env zBody (RecStmt { recS_stmts = segStmts, recS_later_ids = lvs, recS_rec_ids = rvs , recS_ret_fn = ret_id, recS_mfix_fn = mfix_id @@ -1264,13 +1264,13 @@ zonkStmt env _zBody (ApplicativeStmt body_ty args mb_join) get_pat (_, ApplicativeArgOne _ pat _ _) = pat get_pat (_, ApplicativeArgMany _ _ _ pat) = pat - get_pat (_, XApplicativeArg _) = panic "zonkStmt" + get_pat (_, XApplicativeArg nec) = noExtCon nec replace_pat pat (op, ApplicativeArgOne x _ a isBody) = (op, ApplicativeArgOne x pat a isBody) replace_pat pat (op, ApplicativeArgMany x a b _) = (op, ApplicativeArgMany x a b pat) - replace_pat _ (_, XApplicativeArg _) = panic "zonkStmt" + replace_pat _ (_, XApplicativeArg nec) = noExtCon nec zonk_args env args = do { (env1, new_args_rev) <- zonk_args_rev env (reverse args) @@ -1294,9 +1294,9 @@ zonkStmt env _zBody (ApplicativeStmt body_ty args mb_join) = do { (env1, new_stmts) <- zonkStmts env zonkLExpr stmts ; new_ret <- zonkExpr env1 ret ; return (ApplicativeArgMany x new_stmts new_ret pat) } - zonk_arg _ (XApplicativeArg _) = panic "zonkStmt.XApplicativeArg" + zonk_arg _ (XApplicativeArg nec) = noExtCon nec -zonkStmt _ _ (XStmtLR _) = panic "zonkStmt" +zonkStmt _ _ (XStmtLR nec) = noExtCon nec ------------------------------------------------------------------------- zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTcId -> TcM (HsRecordBinds GhcTcId) @@ -1540,7 +1540,7 @@ zonkRule env rule@(HsRule { rd_tmvs = tm_bndrs{-::[RuleBndr TcId]-} = do { (env', v') <- zonk_it env v ; return (env', cL l (RuleBndr x (cL loc v'))) } zonk_tm_bndr _ (dL->L _ (RuleBndrSig {})) = panic "zonk_tm_bndr RuleBndrSig" - zonk_tm_bndr _ (dL->L _ (XRuleBndr {})) = panic "zonk_tm_bndr XRuleBndr" + zonk_tm_bndr _ (dL->L _ (XRuleBndr nec)) = noExtCon nec zonk_tm_bndr _ _ = panic "zonk_tm_bndr: Impossible Match" -- due to #15884 @@ -1552,7 +1552,7 @@ zonkRule env rule@(HsRule { rd_tmvs = tm_bndrs{-::[RuleBndr TcId]-} -- DV: used to be return (env,v) but that is plain -- wrong because we may need to go inside the kind -- of v and zonk there! -zonkRule _ (XRuleDecl _) = panic "zonkRule" +zonkRule _ (XRuleDecl nec) = noExtCon nec {- ************************************************************************ diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index a7e3cf7945..c81956d8a7 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -271,7 +271,7 @@ tc_hs_sig_type skol_info hs_sig_type ctxt_kind ; return (insolubleWC wanted, mkInvForAllTys kvs ty1) } -tc_hs_sig_type _ (XHsImplicitBndrs _) _ = panic "tc_hs_sig_type" +tc_hs_sig_type _ (XHsImplicitBndrs nec) _ = noExtCon nec tcTopLHsType :: LHsSigType GhcRn -> ContextKind -> TcM Type -- tcTopLHsType is used for kind-checking top-level HsType where @@ -296,7 +296,7 @@ tcTopLHsType hs_sig_type ctxt_kind ; traceTc "End tcTopLHsType }" (vcat [ppr hs_ty, ppr final_ty]) ; return final_ty} -tcTopLHsType (XHsImplicitBndrs _) _ = panic "tcTopLHsType" +tcTopLHsType (XHsImplicitBndrs nec) _ = noExtCon nec ----------------- tcHsDeriv :: LHsSigType GhcRn -> TcM ([TyVar], (Class, [Type], [Kind])) @@ -398,7 +398,7 @@ tcHsTypeApp wc_ty kind ; ty <- zonkPromoteType ty ; checkValidType TypeAppCtxt ty ; return ty } -tcHsTypeApp (XHsWildCardBndrs _) _ = panic "tcHsTypeApp" +tcHsTypeApp (XHsWildCardBndrs nec) _ = noExtCon nec {- Note [Wildcards in visible type application] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -841,12 +841,12 @@ tc_fun_type mode ty1 ty2 exp_kind = case mode_level mode of ; res_k <- newOpenTypeKind ; ty1' <- tc_lhs_type mode ty1 arg_k ; ty2' <- tc_lhs_type mode ty2 res_k - ; checkExpectedKind (HsFunTy noExt ty1 ty2) (mkVisFunTy ty1' ty2') + ; checkExpectedKind (HsFunTy noExtField ty1 ty2) (mkVisFunTy ty1' ty2') liftedTypeKind exp_kind } KindLevel -> -- no representation polymorphism in kinds. yet. do { ty1' <- tc_lhs_type mode ty1 liftedTypeKind ; ty2' <- tc_lhs_type mode ty2 liftedTypeKind - ; checkExpectedKind (HsFunTy noExt ty1 ty2) (mkVisFunTy ty1' ty2') + ; checkExpectedKind (HsFunTy noExtField ty1 ty2) (mkVisFunTy ty1' ty2') liftedTypeKind exp_kind } --------------------------- @@ -980,7 +980,7 @@ splitHsAppTys hs_ty go (L _ (HsAppKindTy l ty k)) as = go ty (HsTypeArg l k : as) go (L sp (HsParTy _ f)) as = go f (HsArgPar sp : as) go (L _ (HsOpTy _ l op@(L sp _) r)) as - = ( L sp (HsTyVar noExt NotPromoted op) + = ( L sp (HsTyVar noExtField NotPromoted op) , HsValArg l : HsValArg r : as ) go f as = (f, as) @@ -1870,7 +1870,7 @@ kcLHsQTyVars_Cusk name flav ctxt_kind | tcFlavourIsOpen flav = TheKind liftedTypeKind | otherwise = AnyKind -kcLHsQTyVars_Cusk _ _ (XLHsQTyVars _) _ = panic "kcLHsQTyVars" +kcLHsQTyVars_Cusk _ _ (XLHsQTyVars nec) _ = noExtCon nec ------------------------------ kcLHsQTyVars_NonCusk name flav @@ -1918,7 +1918,7 @@ kcLHsQTyVars_NonCusk name flav ctxt_kind | tcFlavourIsOpen flav = TheKind liftedTypeKind | otherwise = AnyKind -kcLHsQTyVars_NonCusk _ _ (XLHsQTyVars _) _ = panic "kcLHsQTyVars" +kcLHsQTyVars_NonCusk _ _ (XLHsQTyVars nec) _ = noExtCon nec {- Note [No polymorphic recursion] @@ -2161,7 +2161,7 @@ tcHsTyVarBndr new_tv (UserTyVar _ (L _ tv_nm)) tcHsTyVarBndr new_tv (KindedTyVar _ (L _ tv_nm) lhs_kind) = do { kind <- tcLHsKindSig (TyVarBndrKindCtxt tv_nm) lhs_kind ; new_tv tv_nm kind } -tcHsTyVarBndr _ (XTyVarBndr _) = panic "tcHsTyVarBndr" +tcHsTyVarBndr _ (XTyVarBndr nec) = noExtCon nec ----------------- tcHsQTyVarBndr :: ContextKind @@ -2191,10 +2191,10 @@ tcHsQTyVarBndr _ new_tv (KindedTyVar _ (L _ tv_nm) lhs_kind) _ -> new_tv tv_nm kind } where - hs_tv = HsTyVar noExt NotPromoted (noLoc tv_nm) + hs_tv = HsTyVar noExtField NotPromoted (noLoc tv_nm) -- Used for error messages only -tcHsQTyVarBndr _ _ (XTyVarBndr _) = panic "tcHsTyVarBndr" +tcHsQTyVarBndr _ _ (XTyVarBndr nec) = noExtCon nec -------------------------------------- @@ -2630,8 +2630,8 @@ tcHsPartialSigType ctxt sig_ty ; traceTc "tcHsPartialSigType" (ppr tv_prs) ; return (wcs, wcx, tv_prs, theta, tau) } -tcHsPartialSigType _ (HsWC _ (XHsImplicitBndrs _)) = panic "tcHsPartialSigType" -tcHsPartialSigType _ (XHsWildCardBndrs _) = panic "tcHsPartialSigType" +tcHsPartialSigType _ (HsWC _ (XHsImplicitBndrs nec)) = noExtCon nec +tcHsPartialSigType _ (XHsWildCardBndrs nec) = noExtCon nec tcPartialContext :: HsContext GhcRn -> TcM (TcThetaType, Maybe TcType) tcPartialContext hs_theta @@ -2770,8 +2770,8 @@ tcHsPatSigType ctxt sig_ty -- NB: tv's Name may be fresh (in the case of newPatSigTyVar) ; return (name, tv) } -tcHsPatSigType _ (HsWC _ (XHsImplicitBndrs _)) = panic "tcHsPatSigType" -tcHsPatSigType _ (XHsWildCardBndrs _) = panic "tcHsPatSigType" +tcHsPatSigType _ (HsWC _ (XHsImplicitBndrs nec)) = noExtCon nec +tcHsPatSigType _ (XHsWildCardBndrs nec) = noExtCon nec tcPatSig :: Bool -- True <=> pattern binding -> LHsSigWcType GhcRn diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index 716acb6942..6d63054e64 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -458,7 +458,7 @@ tcLocalInstDecl (L loc (ClsInstD { cid_inst = decl })) = do { (insts, fam_insts, deriv_infos) <- tcClsInstDecl (L loc decl) ; return (insts, fam_insts, deriv_infos) } -tcLocalInstDecl (L _ (XInstDecl _)) = panic "tcLocalInstDecl" +tcLocalInstDecl (L _ (XInstDecl nec)) = noExtCon nec tcClsInstDecl :: LClsInstDecl GhcRn -> TcM ([InstInfo GhcRn], [FamInst], [DerivInfo]) @@ -535,7 +535,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty, cid_binds = binds . dfid_eqn . unLoc) adts) -tcClsInstDecl (L _ (XClsInstDecl _)) = panic "tcClsInstDecl" +tcClsInstDecl (L _ (XClsInstDecl nec)) = noExtCon nec {- ************************************************************************ @@ -1091,14 +1091,14 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds }) -- con_app_scs = MkD ty1 ty2 sc1 sc2 -- con_app_args = MkD ty1 ty2 sc1 sc2 op1 op2 con_app_tys = mkHsWrap (mkWpTyApps inst_tys) - (HsConLikeOut noExt (RealDataCon dict_constr)) + (HsConLikeOut noExtField (RealDataCon dict_constr)) -- NB: We *can* have covars in inst_tys, in the case of -- promoted GADT constructors. con_app_args = foldl' app_to_meth con_app_tys sc_meth_ids app_to_meth :: HsExpr GhcTc -> Id -> HsExpr GhcTc - app_to_meth fun meth_id = HsApp noExt (L loc fun) + app_to_meth fun meth_id = HsApp noExtField (L loc fun) (L loc (wrapId arg_wrapper meth_id)) inst_tv_tys = mkTyVarTys inst_tyvars @@ -1112,13 +1112,13 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds }) -- Newtype dfuns just inline unconditionally, -- so don't attempt to specialise them - export = ABE { abe_ext = noExt + export = ABE { abe_ext = noExtField , abe_wrap = idHsWrapper , abe_poly = dfun_id_w_prags , abe_mono = self_dict , abe_prags = dfun_spec_prags } -- NB: see Note [SPECIALISE instance pragmas] - main_bind = AbsBinds { abs_ext = noExt + main_bind = AbsBinds { abs_ext = noExtField , abs_tvs = inst_tyvars , abs_ev_vars = dfun_ev_vars , abs_exports = [export] @@ -1165,7 +1165,7 @@ addDFunPrags dfun_id sc_meth_ids is_newtype = isNewTyCon clas_tc wrapId :: HsWrapper -> IdP (GhcPass id) -> HsExpr (GhcPass id) -wrapId wrapper id = mkHsWrap wrapper (HsVar noExt (noLoc id)) +wrapId wrapper id = mkHsWrap wrapper (HsVar noExtField (noLoc id)) {- Note [Typechecking plan for instance declarations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1264,13 +1264,13 @@ tcSuperClasses dfun_id cls tyvars dfun_evs inst_tys dfun_ev_binds sc_theta ; let sc_top_ty = mkInvForAllTys tyvars $ mkPhiTy (map idType dfun_evs) sc_pred sc_top_id = mkLocalId sc_top_name sc_top_ty - export = ABE { abe_ext = noExt + export = ABE { abe_ext = noExtField , abe_wrap = idHsWrapper , abe_poly = sc_top_id , abe_mono = sc_ev_id , abe_prags = noSpecPrags } local_ev_binds = TcEvBinds ev_binds_var - bind = AbsBinds { abs_ext = noExt + bind = AbsBinds { abs_ext = noExtField , abs_tvs = tyvars , abs_ev_vars = dfun_evs , abs_exports = [export] @@ -1563,12 +1563,12 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys mkLHsWrap lam_wrapper (error_rhs dflags) ; return (meth_id, meth_bind, Nothing) } where - error_rhs dflags = L inst_loc $ HsApp noExt error_fun (error_msg dflags) + error_rhs dflags = L inst_loc $ HsApp noExtField error_fun (error_msg dflags) error_fun = L inst_loc $ wrapId (mkWpTyApps [ getRuntimeRep meth_tau, meth_tau]) nO_METHOD_BINDING_ERROR_ID - error_msg dflags = L inst_loc (HsLit noExt (HsStringPrim NoSourceText + error_msg dflags = L inst_loc (HsLit noExtField (HsStringPrim NoSourceText (unsafeMkByteString (error_string dflags)))) meth_tau = funResultTy (piResultTys (idType sel_id) inst_tys) error_string dflags = showSDoc dflags @@ -1696,14 +1696,14 @@ tcMethodBody clas tyvars dfun_ev_vars inst_tys ; spec_prags <- tcSpecPrags global_meth_id prags ; let specs = mk_meth_spec_prags global_meth_id spec_inst_prags spec_prags - export = ABE { abe_ext = noExt + export = ABE { abe_ext = noExtField , abe_poly = global_meth_id , abe_mono = local_meth_id , abe_wrap = idHsWrapper , abe_prags = specs } local_ev_binds = TcEvBinds ev_binds_var - full_bind = AbsBinds { abs_ext = noExt + full_bind = AbsBinds { abs_ext = noExtField , abs_tvs = tyvars , abs_ev_vars = dfun_ev_vars , abs_exports = [export] @@ -1746,14 +1746,14 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind ; (tc_bind, [inner_id]) <- tcPolyCheck no_prag_fn inner_meth_sig meth_bind - ; let export = ABE { abe_ext = noExt + ; let export = ABE { abe_ext = noExtField , abe_poly = local_meth_id , abe_mono = inner_id , abe_wrap = hs_wrap , abe_prags = noSpecPrags } ; return (unitBag $ L (getLoc meth_bind) $ - AbsBinds { abs_ext = noExt, abs_tvs = [], abs_ev_vars = [] + AbsBinds { abs_ext = noExtField, abs_tvs = [], abs_ev_vars = [] , abs_exports = [export] , abs_binds = tc_bind, abs_ev_binds = [] , abs_sig = True }) } @@ -1899,7 +1899,7 @@ mkDefMethBind clas inst_tys sel_id dm_name ; dm_id <- tcLookupId dm_name ; let inline_prag = idInlinePragma dm_id inline_prags | isAnyInlinePragma inline_prag - = [noLoc (InlineSig noExt fn inline_prag)] + = [noLoc (InlineSig noExtField fn inline_prag)] | otherwise = [] -- Copy the inline pragma (if any) from the default method @@ -1919,7 +1919,7 @@ mkDefMethBind clas inst_tys sel_id dm_name ; return (bind, inline_prags) } where mk_vta :: LHsExpr GhcRn -> Type -> LHsExpr GhcRn - mk_vta fun ty = noLoc (HsAppType noExt fun (mkEmptyWildCardBndrs $ nlHsParTy + mk_vta fun ty = noLoc (HsAppType noExtField fun (mkEmptyWildCardBndrs $ nlHsParTy $ noLoc $ XHsType $ NHsCoreTy ty)) -- NB: use visible type application -- See Note [Default methods in instances] diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index 93e47ac1d9..b2233b4964 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -219,7 +219,7 @@ tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches ; return (MG { mg_alts = L l matches' , mg_ext = MatchGroupTc pat_tys rhs_ty , mg_origin = origin }) } -tcMatches _ _ _ (XMatchGroup {}) = panic "tcMatches" +tcMatches _ _ _ (XMatchGroup nec) = noExtCon nec ------------- tcMatch :: (Outputable (body GhcRn)) => TcMatchCtxt body @@ -236,10 +236,10 @@ tcMatch ctxt pat_tys rhs_ty match = add_match_ctxt match $ do { (pats', grhss') <- tcPats (mc_what ctxt) pats pat_tys $ tcGRHSs ctxt grhss rhs_ty - ; return (Match { m_ext = noExt + ; return (Match { m_ext = noExtField , m_ctxt = mc_what ctxt, m_pats = pats' , m_grhss = grhss' }) } - tc_match _ _ _ (XMatch _) = panic "tcMatch" + tc_match _ _ _ (XMatch nec) = noExtCon nec -- For (\x -> e), tcExpr has already said "In the expression \x->e" -- so we don't want to add "In the lambda abstraction \x->e" @@ -263,8 +263,8 @@ tcGRHSs ctxt (GRHSs _ grhss (L l binds)) res_ty <- tcLocalBinds binds $ mapM (wrapLocM (tcGRHS ctxt res_ty)) grhss - ; return (GRHSs noExt grhss' (L l binds')) } -tcGRHSs _ (XGRHSs _) _ = panic "tcGRHSs" + ; return (GRHSs noExtField grhss' (L l binds')) } +tcGRHSs _ (XGRHSs nec) _ = noExtCon nec ------------- tcGRHS :: TcMatchCtxt body -> ExpRhoType -> GRHS GhcRn (Located (body GhcRn)) @@ -274,10 +274,10 @@ tcGRHS ctxt res_ty (GRHS _ guards rhs) = do { (guards', rhs') <- tcStmtsAndThen stmt_ctxt tcGuardStmt guards res_ty $ mc_body ctxt rhs - ; return (GRHS noExt guards' rhs') } + ; return (GRHS noExtField guards' rhs') } where stmt_ctxt = PatGuard (mc_what ctxt) -tcGRHS _ _ (XGRHS _) = panic "tcGRHS" +tcGRHS _ _ (XGRHS nec) = noExtCon nec {- ************************************************************************ @@ -467,7 +467,7 @@ tcLcStmt m_tc ctxt (ParStmt _ bndr_stmts_s _ _) elt_ty thing_inside ; (pairs', thing) <- loop pairs ; return (ids, pairs', thing) } ; return ( ParStmtBlock x stmts' ids noSyntaxExpr : pairs', thing ) } - loop (XParStmtBlock{}:_) = panic "tcLcStmt" + loop (XParStmtBlock nec:_) = noExtCon nec tcLcStmt m_tc ctxt (TransStmt { trS_form = form, trS_stmts = stmts , trS_bndrs = bindersMap @@ -1034,12 +1034,12 @@ tcApplicativeStmts ctxt pairs rhs_ty thing_inside } ; return (ApplicativeArgMany x stmts' ret' pat') } - goArg (XApplicativeArg _, _, _) = panic "tcApplicativeStmts" + goArg (XApplicativeArg nec, _, _) = noExtCon nec get_arg_bndrs :: ApplicativeArg GhcTcId -> [Id] get_arg_bndrs (ApplicativeArgOne _ pat _ _) = collectPatBinders pat get_arg_bndrs (ApplicativeArgMany _ _ _ pat) = collectPatBinders pat - get_arg_bndrs (XApplicativeArg _) = panic "tcApplicativeStmts" + get_arg_bndrs (XApplicativeArg nec) = noExtCon nec {- Note [ApplicativeDo and constraints] @@ -1096,5 +1096,5 @@ checkArgs fun (MG { mg_alts = L _ (match1:matches) }) args_in_match :: LMatch GhcRn body -> Int args_in_match (L _ (Match { m_pats = pats })) = length pats - args_in_match (L _ (XMatch _)) = panic "checkArgs" -checkArgs _ (XMatchGroup{}) = panic "checkArgs" + args_in_match (L _ (XMatch nec)) = noExtCon nec +checkArgs _ (XMatchGroup nec) = noExtCon nec diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index 38ca85969a..fae16723fa 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -466,7 +466,7 @@ tc_pat penv (TuplePat _ pats boxity) pat_ty thing_inside -- pat_ty /= pat_ty iff coi /= IdCo possibly_mangled_result | gopt Opt_IrrefutableTuples dflags && - isBoxed boxity = LazyPat noExt (noLoc unmangled_result) + isBoxed boxity = LazyPat noExtField (noLoc unmangled_result) | otherwise = unmangled_result ; pat_ty <- readExpType pat_ty diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 5dcee99bfd..49f15e2849 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -102,7 +102,7 @@ recoverPSB (PSB { psb_id = (dL->L _ name) matcher_id = mkLocalId matcher_name $ mkSpecForAllTys [alphaTyVar] alphaTy -recoverPSB (XPatSynBind {}) = panic "recoverPSB" +recoverPSB (XPatSynBind nec) = noExtCon nec {- Note [Pattern synonym error recovery] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -187,7 +187,7 @@ tcInferPatSynDecl (PSB { psb_id = lname@(dL->L _ name), psb_args = details , mkTyVarTys ex_tvs, prov_theta, prov_evs) (map nlHsVar args, map idType args) pat_ty rec_fields } } -tcInferPatSynDecl (XPatSynBind _) = panic "tcInferPatSynDecl" +tcInferPatSynDecl (XPatSynBind nec) = noExtCon nec mkProvEvidence :: EvId -> Maybe (PredType, EvTerm) -- See Note [Equality evidence in pattern synonyms] @@ -434,7 +434,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(dL->L _ name), psb_args = details -- Why do we need tcSubType here? -- See Note [Pattern synonyms and higher rank types] ; return (mkLHsWrap wrap $ nlHsVar arg_id) } -tcCheckPatSynDecl (XPatSynBind _) _ = panic "tcCheckPatSynDecl" +tcCheckPatSynDecl (XPatSynBind nec) _ = noExtCon nec {- [Pattern synonyms and higher rank types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -726,13 +726,13 @@ tcPatSynMatcher (dL->L loc name) lpat mkHsCaseAlt lwpat fail'] body = mkLHsWrap (mkWpLet req_ev_binds) $ cL (getLoc lpat) $ - HsCase noExt (nlHsVar scrutinee) $ + HsCase noExtField (nlHsVar scrutinee) $ MG{ mg_alts = cL (getLoc lpat) cases , mg_ext = MatchGroupTc [pat_ty] res_ty , mg_origin = Generated } body' = noLoc $ - HsLam noExt $ + HsLam noExtField $ MG{ mg_alts = noLoc [mkSimpleMatch LambdaExpr args body] , mg_ext = MatchGroupTc [pat_ty, cont_ty, fail_ty] res_ty @@ -741,7 +741,7 @@ tcPatSynMatcher (dL->L loc name) lpat match = mkMatch (mkPrefixFunRhs (cL loc name)) [] (mkHsLams (rr_tv:res_tv:univ_tvs) req_dicts body') - (noLoc (EmptyLocalBinds noExt)) + (noLoc (EmptyLocalBinds noExtField)) mg :: MatchGroup GhcTc (LHsExpr GhcTc) mg = MG{ mg_alts = cL (getLoc match) [match] , mg_ext = MatchGroupTc [] res_ty @@ -863,11 +863,11 @@ tcPatSynBuilderBind (PSB { psb_id = (dL->L loc name) mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn) mk_mg body = mkMatchGroup Generated [builder_match] where - builder_args = [cL loc (VarPat noExt (cL loc n)) + builder_args = [cL loc (VarPat noExtField (cL loc n)) | (dL->L loc n) <- args] builder_match = mkMatch (mkPrefixFunRhs (cL loc name)) builder_args body - (noLoc (EmptyLocalBinds noExt)) + (noLoc (EmptyLocalBinds noExtField)) args = case details of PrefixCon args -> args @@ -882,13 +882,13 @@ tcPatSynBuilderBind (PSB { psb_id = (dL->L loc name) = mg { mg_alts = cL l [cL loc (match { m_pats = nlWildPatName : pats })] } add_dummy_arg other_mg = pprPanic "add_dummy_arg" $ pprMatches other_mg -tcPatSynBuilderBind (XPatSynBind _) = panic "tcPatSynBuilderBind" +tcPatSynBuilderBind (XPatSynBind nec) = noExtCon nec tcPatSynBuilderOcc :: PatSyn -> TcM (HsExpr GhcTcId, TcSigmaType) -- monadic only for failure tcPatSynBuilderOcc ps | Just (builder_id, add_void_arg) <- builder - , let builder_expr = HsConLikeOut noExt (PatSynCon ps) + , let builder_expr = HsConLikeOut noExtField (PatSynCon ps) builder_ty = idType builder_id = return $ if add_void_arg @@ -927,14 +927,14 @@ tcPatToExpr name args pat = go pat -> Either MsgDoc (HsExpr GhcRn) mkPrefixConExpr lcon@(dL->L loc _) pats = do { exprs <- mapM go pats - ; return (foldl' (\x y -> HsApp noExt (cL loc x) y) - (HsVar noExt lcon) exprs) } + ; return (foldl' (\x y -> HsApp noExtField (cL loc x) y) + (HsVar noExtField lcon) exprs) } mkRecordConExpr :: Located Name -> HsRecFields GhcRn (LPat GhcRn) -> Either MsgDoc (HsExpr GhcRn) mkRecordConExpr con fields = do { exprFields <- mapM go fields - ; return (RecordCon noExt con exprFields) } + ; return (RecordCon noExtField con exprFields) } go :: LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn) go (dL->L loc p) = cL loc <$> go1 p @@ -951,27 +951,27 @@ tcPatToExpr name args pat = go pat go1 (VarPat _ (dL->L l var)) | var `elemNameSet` lhsVars - = return $ HsVar noExt (cL l var) + = return $ HsVar noExtField (cL l var) | otherwise = Left (quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym") - go1 (ParPat _ pat) = fmap (HsPar noExt) $ go pat + go1 (ParPat _ pat) = fmap (HsPar noExtField) $ go pat go1 p@(ListPat reb pats) | Nothing <- reb = do { exprs <- mapM go pats - ; return $ ExplicitList noExt Nothing exprs } + ; return $ ExplicitList noExtField Nothing exprs } | otherwise = notInvertibleListPat p go1 (TuplePat _ pats box) = do { exprs <- mapM go pats - ; return $ ExplicitTuple noExt - (map (noLoc . (Present noExt)) exprs) + ; return $ ExplicitTuple noExtField + (map (noLoc . (Present noExtField)) exprs) box } go1 (SumPat _ pat alt arity) = do { expr <- go1 (unLoc pat) - ; return $ ExplicitSum noExt alt arity + ; return $ ExplicitSum noExtField alt arity (noLoc expr) } - go1 (LitPat _ lit) = return $ HsLit noExt lit + go1 (LitPat _ lit) = return $ HsLit noExtField lit go1 (NPat _ (dL->L _ n) mb_neg _) | Just neg <- mb_neg = return $ unLoc $ nlHsSyntaxApps neg - [noLoc (HsOverLit noExt n)] - | otherwise = return $ HsOverLit noExt n + [noLoc (HsOverLit noExtField n)] + | otherwise = return $ HsOverLit noExtField n go1 (ConPatOut{}) = panic "ConPatOut in output of renamer" go1 (CoPat{}) = panic "CoPat in output of renamer" go1 (SplicePat _ (HsSpliced _ _ (HsSplicedPat pat))) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 96240e6092..ca4f98b98c 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -554,7 +554,7 @@ tc_rn_src_decls ds ("Declaration splices are not " ++ "permitted inside top-level " ++ "declarations added with addTopDecls")) - ; Just (XSpliceDecl _, _) -> panic "tc_rn_src_decls" + ; Just (XSpliceDecl nec, _) -> noExtCon nec } -- Rename TH-generated top-level declarations ; (tcg_env, th_rn_decls) <- setGblEnv tcg_env @@ -597,7 +597,7 @@ tc_rn_src_decls ds ; return (tcg_env, tcl_env, lie1 `andWC` lie2) } - ; Just (XSpliceDecl _, _) -> panic "tc_rn_src_decls" + ; Just (XSpliceDecl nec, _) -> noExtCon nec } } @@ -634,8 +634,8 @@ tcRnHsBootDecls hsc_src decls -- Check for illegal declarations ; case group_tail of Just (SpliceDecl _ d _, _) -> badBootDecl hsc_src "splice" d - Just (XSpliceDecl _, _) -> panic "tcRnHsBootDecls" - Nothing -> return () + Just (XSpliceDecl nec, _) -> noExtCon nec + Nothing -> return () ; mapM_ (badBootDecl hsc_src "foreign") for_decls ; mapM_ (badBootDecl hsc_src "default") def_decls ; mapM_ (badBootDecl hsc_src "rule") rule_decls @@ -1739,7 +1739,7 @@ check_main dflags tcg_env explicit_mod_hdr ; (ev_binds, main_expr) <- checkConstraints skol_info [] [] $ addErrCtxt mainCtxt $ - tcMonoExpr (cL loc (HsVar noExt (cL loc main_name))) + tcMonoExpr (cL loc (HsVar noExtField (cL loc main_name))) (mkCheckExpType io_ty) -- See Note [Root-main Id] @@ -2068,35 +2068,35 @@ tcUserStmt (dL->L loc (BodyStmt _ expr _ _)) -- (if we are at a breakpoint, say). We must put those free vars -- [let it = expr] - let_stmt = cL loc $ LetStmt noExt $ noLoc $ HsValBinds noExt + let_stmt = cL loc $ LetStmt noExtField $ noLoc $ HsValBinds noExtField $ XValBindsLR (NValBinds [(NonRecursive,unitBag the_bind)] []) -- [it <- e] - bind_stmt = cL loc $ BindStmt noExt - (cL loc (VarPat noExt (cL loc fresh_it))) + bind_stmt = cL loc $ BindStmt noExtField + (cL loc (VarPat noExtField (cL loc fresh_it))) (nlHsApp ghciStep rn_expr) (mkRnSyntaxExpr bindIOName) noSyntaxExpr -- [; print it] - print_it = cL loc $ BodyStmt noExt + print_it = cL loc $ BodyStmt noExtField (nlHsApp (nlHsVar interPrintName) (nlHsVar fresh_it)) (mkRnSyntaxExpr thenIOName) noSyntaxExpr -- NewA - no_it_a = cL loc $ BodyStmt noExt (nlHsApps bindIOName + no_it_a = cL loc $ BodyStmt noExtField (nlHsApps bindIOName [rn_expr , nlHsVar interPrintName]) (mkRnSyntaxExpr thenIOName) noSyntaxExpr - no_it_b = cL loc $ BodyStmt noExt (rn_expr) + no_it_b = cL loc $ BodyStmt noExtField (rn_expr) (mkRnSyntaxExpr thenIOName) noSyntaxExpr - no_it_c = cL loc $ BodyStmt noExt + no_it_c = cL loc $ BodyStmt noExtField (nlHsApp (nlHsVar interPrintName) rn_expr) (mkRnSyntaxExpr thenIOName) noSyntaxExpr @@ -2230,7 +2230,7 @@ tcUserStmt rdr_stmt@(dL->L loc _) ; when (isUnitTy v_ty || not (isTauTy v_ty)) failM ; return stuff } where - print_v = cL loc $ BodyStmt noExt (nlHsApp (nlHsVar printName) + print_v = cL loc $ BodyStmt noExtField (nlHsApp (nlHsVar printName) (nlHsVar v)) (mkRnSyntaxExpr thenIOName) noSyntaxExpr @@ -2317,14 +2317,14 @@ getGhciStepIO = do step_ty = noLoc $ HsForAllTy { hst_fvf = ForallInvis - , hst_bndrs = [noLoc $ UserTyVar noExt (noLoc a_tv)] - , hst_xforall = noExt + , hst_bndrs = [noLoc $ UserTyVar noExtField (noLoc a_tv)] + , hst_xforall = noExtField , hst_body = nlHsFunTy ghciM ioM } stepTy :: LHsSigWcType GhcRn stepTy = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs step_ty) - return (noLoc $ ExprWithTySig noExt (nlHsVar ghciStepIoMName) stepTy) + return (noLoc $ ExprWithTySig noExtField (nlHsVar ghciStepIoMName) stepTy) isGHCiMonad :: HscEnv -> String -> IO (Messages, Maybe Name) isGHCiMonad hsc_env ty diff --git a/compiler/typecheck/TcRnExports.hs b/compiler/typecheck/TcRnExports.hs index e4009e6040..4ac969ffcf 100644 --- a/compiler/typecheck/TcRnExports.hs +++ b/compiler/typecheck/TcRnExports.hs @@ -183,7 +183,7 @@ tcRnExports explicit_mod exports ; let real_exports | explicit_mod = exports | has_main - = Just (noLoc [noLoc (IEVar noExt + = Just (noLoc [noLoc (IEVar noExtField (noLoc (IEName $ noLoc default_main)))]) -- ToDo: the 'noLoc' here is unhelpful if 'main' -- turns out to be out of scope @@ -317,7 +317,7 @@ exports_from_avail (Just (dL->L _ rdr_items)) rdr_env imports this_mod , ppr new_exports ]) ; return (Just ( ExportAccum occs' mods - , ( cL loc (IEModuleContents noExt lmod) + , ( cL loc (IEModuleContents noExtField lmod) , new_exports))) } exports_from_item acc@(ExportAccum occs mods) (dL->L loc ie) @@ -340,18 +340,18 @@ exports_from_avail (Just (dL->L _ rdr_items)) rdr_env imports this_mod lookup_ie :: IE GhcPs -> RnM (IE GhcRn, AvailInfo) lookup_ie (IEVar _ (dL->L l rdr)) = do (name, avail) <- lookupGreAvailRn $ ieWrappedName rdr - return (IEVar noExt (cL l (replaceWrappedName rdr name)), avail) + return (IEVar noExtField (cL l (replaceWrappedName rdr name)), avail) lookup_ie (IEThingAbs _ (dL->L l rdr)) = do (name, avail) <- lookupGreAvailRn $ ieWrappedName rdr - return (IEThingAbs noExt (cL l (replaceWrappedName rdr name)) + return (IEThingAbs noExtField (cL l (replaceWrappedName rdr name)) , avail) lookup_ie ie@(IEThingAll _ n') = do (n, avail, flds) <- lookup_ie_all ie n' let name = unLoc n - return (IEThingAll noExt (replaceLWrappedName n' (unLoc n)) + return (IEThingAll noExtField (replaceLWrappedName n' (unLoc n)) , AvailTC name (name:avail) flds) @@ -364,7 +364,7 @@ exports_from_avail (Just (dL->L _ rdr_items)) rdr_env imports this_mod NoIEWildcard -> return (lname, [], []) IEWildcard _ -> lookup_ie_all ie l let name = unLoc lname - return (IEThingWith noExt (replaceLWrappedName l name) wc subs + return (IEThingWith noExtField (replaceLWrappedName l name) wc subs (flds ++ (map noLoc all_flds)), AvailTC name (name : avails ++ all_avail) (map unLoc flds ++ all_flds)) @@ -406,10 +406,10 @@ exports_from_avail (Just (dL->L _ rdr_items)) rdr_env imports this_mod ------------- lookup_doc_ie :: IE GhcPs -> RnM (IE GhcRn) lookup_doc_ie (IEGroup _ lev doc) = do rn_doc <- rnHsDoc doc - return (IEGroup noExt lev rn_doc) + return (IEGroup noExtField lev rn_doc) lookup_doc_ie (IEDoc _ doc) = do rn_doc <- rnHsDoc doc - return (IEDoc noExt rn_doc) - lookup_doc_ie (IEDocNamed _ str) = return (IEDocNamed noExt str) + return (IEDoc noExtField rn_doc) + lookup_doc_ie (IEDocNamed _ str) = return (IEDocNamed noExtField str) lookup_doc_ie _ = panic "lookup_doc_ie" -- Other cases covered earlier -- In an export item M.T(A,B,C), we want to treat the uses of diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 8882bbc6c7..7e28359c36 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -3734,7 +3734,7 @@ exprCtOrigin (HsTick _ _ e) = lexprCtOrigin e exprCtOrigin (HsBinTick _ _ _ e) = lexprCtOrigin e exprCtOrigin (HsTickPragma _ _ _ _ e) = lexprCtOrigin e exprCtOrigin (HsWrap {}) = panic "exprCtOrigin HsWrap" -exprCtOrigin (XExpr {}) = panic "exprCtOrigin XExpr" +exprCtOrigin (XExpr nec) = noExtCon nec -- | Extract a suitable CtOrigin from a MatchGroup matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin @@ -3745,17 +3745,17 @@ matchesCtOrigin (MG { mg_alts = alts }) | otherwise = Shouldn'tHappenOrigin "multi-way match" -matchesCtOrigin (XMatchGroup{}) = panic "matchesCtOrigin" +matchesCtOrigin (XMatchGroup nec) = noExtCon nec -- | Extract a suitable CtOrigin from guarded RHSs grhssCtOrigin :: GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin grhssCtOrigin (GRHSs { grhssGRHSs = lgrhss }) = lGRHSCtOrigin lgrhss -grhssCtOrigin (XGRHSs _) = panic "grhssCtOrigin" +grhssCtOrigin (XGRHSs nec) = noExtCon nec -- | Extract a suitable CtOrigin from a list of guarded RHSs lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin lGRHSCtOrigin [L _ (GRHS _ _ (L _ e))] = exprCtOrigin e -lGRHSCtOrigin [L _ (XGRHS _)] = panic "lGRHSCtOrigin" +lGRHSCtOrigin [L _ (XGRHS nec)] = noExtCon nec lGRHSCtOrigin _ = Shouldn'tHappenOrigin "multi-way GRHS" pprCtLoc :: CtLoc -> SDoc diff --git a/compiler/typecheck/TcRules.hs b/compiler/typecheck/TcRules.hs index f1d549568a..b60bbd2e5a 100644 --- a/compiler/typecheck/TcRules.hs +++ b/compiler/typecheck/TcRules.hs @@ -66,10 +66,10 @@ tcRuleDecls :: RuleDecls GhcRn -> TcM (RuleDecls GhcTcId) tcRuleDecls (HsRules { rds_src = src , rds_rules = decls }) = do { tc_decls <- mapM (wrapLocM tcRule) decls - ; return $ HsRules { rds_ext = noExt + ; return $ HsRules { rds_ext = noExtField , rds_src = src , rds_rules = tc_decls } } -tcRuleDecls (XRuleDecls _) = panic "tcRuleDecls" +tcRuleDecls (XRuleDecls nec) = noExtCon nec tcRule :: RuleDecl GhcRn -> TcM (RuleDecl GhcTcId) tcRule (HsRule { rd_ext = ext @@ -141,10 +141,11 @@ tcRule (HsRule { rd_ext = ext , rd_name = rname , rd_act = act , rd_tyvs = ty_bndrs -- preserved for ppr-ing - , rd_tmvs = map (noLoc . RuleBndr noExt . noLoc) (all_qtkvs ++ tpl_ids) + , rd_tmvs = map (noLoc . RuleBndr noExtField . noLoc) + (all_qtkvs ++ tpl_ids) , rd_lhs = mkHsDictLet lhs_binds lhs' , rd_rhs = mkHsDictLet rhs_binds rhs' } } -tcRule (XRuleDecl _) = panic "tcRule" +tcRule (XRuleDecl nec) = noExtCon nec generateRuleConstraints :: Maybe [LHsTyVarBndr GhcRn] -> [LRuleBndr GhcRn] -> LHsExpr GhcRn -> LHsExpr GhcRn @@ -203,7 +204,7 @@ tcRuleTmBndrs (L _ (RuleBndrSig _ (L _ name) rn_ty) : rule_bndrs) ; (tyvars, tmvars) <- tcExtendNameTyVarEnv tvs $ tcRuleTmBndrs rule_bndrs ; return (map snd tvs ++ tyvars, id : tmvars) } -tcRuleTmBndrs (L _ (XRuleBndr _) : _) = panic "tcRuleTmBndrs" +tcRuleTmBndrs (L _ (XRuleBndr nec) : _) = noExtCon nec ruleCtxt :: FastString -> SDoc ruleCtxt name = text "When checking the transformation rule" <+> diff --git a/compiler/typecheck/TcSigs.hs b/compiler/typecheck/TcSigs.hs index da18065b93..a8a3e0dd47 100644 --- a/compiler/typecheck/TcSigs.hs +++ b/compiler/typecheck/TcSigs.hs @@ -258,8 +258,8 @@ isCompleteHsSig :: LHsSigWcType GhcRn -> Bool isCompleteHsSig (HsWC { hswc_ext = wcs , hswc_body = HsIB { hsib_body = hs_ty } }) = null wcs && no_anon_wc hs_ty -isCompleteHsSig (HsWC _ (XHsImplicitBndrs _)) = panic "isCompleteHsSig" -isCompleteHsSig (XHsWildCardBndrs _) = panic "isCompleteHsSig" +isCompleteHsSig (HsWC _ (XHsImplicitBndrs nec)) = noExtCon nec +isCompleteHsSig (XHsWildCardBndrs nec) = noExtCon nec no_anon_wc :: LHsType GhcRn -> Bool no_anon_wc lty = go lty @@ -300,7 +300,7 @@ no_anon_wc_bndrs ltvs = all (go . unLoc) ltvs where go (UserTyVar _ _) = True go (KindedTyVar _ _ ki) = no_anon_wc ki - go (XTyVarBndr{}) = panic "no_anon_wc_bndrs" + go (XTyVarBndr nec) = noExtCon nec {- Note [Fail eagerly on bad signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -465,7 +465,7 @@ tcPatSynSig name sig_ty mkSpecForAllTys ex $ mkPhiTy prov $ body -tcPatSynSig _ (XHsImplicitBndrs _) = panic "tcPatSynSig" +tcPatSynSig _ (XHsImplicitBndrs nec) = noExtCon nec ppr_tvs :: [TyVar] -> SDoc ppr_tvs tvs = braces (vcat [ ppr tv <+> dcolon <+> ppr (tyVarKind tv) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 3434b68615..bcdc503e56 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -185,7 +185,7 @@ tcTypedBracket rn_expr brack@(TExpBr _ expr) res_ty ; tcWrapResultO (Shouldn'tHappenOrigin "TExpBr") rn_expr (unLoc (mkHsApp (nlHsTyApp texpco [rep, expr_ty]) - (noLoc (HsTcBracketOut noExt brack ps')))) + (noLoc (HsTcBracketOut noExtField brack ps')))) meta_ty res_ty } tcTypedBracket _ other_brack _ = pprPanic "tcTypedBracket" (ppr other_brack) @@ -197,7 +197,7 @@ tcUntypedBracket rn_expr brack ps res_ty ; meta_ty <- tcBrackTy brack ; traceTc "tc_bracket done untyped" (ppr meta_ty) ; tcWrapResultO (Shouldn'tHappenOrigin "untyped bracket") - rn_expr (HsTcBracketOut noExt brack ps') meta_ty res_ty } + rn_expr (HsTcBracketOut noExtField brack ps') meta_ty res_ty } --------------- tcBrackTy :: HsBracket GhcRn -> TcM TcType @@ -207,9 +207,9 @@ tcBrackTy (ExpBr {}) = tcMetaTy expQTyConName -- Result type is ExpQ (= Q Exp) tcBrackTy (TypBr {}) = tcMetaTy typeQTyConName -- Result type is Type (= Q Typ) tcBrackTy (DecBrG {}) = tcMetaTy decsQTyConName -- Result type is Q [Dec] tcBrackTy (PatBr {}) = tcMetaTy patQTyConName -- Result type is PatQ (= Q Pat) -tcBrackTy (DecBrL {}) = panic "tcBrackTy: Unexpected DecBrL" -tcBrackTy (TExpBr {}) = panic "tcUntypedBracket: Unexpected TExpBr" -tcBrackTy (XBracket {}) = panic "tcUntypedBracket: Unexpected XBracket" +tcBrackTy (DecBrL {}) = panic "tcBrackTy: Unexpected DecBrL" +tcBrackTy (TExpBr {}) = panic "tcUntypedBracket: Unexpected TExpBr" +tcBrackTy (XBracket nec) = noExtCon nec --------------- tcPendingSplice :: PendingRnSplice -> TcM PendingTcSplice @@ -498,7 +498,7 @@ tcTopSplice expr res_ty ; lcl_env <- getLclEnv ; let delayed_splice = DelayedSplice lcl_env expr res_ty q_expr - ; return (HsSpliceE noExt (HsSplicedT delayed_splice)) + ; return (HsSpliceE noExtField (HsSplicedT delayed_splice)) } @@ -610,8 +610,8 @@ runAnnotation target expr = do ; wrapper <- instCall AnnOrigin [expr_ty] [mkClassPred data_class [expr_ty]] ; let specialised_to_annotation_wrapper_expr = L loc (mkHsWrap wrapper - (HsVar noExt (L loc to_annotation_wrapper_id))) - ; return (L loc (HsApp noExt + (HsVar noExtField (L loc to_annotation_wrapper_id))) + ; return (L loc (HsApp noExtField specialised_to_annotation_wrapper_expr expr')) }) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 67fc558af1..395c123290 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -194,7 +194,7 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds ; return (gbl_env', inst_info, deriv_info) } -tcTyClGroup (XTyClGroup _) = panic "tcTyClGroup" +tcTyClGroup (XTyClGroup nec) = noExtCon nec tcTyClDecls :: [LTyClDecl GhcRn] @@ -1079,8 +1079,8 @@ getInitialKind cusk (SynDecl { tcdLName = dL->L _ name HsKindSig _ _ k -> Just k _ -> Nothing -getInitialKind _ (DataDecl _ _ _ _ (XHsDataDefn _)) = panic "getInitialKind" -getInitialKind _ (XTyClDecl _) = panic "getInitialKind" +getInitialKind _ (DataDecl _ _ _ _ (XHsDataDefn nec)) = noExtCon nec +getInitialKind _ (XTyClDecl nec) = noExtCon nec --------------------------------- getFamDeclInitialKinds @@ -1121,7 +1121,7 @@ getFamDeclInitialKind parent_cusk mb_parent_tycon ClosedTypeFamily _ -> ASSERT( isNothing mb_parent_tycon ) ClosedTypeFamilyFlavour ctxt = TyFamResKindCtxt name -getFamDeclInitialKind _ _ (XFamilyDecl _) = panic "getFamDeclInitialKind" +getFamDeclInitialKind _ _ (XFamilyDecl nec) = noExtCon nec ------------------------------------------------------------------------ kcLTyClDecl :: LTyClDecl GhcRn -> TcM () @@ -1193,9 +1193,9 @@ kcTyClDecl (FamDecl _ (FamilyDecl { fdLName = (dL->L _ fam_tc_name) do { fam_tc <- kcLookupTcTyCon fam_tc_name ; mapM_ (kcTyFamInstEqn fam_tc) eqns } _ -> return () -kcTyClDecl (FamDecl _ (XFamilyDecl _)) = panic "kcTyClDecl" -kcTyClDecl (DataDecl _ _ _ _ (XHsDataDefn _)) = panic "kcTyClDecl" -kcTyClDecl (XTyClDecl _) = panic "kcTyClDecl" +kcTyClDecl (FamDecl _ (XFamilyDecl nec)) = noExtCon nec +kcTyClDecl (DataDecl _ _ _ _ (XHsDataDefn nec)) = noExtCon nec +kcTyClDecl (XTyClDecl nec) = noExtCon nec ------------------- @@ -1276,8 +1276,8 @@ kcConDecl new_or_data res_kind (ConDeclGADT ; kcConArgTys new_or_data res_kind (hsConDeclArgTys args) ; _ <- tcHsOpenType res_ty ; return () } -kcConDecl _ _ (ConDeclGADT _ _ _ (XLHsQTyVars _) _ _ _ _) = panic "kcConDecl" -kcConDecl _ _ (XConDecl _) = panic "kcConDecl" +kcConDecl _ _ (ConDeclGADT _ _ _ (XLHsQTyVars nec) _ _ _ _) = noExtCon nec +kcConDecl _ _ (XConDecl nec) = noExtCon nec {- Note [Recursion and promoting data constructors] @@ -1594,7 +1594,7 @@ tcTyClDecl1 _parent roles_info meths fundeps sigs ats at_defs ; return (noDerivInfos (classTyCon clas)) } -tcTyClDecl1 _ _ (XTyClDecl _) = panic "tcTyClDecl1" +tcTyClDecl1 _ _ (XTyClDecl nec) = noExtCon nec {- ********************************************************************* @@ -1972,7 +1972,7 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info ; return fam_tc } } | otherwise = panic "tcFamInst1" -- Silence pattern-exhaustiveness checker -tcFamDecl1 _ (XFamilyDecl _) = panic "tcFamDecl1" +tcFamDecl1 _ (XFamilyDecl nec) = noExtCon nec -- | Maybe return a list of Bools that say whether a type family was declared -- injective in the corresponding type arguments. Length of the list is equal to @@ -2115,7 +2115,7 @@ tcDataDefn err_ctxt DataType -> return (mkDataTyConRhs data_cons) NewType -> ASSERT( not (null data_cons) ) mkNewTyConRhs tc_name tycon (head data_cons) -tcDataDefn _ _ _ _ _ (XHsDataDefn _) = panic "tcDataDefn" +tcDataDefn _ _ _ _ _ (XHsDataDefn nec) = noExtCon nec ------------------------- @@ -2153,8 +2153,8 @@ kcTyFamInstEqn tc_fam_tc where vis_arity = length (tyConVisibleTyVars tc_fam_tc) -kcTyFamInstEqn _ (dL->L _ (XHsImplicitBndrs _)) = panic "kcTyFamInstEqn" -kcTyFamInstEqn _ (dL->L _ (HsIB _ (XFamEqn _))) = panic "kcTyFamInstEqn" +kcTyFamInstEqn _ (dL->L _ (XHsImplicitBndrs nec)) = noExtCon nec +kcTyFamInstEqn _ (dL->L _ (HsIB _ (XFamEqn nec))) = noExtCon nec kcTyFamInstEqn _ _ = panic "kcTyFamInstEqn: Impossible Match" -- due to #15884 @@ -2320,7 +2320,7 @@ tcFamTyPats fam_tc hs_pats where fam_name = tyConName fam_tc fam_arity = tyConArity fam_tc - lhs_fun = noLoc (HsTyVar noExt NotPromoted (noLoc fam_name)) + lhs_fun = noLoc (HsTyVar noExtField NotPromoted (noLoc fam_name)) unravelFamInstPats :: TcType -> [TcType] -- Decompose fam_app to get the argument patterns @@ -2684,9 +2684,9 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; traceTc "tcConDecl 2" (ppr names) ; mapM buildOneDataCon names } -tcConDecl _ _ _ _ _ _ (ConDeclGADT _ _ _ (XLHsQTyVars _) _ _ _ _) - = panic "tcConDecl" -tcConDecl _ _ _ _ _ _ (XConDecl _) = panic "tcConDecl" +tcConDecl _ _ _ _ _ _ (ConDeclGADT _ _ _ (XLHsQTyVars nec) _ _ _ _) + = noExtCon nec +tcConDecl _ _ _ _ _ _ (XConDecl nec) = noExtCon nec tcConIsInfixH98 :: Name -> HsConDetails (LHsType GhcRn) (Located [LConDeclField GhcRn]) @@ -4006,8 +4006,8 @@ tcMkDataFamInstCtxt decl@(DataFamInstDecl { dfid_eqn = HsIB { hsib_body = eqn }}) = tcMkFamInstCtxt (pprDataFamInstFlavour decl <+> text "instance") (unLoc (feqn_tycon eqn)) -tcMkDataFamInstCtxt (DataFamInstDecl (XHsImplicitBndrs _)) - = panic "tcMkDataFamInstCtxt" +tcMkDataFamInstCtxt (DataFamInstDecl (XHsImplicitBndrs nec)) + = noExtCon nec tcAddDataFamInstCtxt :: DataFamInstDecl GhcRn -> TcM a -> TcM a tcAddDataFamInstCtxt decl @@ -4199,7 +4199,7 @@ wrongNumberOfRoles tyvars d@(dL->L _ (RoleAnnotDecl _ _ annots)) text "Expected" <+> (ppr $ length tyvars) <> comma <+> text "got" <+> (ppr $ length annots) <> colon) 2 (ppr d) -wrongNumberOfRoles _ (dL->L _ (XRoleAnnotDecl _)) = panic "wrongNumberOfRoles" +wrongNumberOfRoles _ (dL->L _ (XRoleAnnotDecl nec)) = noExtCon nec wrongNumberOfRoles _ _ = panic "wrongNumberOfRoles: Impossible Match" -- due to #15884 @@ -4210,7 +4210,7 @@ illegalRoleAnnotDecl (dL->L loc (RoleAnnotDecl _ tycon _)) setSrcSpan loc $ addErrTc (text "Illegal role annotation for" <+> ppr tycon <> char ';' $$ text "they are allowed only for datatypes and classes.") -illegalRoleAnnotDecl (dL->L _ (XRoleAnnotDecl _)) = panic "illegalRoleAnnotDecl" +illegalRoleAnnotDecl (dL->L _ (XRoleAnnotDecl nec)) = noExtCon nec illegalRoleAnnotDecl _ = panic "illegalRoleAnnotDecl: Impossible Match" -- due to #15884 diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs index 7a68fe1144..94658c2413 100644 --- a/compiler/typecheck/TcTyDecls.hs +++ b/compiler/typecheck/TcTyDecls.hs @@ -832,8 +832,8 @@ tcRecSelBinds sel_bind_prs tcValBinds TopLevel binds sigs getGblEnv ; return (tcg_env `addTypecheckedBinds` map snd rec_sel_binds) } where - sigs = [ cL loc (IdSig noExt sel_id) | (sel_id, _) <- sel_bind_prs - , let loc = getSrcSpan sel_id ] + sigs = [ cL loc (IdSig noExtField sel_id) | (sel_id, _) <- sel_bind_prs + , let loc = getSrcSpan sel_id ] binds = [(NonRecursive, unitBag bind) | (_, bind) <- sel_bind_prs] mkRecSelBinds :: [TyCon] -> [(Id, LHsBind GhcRn)] @@ -892,7 +892,7 @@ mkOneRecordSelector all_cons idDetails fl | otherwise = map mk_match cons_w_field ++ deflt mk_match con = mkSimpleMatch (mkPrefixFunRhs sel_lname) [cL loc (mk_sel_pat con)] - (cL loc (HsVar noExt (cL loc field_var))) + (cL loc (HsVar noExtField (cL loc field_var))) mk_sel_pat con = ConPatIn (cL loc (getName con)) (RecCon rec_fields) rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing } rec_field = noLoc (HsRecField @@ -900,7 +900,7 @@ mkOneRecordSelector all_cons idDetails fl = cL loc (FieldOcc sel_name (cL loc $ mkVarUnqual lbl)) , hsRecFieldArg - = cL loc (VarPat noExt (cL loc field_var)) + = cL loc (VarPat noExtField (cL loc field_var)) , hsRecPun = False }) sel_lname = cL loc sel_name field_var = mkInternalName (mkBuiltinUnique 1) (getOccName sel_name) loc @@ -910,10 +910,10 @@ mkOneRecordSelector all_cons idDetails fl -- mentions this particular record selector deflt | all dealt_with all_cons = [] | otherwise = [mkSimpleMatch CaseAlt - [cL loc (WildPat noExt)] - (mkHsApp (cL loc (HsVar noExt + [cL loc (WildPat noExtField)] + (mkHsApp (cL loc (HsVar noExtField (cL loc (getName rEC_SEL_ERROR_ID)))) - (cL loc (HsLit noExt msg_lit)))] + (cL loc (HsLit noExtField msg_lit)))] -- Do not add a default case unless there are unmatched -- constructors. We must take account of GADTs, else we diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 31c6db055d..f5cae41578 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -1252,7 +1252,7 @@ runStmt input step = do mk_stmt :: SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs mk_stmt loc bind = let l = L loc - in l (LetStmt noExt (l (HsValBinds noExt (ValBinds noExt (unitBag (l bind)) [])))) + in l (LetStmt noExtField (l (HsValBinds noExtField (ValBinds noExtField (unitBag (l bind)) [])))) -- | Clean up the GHCi environment after a statement has run afterRunStmt :: GhciMonad m @@ -1662,7 +1662,7 @@ defineMacro overwrite s = do body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) `mkHsApp` (nlHsPar expr) tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) - new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig + new_expr = L (getLoc expr) $ ExprWithTySig noExtField body tySig hv <- GHC.compileParsedExprRemote new_expr let newCmd = Command { cmdName = macro_name @@ -1730,7 +1730,7 @@ getGhciStepIO = do ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy body = nlHsVar (getRdrName ghciStepIoMName) tySig = mkLHsSigWcType (ghciM `nlHsFunTy` ioM) - return $ noLoc $ ExprWithTySig noExt body tySig + return $ noLoc $ ExprWithTySig noExtField body tySig ----------------------------------------------------------------------------- -- :check diff --git a/testsuite/tests/ghc-api/annotations/parseTree.hs b/testsuite/tests/ghc-api/annotations/parseTree.hs index b04be775c3..badf59150f 100644 --- a/testsuite/tests/ghc-api/annotations/parseTree.hs +++ b/testsuite/tests/ghc-api/annotations/parseTree.hs @@ -52,9 +52,9 @@ testOneFile libdir fileName = do doLHsTupArg :: LHsTupArg GhcPs -> [(SrcSpan,String,HsExpr GhcPs)] doLHsTupArg (L l arg@(Present {})) - = [(l,"p",ExplicitTuple noExt [L l arg] Boxed)] + = [(l,"p",ExplicitTuple noExtField [L l arg] Boxed)] doLHsTupArg (L l arg@(Missing {})) - = [(l,"m",ExplicitTuple noExt [L l arg] Boxed)] + = [(l,"m",ExplicitTuple noExtField [L l arg] Boxed)] showAnns anns = "[\n" ++ (intercalate "\n" diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr index d290e61da1..d7996df404 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr @@ -9,7 +9,7 @@ (Nothing) [({ DumpParsedAst.hs:5:1-16 } (ImportDecl - (NoExt) + (NoExtField) (NoSourceText) ({ DumpParsedAst.hs:5:8-16 } {ModuleName: Data.Kind}) @@ -22,18 +22,18 @@ (Nothing)))] [({ DumpParsedAst.hs:7:1-30 } (TyClD - (NoExt) + (NoExtField) (DataDecl - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:7:6-10 } (Unqual {OccName: Peano})) (HsQTvs - (NoExt) + (NoExtField) []) (Prefix) (HsDataDefn - (NoExt) + (NoExtField) (DataType) ({ <no location info> } []) @@ -41,7 +41,7 @@ (Nothing) [({ DumpParsedAst.hs:7:14-17 } (ConDeclH98 - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:7:14-17 } (Unqual {OccName: Zero})) @@ -54,7 +54,7 @@ (Nothing))) ,({ DumpParsedAst.hs:7:21-30 } (ConDeclH98 - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:7:21-24 } (Unqual {OccName: Succ})) @@ -65,7 +65,7 @@ (PrefixCon [({ DumpParsedAst.hs:7:26-30 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:7:26-30 } (Unqual @@ -75,18 +75,18 @@ []))))) ,({ DumpParsedAst.hs:9:1-39 } (TyClD - (NoExt) + (NoExtField) (FamDecl - (NoExt) + (NoExtField) (FamilyDecl - (NoExt) + (NoExtField) (ClosedTypeFamily (Just [({ DumpParsedAst.hs:10:3-36 } (HsIB - (NoExt) + (NoExtField) (FamEqn - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:10:3-8 } (Unqual {OccName: Length})) @@ -94,13 +94,13 @@ [(HsValArg ({ DumpParsedAst.hs:10:10-17 } (HsParTy - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:10:11-16 } (HsOpTy - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:10:11 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:10:11 } (Unqual @@ -110,7 +110,7 @@ {Name: :})) ({ DumpParsedAst.hs:10:15-16 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:10:15-16 } (Unqual @@ -118,39 +118,39 @@ (Prefix) ({ DumpParsedAst.hs:10:21-36 } (HsAppTy - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:10:21-24 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:10:21-24 } (Unqual {OccName: Succ})))) ({ DumpParsedAst.hs:10:26-36 } (HsParTy - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:10:27-35 } (HsAppTy - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:10:27-32 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:10:27-32 } (Unqual {OccName: Length})))) ({ DumpParsedAst.hs:10:34-35 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:10:34-35 } (Unqual {OccName: as}))))))))))))) ,({ DumpParsedAst.hs:11:3-24 } (HsIB - (NoExt) + (NoExtField) (FamEqn - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:11:3-8 } (Unqual {OccName: Length})) @@ -158,13 +158,13 @@ [(HsValArg ({ DumpParsedAst.hs:11:10-12 } (HsExplicitListTy - (NoExt) + (NoExtField) (IsPromoted) [])))] (Prefix) ({ DumpParsedAst.hs:11:21-24 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:11:21-24 } (Unqual @@ -173,19 +173,19 @@ (Unqual {OccName: Length})) (HsQTvs - (NoExt) + (NoExtField) [({ DumpParsedAst.hs:9:21-29 } (KindedTyVar - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:9:21-22 } (Unqual {OccName: as})) ({ DumpParsedAst.hs:9:27-29 } (HsListTy - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:9:28 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:9:28 } (Unqual @@ -193,10 +193,10 @@ (Prefix) ({ DumpParsedAst.hs:9:32-39 } (KindSig - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:9:35-39 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:9:35-39 } (Unqual @@ -204,36 +204,36 @@ (Nothing))))) ,({ DumpParsedAst.hs:14:1-29 } (TyClD - (NoExt) + (NoExtField) (DataDecl - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:14:6 } (Unqual {OccName: T})) (HsQTvs - (NoExt) + (NoExtField) [({ DumpParsedAst.hs:14:8 } (UserTyVar - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:14:8 } (Unqual {OccName: f})))) ,({ DumpParsedAst.hs:14:11-16 } (KindedTyVar - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:14:11 } (Unqual {OccName: a})) ({ DumpParsedAst.hs:14:16 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:14:16 } (Unqual {OccName: k}))))))]) (Prefix) (HsDataDefn - (NoExt) + (NoExtField) (DataType) ({ <no location info> } []) @@ -241,7 +241,7 @@ (Nothing) [({ DumpParsedAst.hs:14:21-29 } (ConDeclH98 - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:14:21-23 } (Unqual {OccName: MkT})) @@ -252,20 +252,20 @@ (PrefixCon [({ DumpParsedAst.hs:14:25-29 } (HsParTy - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:14:26-28 } (HsAppTy - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:14:26 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:14:26 } (Unqual {OccName: f})))) ({ DumpParsedAst.hs:14:28 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:14:28 } (Unqual @@ -275,18 +275,18 @@ []))))) ,({ DumpParsedAst.hs:16:1-48 } (TyClD - (NoExt) + (NoExtField) (FamDecl - (NoExt) + (NoExtField) (FamilyDecl - (NoExt) + (NoExtField) (ClosedTypeFamily (Just [({ DumpParsedAst.hs:17:3-30 } (HsIB - (NoExt) + (NoExtField) (FamEqn - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:17:3-4 } (Unqual {OccName: F1})) @@ -295,7 +295,7 @@ { DumpParsedAst.hs:17:6-11 } ({ DumpParsedAst.hs:17:7-11 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:17:7-11 } (Unqual @@ -303,7 +303,7 @@ ,(HsValArg ({ DumpParsedAst.hs:17:13 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:17:13 } (Unqual @@ -311,7 +311,7 @@ ,(HsValArg ({ DumpParsedAst.hs:17:15 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:17:15 } (Unqual @@ -319,37 +319,37 @@ (Prefix) ({ DumpParsedAst.hs:17:19-30 } (HsAppTy - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:17:19-28 } (HsAppTy - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:17:19-26 } (HsAppKindTy { DumpParsedAst.hs:17:21-26 } ({ DumpParsedAst.hs:17:19 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:17:19 } (Unqual {OccName: T})))) ({ DumpParsedAst.hs:17:22-26 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:17:22-26 } (Unqual {OccName: Peano})))))) ({ DumpParsedAst.hs:17:28 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:17:28 } (Unqual {OccName: f})))))) ({ DumpParsedAst.hs:17:30 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:17:30 } (Unqual @@ -358,39 +358,39 @@ (Unqual {OccName: F1})) (HsQTvs - (NoExt) + (NoExtField) [({ DumpParsedAst.hs:16:17-22 } (KindedTyVar - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:16:17 } (Unqual {OccName: a})) ({ DumpParsedAst.hs:16:22 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:16:22 } (Unqual {OccName: k})))))) ,({ DumpParsedAst.hs:16:26-39 } (KindedTyVar - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:16:26 } (Unqual {OccName: f})) ({ DumpParsedAst.hs:16:31-39 } (HsFunTy - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:16:31 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:16:31 } (Unqual {OccName: k})))) ({ DumpParsedAst.hs:16:36-39 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:16:36-39 } (Unqual @@ -398,10 +398,10 @@ (Prefix) ({ DumpParsedAst.hs:16:42-48 } (KindSig - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:16:45-48 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpParsedAst.hs:16:45-48 } (Unqual @@ -409,18 +409,18 @@ (Nothing))))) ,({ DumpParsedAst.hs:19:1-23 } (ValD - (NoExt) + (NoExtField) (FunBind - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:19:1-4 } (Unqual {OccName: main})) (MG - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:19:1-23 } [({ DumpParsedAst.hs:19:1-23 } (Match - (NoExt) + (NoExtField) (FunRhs ({ DumpParsedAst.hs:19:1-4 } (Unqual @@ -429,32 +429,34 @@ (NoSrcStrict)) [] (GRHSs - (NoExt) + (NoExtField) [({ DumpParsedAst.hs:19:6-23 } (GRHS - (NoExt) + (NoExtField) [] ({ DumpParsedAst.hs:19:8-23 } (HsApp - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:19:8-15 } (HsVar - (NoExt) + (NoExtField) ({ DumpParsedAst.hs:19:8-15 } (Unqual {OccName: putStrLn})))) ({ DumpParsedAst.hs:19:17-23 } (HsLit - (NoExt) + (NoExtField) (HsString (SourceText "\"hello\"") {FastString: "hello"})))))))] ({ <no location info> } (EmptyLocalBinds - (NoExt))))))]) + (NoExtField))))))]) (FromSource)) (WpHole) [])))] (Nothing) (Nothing))) + + diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr index 48b880b16d..49ec1d111a 100644 --- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr @@ -4,7 +4,7 @@ (Just ((,,,) (HsGroup - (NoExt) + (NoExtField) (XValBindsLR (NValBinds [((,) @@ -17,11 +17,11 @@ ({ DumpRenamedAst.hs:26:1-4 } {Name: DumpRenamedAst.main}) (MG - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:26:1-23 } [({ DumpRenamedAst.hs:26:1-23 } (Match - (NoExt) + (NoExtField) (FunRhs ({ DumpRenamedAst.hs:26:1-4 } {Name: DumpRenamedAst.main}) @@ -29,36 +29,36 @@ (NoSrcStrict)) [] (GRHSs - (NoExt) + (NoExtField) [({ DumpRenamedAst.hs:26:6-23 } (GRHS - (NoExt) + (NoExtField) [] ({ DumpRenamedAst.hs:26:8-23 } (HsApp - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:26:8-15 } (HsVar - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:26:8-15 } {Name: System.IO.putStrLn}))) ({ DumpRenamedAst.hs:26:17-23 } (HsLit - (NoExt) + (NoExtField) (HsString (SourceText "\"hello\"") {FastString: "hello"})))))))] ({ <no location info> } (EmptyLocalBinds - (NoExt))))))]) + (NoExtField))))))]) (FromSource)) (WpHole) []))]})] [])) [] [(TyClGroup - (NoExt) + (NoExtField) [({ DumpRenamedAst.hs:9:1-30 } (DataDecl (DataDeclRn @@ -72,7 +72,7 @@ []) (Prefix) (HsDataDefn - (NoExt) + (NoExtField) (DataType) ({ <no location info> } []) @@ -80,7 +80,7 @@ (Nothing) [({ DumpRenamedAst.hs:9:14-17 } (ConDeclH98 - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:9:14-17 } {Name: DumpRenamedAst.Zero}) ({ <no location info> } @@ -92,7 +92,7 @@ (Nothing))) ,({ DumpRenamedAst.hs:9:21-30 } (ConDeclH98 - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:9:21-24 } {Name: DumpRenamedAst.Succ}) ({ <no location info> } @@ -102,7 +102,7 @@ (PrefixCon [({ DumpRenamedAst.hs:9:26-30 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:9:26-30 } {Name: DumpRenamedAst.Peano})))]) @@ -112,12 +112,12 @@ [] []) ,(TyClGroup - (NoExt) + (NoExtField) [({ DumpRenamedAst.hs:11:1-39 } (FamDecl - (NoExt) + (NoExtField) (FamilyDecl - (NoExt) + (NoExtField) (ClosedTypeFamily (Just [({ DumpRenamedAst.hs:12:3-36 } @@ -125,20 +125,20 @@ [{Name: a} ,{Name: as}] (FamEqn - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:12:3-8 } {Name: DumpRenamedAst.Length}) (Nothing) [(HsValArg ({ DumpRenamedAst.hs:12:10-17 } (HsParTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:12:11-16 } (HsOpTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:12:11 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:12:11 } {Name: a}))) @@ -146,35 +146,35 @@ {Name: :}) ({ DumpRenamedAst.hs:12:15-16 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:12:15-16 } {Name: as}))))))))] (Prefix) ({ DumpRenamedAst.hs:12:21-36 } (HsAppTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:12:21-24 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:12:21-24 } {Name: DumpRenamedAst.Succ}))) ({ DumpRenamedAst.hs:12:26-36 } (HsParTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:12:27-35 } (HsAppTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:12:27-32 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:12:27-32 } {Name: DumpRenamedAst.Length}))) ({ DumpRenamedAst.hs:12:34-35 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:12:34-35 } {Name: as})))))))))))) @@ -182,20 +182,20 @@ (HsIB [] (FamEqn - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:13:3-8 } {Name: DumpRenamedAst.Length}) (Nothing) [(HsValArg ({ DumpRenamedAst.hs:13:10-12 } (HsExplicitListTy - (NoExt) + (NoExtField) (IsPromoted) [])))] (Prefix) ({ DumpRenamedAst.hs:13:21-24 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:13:21-24 } {Name: DumpRenamedAst.Zero}))))))])) @@ -205,25 +205,25 @@ [{Name: k}] [({ DumpRenamedAst.hs:11:21-29 } (KindedTyVar - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:11:21-22 } {Name: as}) ({ DumpRenamedAst.hs:11:27-29 } (HsListTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:11:28 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:11:28 } {Name: k})))))))]) (Prefix) ({ DumpRenamedAst.hs:11:32-39 } (KindSig - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:11:35-39 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:11:35-39 } {Name: DumpRenamedAst.Peano}))))) @@ -231,12 +231,12 @@ [] []) ,(TyClGroup - (NoExt) + (NoExtField) [({ DumpRenamedAst.hs:15:1-33 } (FamDecl - (NoExt) + (NoExtField) (FamilyDecl - (NoExt) + (NoExtField) (DataFamily) ({ DumpRenamedAst.hs:15:13-15 } {Name: DumpRenamedAst.Nat}) @@ -246,28 +246,28 @@ (Prefix) ({ DumpRenamedAst.hs:15:17-33 } (KindSig - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:15:20-33 } (HsFunTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:15:20 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:15:20 } {Name: k}))) ({ DumpRenamedAst.hs:15:25-33 } (HsFunTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:15:25 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:15:25 } {Name: k}))) ({ DumpRenamedAst.hs:15:30-33 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:15:30-33 } {Name: GHC.Types.Type}))))))))) @@ -275,47 +275,47 @@ [] [({ DumpRenamedAst.hs:(18,1)-(19,45) } (DataFamInstD - (NoExt) + (NoExtField) (DataFamInstDecl (HsIB [{Name: a} ,{Name: k}] (FamEqn - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:18:18-20 } {Name: DumpRenamedAst.Nat}) (Nothing) [(HsValArg ({ DumpRenamedAst.hs:18:22-37 } (HsParTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:18:23-36 } (HsKindSig - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:18:23 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:18:23 } {Name: a}))) ({ DumpRenamedAst.hs:18:28-36 } (HsFunTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:18:28 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:18:28 } {Name: k}))) ({ DumpRenamedAst.hs:18:33-36 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:18:33-36 } {Name: GHC.Types.Type}))))))))))] (Prefix) (HsDataDefn - (NoExt) + (NoExtField) (NewType) ({ <no location info> } []) @@ -323,34 +323,34 @@ (Just ({ DumpRenamedAst.hs:18:42-60 } (HsFunTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:18:42-52 } (HsParTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:18:43-51 } (HsFunTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:18:43 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:18:43 } {Name: k}))) ({ DumpRenamedAst.hs:18:48-51 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:18:48-51 } {Name: GHC.Types.Type}))))))) ({ DumpRenamedAst.hs:18:57-60 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:18:57-60 } {Name: GHC.Types.Type})))))) [({ DumpRenamedAst.hs:19:3-45 } (ConDeclGADT - (NoExt) + (NoExtField) [({ DumpRenamedAst.hs:19:3-5 } {Name: DumpRenamedAst.Nat})] ({ DumpRenamedAst.hs:19:10-45 } @@ -363,70 +363,70 @@ (PrefixCon [({ DumpRenamedAst.hs:19:10-34 } (HsParTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:19:11-33 } (HsForAllTy - (NoExt) + (NoExtField) (ForallInvis) [({ DumpRenamedAst.hs:19:18-19 } (UserTyVar - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:19:18-19 } {Name: xx})))] ({ DumpRenamedAst.hs:19:22-33 } (HsFunTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:19:22-25 } (HsAppTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:19:22 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:19:22 } {Name: f}))) ({ DumpRenamedAst.hs:19:24-25 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:19:24-25 } {Name: xx}))))) ({ DumpRenamedAst.hs:19:30-33 } (HsAppTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:19:30 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:19:30 } {Name: g}))) ({ DumpRenamedAst.hs:19:32-33 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:19:32-33 } {Name: xx})))))))))))]) ({ DumpRenamedAst.hs:19:39-45 } (HsAppTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:19:39-43 } (HsAppTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:19:39-41 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:19:39-41 } {Name: DumpRenamedAst.Nat}))) ({ DumpRenamedAst.hs:19:43 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:19:43 } {Name: f}))))) ({ DumpRenamedAst.hs:19:45 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:19:45 } {Name: g}))))) @@ -434,7 +434,7 @@ ({ <no location info> } [])))))))]) ,(TyClGroup - (NoExt) + (NoExtField) [({ DumpRenamedAst.hs:21:1-29 } (DataDecl (DataDeclRn @@ -448,23 +448,23 @@ [{Name: k}] [({ DumpRenamedAst.hs:21:8 } (UserTyVar - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:21:8 } {Name: f}))) ,({ DumpRenamedAst.hs:21:11-16 } (KindedTyVar - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:21:11 } {Name: a}) ({ DumpRenamedAst.hs:21:16 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:21:16 } {Name: k})))))]) (Prefix) (HsDataDefn - (NoExt) + (NoExtField) (DataType) ({ <no location info> } []) @@ -472,7 +472,7 @@ (Nothing) [({ DumpRenamedAst.hs:21:21-29 } (ConDeclH98 - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:21:21-23 } {Name: DumpRenamedAst.MkT}) ({ <no location info> } @@ -482,19 +482,19 @@ (PrefixCon [({ DumpRenamedAst.hs:21:25-29 } (HsParTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:21:26-28 } (HsAppTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:21:26 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:21:26 } {Name: f}))) ({ DumpRenamedAst.hs:21:28 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:21:28 } {Name: a})))))))]) @@ -504,12 +504,12 @@ [] []) ,(TyClGroup - (NoExt) + (NoExtField) [({ DumpRenamedAst.hs:23:1-48 } (FamDecl - (NoExt) + (NoExtField) (FamilyDecl - (NoExt) + (NoExtField) (ClosedTypeFamily (Just [({ DumpRenamedAst.hs:24:3-30 } @@ -517,7 +517,7 @@ [{Name: a} ,{Name: f}] (FamEqn - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:24:3-4 } {Name: DumpRenamedAst.F1}) (Nothing) @@ -525,55 +525,55 @@ { DumpRenamedAst.hs:24:6-11 } ({ DumpRenamedAst.hs:24:7-11 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:24:7-11 } {Name: DumpRenamedAst.Peano})))) ,(HsValArg ({ DumpRenamedAst.hs:24:13 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:24:13 } {Name: a})))) ,(HsValArg ({ DumpRenamedAst.hs:24:15 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:24:15 } {Name: f}))))] (Prefix) ({ DumpRenamedAst.hs:24:19-30 } (HsAppTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:24:19-28 } (HsAppTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:24:19-26 } (HsAppKindTy { DumpRenamedAst.hs:24:21-26 } ({ DumpRenamedAst.hs:24:19 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:24:19 } {Name: DumpRenamedAst.T}))) ({ DumpRenamedAst.hs:24:22-26 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:24:22-26 } {Name: DumpRenamedAst.Peano}))))) ({ DumpRenamedAst.hs:24:28 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:24:28 } {Name: f}))))) ({ DumpRenamedAst.hs:24:30 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:24:30 } {Name: a}))))))))])) @@ -583,42 +583,42 @@ [{Name: k}] [({ DumpRenamedAst.hs:23:17-22 } (KindedTyVar - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:23:17 } {Name: a}) ({ DumpRenamedAst.hs:23:22 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:23:22 } {Name: k}))))) ,({ DumpRenamedAst.hs:23:26-39 } (KindedTyVar - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:23:26 } {Name: f}) ({ DumpRenamedAst.hs:23:31-39 } (HsFunTy - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:23:31 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:23:31 } {Name: k}))) ({ DumpRenamedAst.hs:23:36-39 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:23:36-39 } {Name: GHC.Types.Type})))))))]) (Prefix) ({ DumpRenamedAst.hs:23:42-48 } (KindSig - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:23:45-48 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ DumpRenamedAst.hs:23:45-48 } {Name: GHC.Types.Type}))))) @@ -635,7 +635,7 @@ []) [({ DumpRenamedAst.hs:4:8-21 } (ImportDecl - (NoExt) + (NoExtField) (NoSourceText) ({ DumpRenamedAst.hs:4:8-21 } {ModuleName: Prelude}) @@ -648,7 +648,7 @@ (Nothing))) ,({ DumpRenamedAst.hs:5:1-16 } (ImportDecl - (NoExt) + (NoExtField) (NoSourceText) ({ DumpRenamedAst.hs:5:8-16 } {ModuleName: Data.Kind}) @@ -661,7 +661,7 @@ (Nothing))) ,({ DumpRenamedAst.hs:7:1-23 } (ImportDecl - (NoExt) + (NoExtField) (NoSourceText) ({ DumpRenamedAst.hs:7:8-16 } {ModuleName: Data.Kind}) @@ -677,10 +677,12 @@ ({ DumpRenamedAst.hs:7:18-23 } [({ DumpRenamedAst.hs:7:19-22 } (IEThingAbs - (NoExt) + (NoExtField) ({ DumpRenamedAst.hs:7:19-22 } (IEName ({ DumpRenamedAst.hs:7:19-22 } {Name: GHC.Types.Type})))))])))))] (Nothing) (Nothing))) + + diff --git a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr index 7c6bfd72d0..6aa8aa4578 100644 --- a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr @@ -4,350 +4,350 @@ {Bag(Located (HsBind Var)): [({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: DumpTypecheckedAst.$tcT} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsWord{64}Prim (1374752024144278257) (NoSourceText)})))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsWord{64}Prim (13654949607623281177) (NoSourceText)})))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: DumpTypecheckedAst.$trModule}))))) ({ <no location info> } (HsPar - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) (HsStringPrim (NoSourceText) "T"))))))))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsInt{64}Prim (1) (SourceText "1")})))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: DumpTypecheckedAst.$tc'MkT} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsWord{64}Prim (10715337633704422415) (NoSourceText)})))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsWord{64}Prim (12411373583424111944) (NoSourceText)})))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: DumpTypecheckedAst.$trModule}))))) ({ <no location info> } (HsPar - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) (HsStringPrim (NoSourceText) "'MkT"))))))))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsInt{64}Prim (3) (SourceText "3")})))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: DumpTypecheckedAst.$tcPeano} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsWord{64}Prim (14073232900889011755) (NoSourceText)})))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsWord{64}Prim (2739668351064589274) (NoSourceText)})))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: DumpTypecheckedAst.$trModule}))))) ({ <no location info> } (HsPar - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) (HsStringPrim (NoSourceText) "Peano"))))))))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsInt{64}Prim (0) (SourceText "0")})))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: GHC.Types.krep$*}))))) (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: DumpTypecheckedAst.$tc'Zero} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsWord{64}Prim (13760111476013868540) (NoSourceText)})))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsWord{64}Prim (12314848029315386153) (NoSourceText)})))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: DumpTypecheckedAst.$trModule}))))) ({ <no location info> } (HsPar - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) (HsStringPrim (NoSourceText) "'Zero"))))))))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsInt{64}Prim (0) (SourceText "0")})))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: DumpTypecheckedAst.$tc'Succ} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsWord{64}Prim (1143980031331647856) (NoSourceText)})))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsWord{64}Prim (14802086722010293686) (NoSourceText)})))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: DumpTypecheckedAst.$trModule}))))) ({ <no location info> } (HsPar - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) (HsStringPrim (NoSourceText) "'Succ"))))))))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) {HsInt{64}Prim (0) (SourceText "0")})))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: $krep} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) (HsInt - (NoExt) + (NoExtField) (IL (SourceText "2") @@ -356,20 +356,20 @@ (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: $krep} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) (HsInt - (NoExt) + (NoExtField) (IL (SourceText "1") @@ -378,20 +378,20 @@ (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: $krep} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) (HsInt - (NoExt) + (NoExtField) (IL (SourceText "0") @@ -400,315 +400,315 @@ (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: $krep} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: $krep} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: GHC.Types.krep$*}))))) (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: $krep} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: $krep} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: $krep} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: $krep} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: DumpTypecheckedAst.$tcT}))))) ({ <no location info> } (HsPar - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsWrap - (NoExt) + (NoExtField) (WpTyApp (TyConApp ({abstract:TyCon}) [])) (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike})))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) ({ <no location info> } (HsPar - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsWrap - (NoExt) + (NoExtField) (WpTyApp (TyConApp ({abstract:TyCon}) [])) (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike})))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) ({ <no location info> } (HsPar - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsWrap - (NoExt) + (NoExtField) (WpTyApp (TyConApp ({abstract:TyCon}) [])) (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike})))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: $krep}))))) ({ <no location info> } (HsWrap - (NoExt) + (NoExtField) (WpTyApp (TyConApp ({abstract:TyCon}) [])) (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike})))))))))))))))))) (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: $krep} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: DumpTypecheckedAst.$tcPeano}))))) ({ <no location info> } (HsWrap - (NoExt) + (NoExtField) (WpTyApp (TyConApp ({abstract:TyCon}) [])) (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike})))))) (False))) ,({ <no location info> } (VarBind - (NoExt) + (NoExtField) {Var: DumpTypecheckedAst.$trModule} ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsPar - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) (HsStringPrim (NoSourceText) "main"))))))))) ({ <no location info> } (HsPar - (NoExt) + (NoExtField) ({ <no location info> } (HsApp - (NoExt) + (NoExtField) ({ <no location info> } (HsConLikeOut - (NoExt) + (NoExtField) ({abstract:ConLike}))) ({ <no location info> } (HsLit - (NoExt) + (NoExtField) (HsStringPrim (NoSourceText) "DumpTypecheckedAst"))))))))) (False))) ,({ DumpTypecheckedAst.hs:18:1-23 } (AbsBinds - (NoExt) + (NoExtField) [] [] [(ABE - (NoExt) + (NoExtField) {Var: main} {Var: main} (WpHole) @@ -733,7 +733,7 @@ ({ DumpTypecheckedAst.hs:18:1-23 } [({ DumpTypecheckedAst.hs:18:1-23 } (Match - (NoExt) + (NoExtField) (FunRhs ({ DumpTypecheckedAst.hs:18:1-4 } {Name: main}) @@ -741,29 +741,29 @@ (NoSrcStrict)) [] (GRHSs - (NoExt) + (NoExtField) [({ DumpTypecheckedAst.hs:18:6-23 } (GRHS - (NoExt) + (NoExtField) [] ({ DumpTypecheckedAst.hs:18:8-23 } (HsApp - (NoExt) + (NoExtField) ({ DumpTypecheckedAst.hs:18:8-15 } (HsVar - (NoExt) + (NoExtField) ({ <no location info> } {Var: putStrLn}))) ({ DumpTypecheckedAst.hs:18:17-23 } (HsLit - (NoExt) + (NoExtField) (HsString (SourceText "\"hello\"") {FastString: "hello"})))))))] ({ <no location info> } (EmptyLocalBinds - (NoExt))))))]) + (NoExtField))))))]) (FromSource)) (WpHole) []))]} diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr index 6c7ef797a1..4612d87cad 100644 --- a/testsuite/tests/parser/should_compile/KindSigs.stderr +++ b/testsuite/tests/parser/should_compile/KindSigs.stderr @@ -9,7 +9,7 @@ (Nothing) [({ KindSigs.hs:8:1-16 } (ImportDecl - (NoExt) + (NoExtField) (NoSourceText) ({ KindSigs.hs:8:8-16 } {ModuleName: Data.Kind}) @@ -22,18 +22,18 @@ (Nothing)))] [({ KindSigs.hs:11:1-17 } (TyClD - (NoExt) + (NoExtField) (FamDecl - (NoExt) + (NoExtField) (FamilyDecl - (NoExt) + (NoExtField) (ClosedTypeFamily (Just [({ KindSigs.hs:12:3-21 } (HsIB - (NoExt) + (NoExtField) (FamEqn - (NoExt) + (NoExtField) ({ KindSigs.hs:12:3-5 } (Unqual {OccName: Foo})) @@ -41,7 +41,7 @@ [(HsValArg ({ KindSigs.hs:12:7 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:12:7 } (Unqual @@ -49,17 +49,17 @@ (Prefix) ({ KindSigs.hs:12:11-21 } (HsKindSig - (NoExt) + (NoExtField) ({ KindSigs.hs:12:11-13 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:12:11-13 } (Unqual {OccName: Int})))) ({ KindSigs.hs:12:18-21 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:12:18-21 } (Unqual @@ -68,271 +68,271 @@ (Unqual {OccName: Foo})) (HsQTvs - (NoExt) + (NoExtField) [({ KindSigs.hs:11:17 } (UserTyVar - (NoExt) + (NoExtField) ({ KindSigs.hs:11:17 } (Unqual {OccName: a}))))]) (Prefix) ({ <no location info> } (NoSig - (NoExt))) + (NoExtField))) (Nothing))))) ,({ KindSigs.hs:15:1-51 } (TyClD - (NoExt) + (NoExtField) (SynDecl - (NoExt) + (NoExtField) ({ KindSigs.hs:15:6-8 } (Unqual {OccName: Bar})) (HsQTvs - (NoExt) + (NoExtField) [({ KindSigs.hs:15:10 } (UserTyVar - (NoExt) + (NoExtField) ({ KindSigs.hs:15:10 } (Unqual {OccName: a}))))]) (Prefix) ({ KindSigs.hs:15:14-51 } (HsTupleTy - (NoExt) + (NoExtField) (HsBoxedOrConstraintTuple) [({ KindSigs.hs:15:16-26 } (HsKindSig - (NoExt) + (NoExtField) ({ KindSigs.hs:15:16-18 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:15:16-18 } (Unqual {OccName: Int})))) ({ KindSigs.hs:15:23-26 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:15:23-26 } (Unqual {OccName: Type})))))) ,({ KindSigs.hs:15:29-32 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:15:29-32 } (Unqual {OccName: Bool})))) ,({ KindSigs.hs:15:35-49 } (HsKindSig - (NoExt) + (NoExtField) ({ KindSigs.hs:15:35-41 } (HsAppTy - (NoExt) + (NoExtField) ({ KindSigs.hs:15:35-39 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:15:35-39 } (Unqual {OccName: Maybe})))) ({ KindSigs.hs:15:41 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:15:41 } (Unqual {OccName: a})))))) ({ KindSigs.hs:15:46-49 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:15:46-49 } (Unqual {OccName: Type}))))))]))))) ,({ KindSigs.hs:16:1-54 } (TyClD - (NoExt) + (NoExtField) (SynDecl - (NoExt) + (NoExtField) ({ KindSigs.hs:16:6-9 } (Unqual {OccName: Bar'})) (HsQTvs - (NoExt) + (NoExtField) [({ KindSigs.hs:16:11 } (UserTyVar - (NoExt) + (NoExtField) ({ KindSigs.hs:16:11 } (Unqual {OccName: a}))))]) (Prefix) ({ KindSigs.hs:16:15-54 } (HsTupleTy - (NoExt) + (NoExtField) (HsUnboxedTuple) [({ KindSigs.hs:16:18-28 } (HsKindSig - (NoExt) + (NoExtField) ({ KindSigs.hs:16:18-20 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:16:18-20 } (Unqual {OccName: Int})))) ({ KindSigs.hs:16:25-28 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:16:25-28 } (Unqual {OccName: Type})))))) ,({ KindSigs.hs:16:31-34 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:16:31-34 } (Unqual {OccName: Bool})))) ,({ KindSigs.hs:16:37-51 } (HsKindSig - (NoExt) + (NoExtField) ({ KindSigs.hs:16:37-43 } (HsAppTy - (NoExt) + (NoExtField) ({ KindSigs.hs:16:37-41 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:16:37-41 } (Unqual {OccName: Maybe})))) ({ KindSigs.hs:16:43 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:16:43 } (Unqual {OccName: a})))))) ({ KindSigs.hs:16:48-51 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:16:48-51 } (Unqual {OccName: Type}))))))]))))) ,({ KindSigs.hs:19:1-26 } (TyClD - (NoExt) + (NoExtField) (SynDecl - (NoExt) + (NoExtField) ({ KindSigs.hs:19:6-8 } (Unqual {OccName: Baz})) (HsQTvs - (NoExt) + (NoExtField) []) (Prefix) ({ KindSigs.hs:19:12-26 } (HsListTy - (NoExt) + (NoExtField) ({ KindSigs.hs:19:14-24 } (HsKindSig - (NoExt) + (NoExtField) ({ KindSigs.hs:19:14-16 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:19:14-16 } (Unqual {OccName: Int})))) ({ KindSigs.hs:19:21-24 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:19:21-24 } (Unqual {OccName: Type}))))))))))) ,({ KindSigs.hs:22:1-44 } (SigD - (NoExt) + (NoExtField) (TypeSig - (NoExt) + (NoExtField) [({ KindSigs.hs:22:1-3 } (Unqual {OccName: qux}))] (HsWC - (NoExt) + (NoExtField) (HsIB - (NoExt) + (NoExtField) ({ KindSigs.hs:22:8-44 } (HsFunTy - (NoExt) + (NoExtField) ({ KindSigs.hs:22:8-20 } (HsParTy - (NoExt) + (NoExtField) ({ KindSigs.hs:22:9-19 } (HsKindSig - (NoExt) + (NoExtField) ({ KindSigs.hs:22:9-11 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:22:9-11 } (Unqual {OccName: Int})))) ({ KindSigs.hs:22:16-19 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:22:16-19 } (Unqual {OccName: Type})))))))) ({ KindSigs.hs:22:25-44 } (HsFunTy - (NoExt) + (NoExtField) ({ KindSigs.hs:22:25-28 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:22:25-28 } (Unqual {OccName: Bool})))) ({ KindSigs.hs:22:33-44 } (HsParTy - (NoExt) + (NoExtField) ({ KindSigs.hs:22:34-43 } (HsKindSig - (NoExt) + (NoExtField) ({ KindSigs.hs:22:34-35 } (HsTupleTy - (NoExt) + (NoExtField) (HsBoxedOrConstraintTuple) [])) ({ KindSigs.hs:22:40-43 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:22:40-43 } (Unqual {OccName: Type}))))))))))))))))) ,({ KindSigs.hs:23:1-12 } (ValD - (NoExt) + (NoExtField) (FunBind - (NoExt) + (NoExtField) ({ KindSigs.hs:23:1-3 } (Unqual {OccName: qux})) (MG - (NoExt) + (NoExtField) ({ KindSigs.hs:23:1-12 } [({ KindSigs.hs:23:1-12 } (Match - (NoExt) + (NoExtField) (FunRhs ({ KindSigs.hs:23:1-3 } (Unqual @@ -341,246 +341,246 @@ (NoSrcStrict)) [(XPat ({ KindSigs.hs:23:5 } - (WildPat - (NoExt)))) + (WildPat + (NoExtField)))) ,(XPat ({ KindSigs.hs:23:7 } - (WildPat - (NoExt))))] + (WildPat + (NoExtField))))] (GRHSs - (NoExt) + (NoExtField) [({ KindSigs.hs:23:9-12 } (GRHS - (NoExt) + (NoExtField) [] ({ KindSigs.hs:23:11-12 } (HsVar - (NoExt) + (NoExtField) ({ KindSigs.hs:23:11-12 } (Exact {Name: ()}))))))] ({ <no location info> } (EmptyLocalBinds - (NoExt))))))]) + (NoExtField))))))]) (FromSource)) (WpHole) []))) ,({ KindSigs.hs:26:1-29 } (TyClD - (NoExt) + (NoExtField) (SynDecl - (NoExt) + (NoExtField) ({ KindSigs.hs:26:6-9 } (Unqual {OccName: Quux})) (HsQTvs - (NoExt) + (NoExtField) []) (Prefix) ({ KindSigs.hs:26:13-29 } (HsExplicitListTy - (NoExt) + (NoExtField) (IsPromoted) [({ KindSigs.hs:26:16-27 } (HsKindSig - (NoExt) + (NoExtField) ({ KindSigs.hs:26:16-19 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:26:16-19 } (Unqual {OccName: True})))) ({ KindSigs.hs:26:24-27 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:26:24-27 } (Unqual {OccName: Bool}))))))]))))) ,({ KindSigs.hs:27:1-45 } (TyClD - (NoExt) + (NoExtField) (SynDecl - (NoExt) + (NoExtField) ({ KindSigs.hs:27:6-10 } (Unqual {OccName: Quux'})) (HsQTvs - (NoExt) + (NoExtField) []) (Prefix) ({ KindSigs.hs:27:14-45 } (HsExplicitListTy - (NoExt) + (NoExtField) (NotPromoted) [({ KindSigs.hs:27:16-27 } (HsKindSig - (NoExt) + (NoExtField) ({ KindSigs.hs:27:16-19 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:27:16-19 } (Unqual {OccName: True})))) ({ KindSigs.hs:27:24-27 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:27:24-27 } (Unqual {OccName: Bool})))))) ,({ KindSigs.hs:27:30-42 } (HsKindSig - (NoExt) + (NoExtField) ({ KindSigs.hs:27:30-34 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:27:30-34 } (Unqual {OccName: False})))) ({ KindSigs.hs:27:39-42 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:27:39-42 } (Unqual {OccName: Bool}))))))]))))) ,({ KindSigs.hs:28:1-44 } (TyClD - (NoExt) + (NoExtField) (SynDecl - (NoExt) + (NoExtField) ({ KindSigs.hs:28:6-10 } (Unqual {OccName: Quuux})) (HsQTvs - (NoExt) + (NoExtField) [({ KindSigs.hs:28:12 } (UserTyVar - (NoExt) + (NoExtField) ({ KindSigs.hs:28:12 } (Unqual {OccName: b}))))]) (Prefix) ({ KindSigs.hs:28:16-44 } (HsExplicitTupleTy - (NoExt) + (NoExtField) [({ KindSigs.hs:28:19-39 } (HsKindSig - (NoExt) + (NoExtField) ({ KindSigs.hs:28:19-29 } (HsExplicitListTy - (NoExt) + (NoExtField) (NotPromoted) [({ KindSigs.hs:28:20-22 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:28:20-22 } (Unqual {OccName: Int})))) ,({ KindSigs.hs:28:25-28 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:28:25-28 } (Unqual {OccName: Bool}))))])) ({ KindSigs.hs:28:34-39 } (HsListTy - (NoExt) + (NoExtField) ({ KindSigs.hs:28:35-38 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:28:35-38 } (Unqual {OccName: Type})))))))) ,({ KindSigs.hs:28:42 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:28:42 } (Unqual {OccName: b}))))]))))) ,({ KindSigs.hs:31:1-31 } (TyClD - (NoExt) + (NoExtField) (SynDecl - (NoExt) + (NoExtField) ({ KindSigs.hs:31:6-17 } (Unqual {OccName: Sarsaparilla})) (HsQTvs - (NoExt) + (NoExtField) []) (Prefix) ({ KindSigs.hs:31:21-31 } (HsKindSig - (NoExt) + (NoExtField) ({ KindSigs.hs:31:21-23 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:31:21-23 } (Unqual {OccName: Int})))) ({ KindSigs.hs:31:28-31 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:31:28-31 } (Unqual {OccName: Type}))))))))) ,({ KindSigs.hs:34:1-22 } (SigD - (NoExt) + (NoExtField) (TypeSig - (NoExt) + (NoExtField) [({ KindSigs.hs:34:1-4 } (Unqual {OccName: true}))] (HsWC - (NoExt) + (NoExtField) (HsIB - (NoExt) + (NoExtField) ({ KindSigs.hs:34:9-22 } (HsParTy - (NoExt) + (NoExtField) ({ KindSigs.hs:34:10-21 } (HsKindSig - (NoExt) + (NoExtField) ({ KindSigs.hs:34:10-13 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:34:10-13 } (Unqual {OccName: Bool})))) ({ KindSigs.hs:34:18-21 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ KindSigs.hs:34:18-21 } (Unqual {OccName: Type}))))))))))))) ,({ KindSigs.hs:35:1-11 } (ValD - (NoExt) + (NoExtField) (FunBind - (NoExt) + (NoExtField) ({ KindSigs.hs:35:1-4 } (Unqual {OccName: true})) (MG - (NoExt) + (NoExtField) ({ KindSigs.hs:35:1-11 } [({ KindSigs.hs:35:1-11 } (Match - (NoExt) + (NoExtField) (FunRhs ({ KindSigs.hs:35:1-4 } (Unqual @@ -589,22 +589,24 @@ (NoSrcStrict)) [] (GRHSs - (NoExt) + (NoExtField) [({ KindSigs.hs:35:6-11 } (GRHS - (NoExt) + (NoExtField) [] ({ KindSigs.hs:35:8-11 } (HsVar - (NoExt) + (NoExtField) ({ KindSigs.hs:35:8-11 } (Unqual {OccName: True}))))))] ({ <no location info> } (EmptyLocalBinds - (NoExt))))))]) + (NoExtField))))))]) (FromSource)) (WpHole) [])))] (Nothing) (Nothing))) + + diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr index e405262c5c..9e6b981bb8 100644 --- a/testsuite/tests/parser/should_compile/T14189.stderr +++ b/testsuite/tests/parser/should_compile/T14189.stderr @@ -4,14 +4,14 @@ (Just ((,,,) (HsGroup - (NoExt) + (NoExtField) (XValBindsLR (NValBinds [] [])) [] [(TyClGroup - (NoExt) + (NoExtField) [({ T14189.hs:6:1-42 } (DataDecl (DataDeclRn @@ -25,7 +25,7 @@ []) (Prefix) (HsDataDefn - (NoExt) + (NoExtField) (DataType) ({ <no location info> } []) @@ -33,7 +33,7 @@ (Nothing) [({ T14189.hs:6:15-20 } (ConDeclH98 - (NoExt) + (NoExtField) ({ T14189.hs:6:15-16 } {Name: T14189.MT}) ({ <no location info> } @@ -43,14 +43,14 @@ (PrefixCon [({ T14189.hs:6:18-20 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ T14189.hs:6:18-20 } {Name: GHC.Types.Int})))]) (Nothing))) ,({ T14189.hs:6:24-25 } (ConDeclH98 - (NoExt) + (NoExtField) ({ T14189.hs:6:24-25 } {Name: T14189.NT}) ({ <no location info> } @@ -62,7 +62,7 @@ (Nothing))) ,({ T14189.hs:6:29-42 } (ConDeclH98 - (NoExt) + (NoExtField) ({ T14189.hs:6:29 } {Name: T14189.F}) ({ <no location info> } @@ -73,7 +73,7 @@ ({ T14189.hs:6:31-42 } [({ T14189.hs:6:33-40 } (ConDeclField - (NoExt) + (NoExtField) [({ T14189.hs:6:33 } (FieldOcc {Name: T14189.f} @@ -82,7 +82,7 @@ {OccName: f}))))] ({ T14189.hs:6:38-40 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ T14189.hs:6:38-40 } {Name: GHC.Types.Int}))) @@ -102,7 +102,7 @@ []) [({ T14189.hs:1:8-13 } (ImportDecl - (NoExt) + (NoExtField) (NoSourceText) ({ T14189.hs:1:8-13 } {ModuleName: Prelude}) @@ -117,7 +117,7 @@ [((,) ({ T14189.hs:3:3-15 } (IEThingWith - (NoExt) + (NoExtField) ({ T14189.hs:3:3-8 } (IEName ({ T14189.hs:3:3-8 } @@ -141,3 +141,5 @@ (False) {Name: T14189.f})])])]) (Nothing))) + + diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr index 93b254bf32..25b0ed002d 100644 --- a/testsuite/tests/parser/should_compile/T15323.stderr +++ b/testsuite/tests/parser/should_compile/T15323.stderr @@ -10,23 +10,23 @@ [] [({ T15323.hs:(5,1)-(6,56) } (TyClD - (NoExt) + (NoExtField) (DataDecl - (NoExt) + (NoExtField) ({ T15323.hs:5:6-17 } (Unqual {OccName: MaybeDefault})) (HsQTvs - (NoExt) + (NoExtField) [({ T15323.hs:5:19 } (UserTyVar - (NoExt) + (NoExtField) ({ T15323.hs:5:19 } (Unqual {OccName: v}))))]) (Prefix) (HsDataDefn - (NoExt) + (NoExtField) (DataType) ({ <no location info> } []) @@ -34,17 +34,17 @@ (Nothing) [({ T15323.hs:6:5-56 } (ConDeclGADT - (NoExt) + (NoExtField) [({ T15323.hs:6:5-14 } (Unqual {OccName: TestParens}))] ({ T15323.hs:6:21-55 } (True)) (HsQTvs - (NoExt) + (NoExtField) [({ T15323.hs:6:28 } (UserTyVar - (NoExt) + (NoExtField) ({ T15323.hs:6:28 } (Unqual {OccName: v}))))]) @@ -52,20 +52,20 @@ ({ T15323.hs:6:32-37 } [({ T15323.hs:6:32-37 } (HsParTy - (NoExt) + (NoExtField) ({ T15323.hs:6:33-36 } (HsAppTy - (NoExt) + (NoExtField) ({ T15323.hs:6:33-34 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ T15323.hs:6:33-34 } (Unqual {OccName: Eq})))) ({ T15323.hs:6:36 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ T15323.hs:6:36 } (Unqual @@ -74,17 +74,17 @@ []) ({ T15323.hs:6:42-55 } (HsAppTy - (NoExt) + (NoExtField) ({ T15323.hs:6:42-53 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ T15323.hs:6:42-53 } (Unqual {OccName: MaybeDefault})))) ({ T15323.hs:6:55 } (HsTyVar - (NoExt) + (NoExtField) (NotPromoted) ({ T15323.hs:6:55 } (Unqual @@ -94,3 +94,5 @@ [])))))] (Nothing) (Nothing))) + + diff --git a/utils/haddock b/utils/haddock -Subproject 5e333bad752b9c048ad5400b7159e32f4d3d65b +Subproject 658ad4af237f3da196cca083ad525375260e38a |