diff options
author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2022-12-14 01:25:29 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-01-05 10:48:34 -0500 |
commit | 541aedcd9023445b8e914d595ae8dcf2e799d618 (patch) | |
tree | 35bf6bee4a05753b486bb642de679963aa134614 | |
parent | 00dc51060881df81258ba3b3bdf447294618a4de (diff) | |
download | haskell-541aedcd9023445b8e914d595ae8dcf2e799d618.tar.gz |
Misc cleanup
- Remove unused uniques and hs-boot declarations
- Fix types of seq and unsafeCoerce#
- Remove FastString/String roundtrip in JS
- Use TTG to enforce totality
- Remove enumeration in Heap/Inspect; the 'otherwise' clause
serves the primitive types well.
28 files changed, 59 insertions, 90 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs index 0b2ace3dfb..691f500a77 100644 --- a/compiler/GHC/Builtin/Names.hs +++ b/compiler/GHC/Builtin/Names.hs @@ -2498,19 +2498,6 @@ typeCharTypeRepKey = mkPreludeMiscIdUnique 509 typeRepIdKey = mkPreludeMiscIdUnique 510 mkTrFunKey = mkPreludeMiscIdUnique 511 --- Representations for primitive types -trTYPEKey - , trTYPE'PtrRepLiftedKey - , trRuntimeRepKey - , tr'PtrRepLiftedKey - , trLiftedRepKey - :: Unique -trTYPEKey = mkPreludeMiscIdUnique 512 -trTYPE'PtrRepLiftedKey = mkPreludeMiscIdUnique 513 -trRuntimeRepKey = mkPreludeMiscIdUnique 514 -tr'PtrRepLiftedKey = mkPreludeMiscIdUnique 515 -trLiftedRepKey = mkPreludeMiscIdUnique 516 - -- KindReps for common cases starKindRepKey, starArrStarKindRepKey, starArrStarArrStarKindRepKey, constraintKindRepKey :: Unique starKindRepKey = mkPreludeMiscIdUnique 520 @@ -2523,9 +2510,6 @@ toDynIdKey :: Unique toDynIdKey = mkPreludeMiscIdUnique 530 -bitIntegerIdKey :: Unique -bitIntegerIdKey = mkPreludeMiscIdUnique 550 - heqSCSelIdKey, eqSCSelIdKey, coercibleSCSelIdKey :: Unique eqSCSelIdKey = mkPreludeMiscIdUnique 551 heqSCSelIdKey = mkPreludeMiscIdUnique 552 diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs index babd94f961..44d22f3676 100644 --- a/compiler/GHC/Builtin/Types.hs +++ b/compiler/GHC/Builtin/Types.hs @@ -903,7 +903,7 @@ mkConstraintTupleStr 1 = "Solo%" -- See Note [One-tuples] mkConstraintTupleStr ar = "(%" ++ commas ar ++ "%)" commas :: Arity -> String -commas ar = take (ar-1) (repeat ',') +commas ar = replicate (ar-1) ',' cTupleTyCon :: Arity -> TyCon cTupleTyCon i diff --git a/compiler/GHC/Builtin/Types/Literals.hs b/compiler/GHC/Builtin/Types/Literals.hs index 02ffbd31dd..5609fab10a 100644 --- a/compiler/GHC/Builtin/Types/Literals.hs +++ b/compiler/GHC/Builtin/Types/Literals.hs @@ -479,8 +479,7 @@ axConsSymbolDef = axUnconsSymbolDef = mkUnAxiom "UnconsSymbolDef" typeUnconsSymbolTyCon isStrLitTy $ - \str -> Just $ - mkPromotedMaybeTy charSymbolPairKind (fmap reifyCharSymbolPairTy (unconsFS str)) + \str -> Just $ computeUncons str axCharToNatDef = mkUnAxiom "CharToNatDef" typeCharToNatTyCon isCharLitTy $ @@ -784,14 +783,15 @@ matchFamConsSymbol [s,t] mbY = isStrLitTy t matchFamConsSymbol _ = Nothing -reifyCharSymbolPairTy :: (Char, FastString) -> Type -reifyCharSymbolPairTy (c, s) = charSymbolPair (mkCharLitTy c) (mkStrLitTy s) +computeUncons :: FastString -> Type +computeUncons str = mkPromotedMaybeTy charSymbolPairKind (fmap reifyCharSymbolPairTy (unconsFS str)) + where reifyCharSymbolPairTy :: (Char, FastString) -> Type + reifyCharSymbolPairTy (c, s) = charSymbolPair (mkCharLitTy c) (mkStrLitTy s) matchFamUnconsSymbol :: [Type] -> Maybe (CoAxiomRule, [Type], Type) matchFamUnconsSymbol [s] | Just x <- mbX = - Just (axUnconsSymbolDef, [s] - , mkPromotedMaybeTy charSymbolPairKind (fmap reifyCharSymbolPairTy (unconsFS x))) + Just (axUnconsSymbolDef, [s], computeUncons x) where mbX = isStrLitTy s matchFamUnconsSymbol _ = Nothing diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp index 617abe5f9e..d51f3616f2 100644 --- a/compiler/GHC/Builtin/primops.txt.pp +++ b/compiler/GHC/Builtin/primops.txt.pp @@ -3743,7 +3743,7 @@ pseudoop "proxy#" representation. } pseudoop "seq" - a -> b -> b + a -> p -> p { The value of @'seq' a b@ is bottom if @a@ is bottom, and otherwise equal to @b@. In other words, it evaluates the first argument @a@ to weak head normal form (WHNF). 'seq' is usually @@ -3761,7 +3761,7 @@ pseudoop "seq" -- change this, do update 'ghcPrimIface' in 'GHC.Iface.Load'. pseudoop "unsafeCoerce#" - a -> b + o -> p { The function 'unsafeCoerce#' allows you to side-step the typechecker entirely. That is, it allows you to coerce any type into any other type. If you use this function, you had better get it right, otherwise segmentation faults await. It is generally diff --git a/compiler/GHC/Core/Coercion.hs-boot b/compiler/GHC/Core/Coercion.hs-boot index 5d5193306e..0d56cf628c 100644 --- a/compiler/GHC/Core/Coercion.hs-boot +++ b/compiler/GHC/Core/Coercion.hs-boot @@ -45,8 +45,6 @@ coVarRole :: CoVar -> Role mkCoercionType :: Role -> Type -> Type -> Type -data LiftingContext -liftCoSubst :: HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion seqCo :: Coercion -> () coercionKind :: Coercion -> Pair Type diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs index 17559cf4a9..d5d21e294d 100644 --- a/compiler/GHC/Core/Ppr.hs +++ b/compiler/GHC/Core/Ppr.hs @@ -159,9 +159,9 @@ ppr_binding ann (val_bdr, expr) -- So refer to printing j = e = pp_normal_bind where - (bndrs, body) = collectBinders expr - lhs_bndrs = take join_arity bndrs - rhs = mkLams (drop join_arity bndrs) body + (bndrs, body) = collectBinders expr + (lhs_bndrs, rest) = splitAt join_arity bndrs + rhs = mkLams rest body pprParendExpr expr = ppr_expr parens expr pprCoreExpr expr = ppr_expr noParens expr diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs index 1ef00b0977..e16ff2faa6 100644 --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -781,7 +781,7 @@ isBoxedRuntimeRep_maybe rep -- | Check whether a type of kind 'RuntimeRep' is lifted, unlifted, or unknown. -- --- `isLiftedRuntimeRep rr` returns: +-- `runtimeRepLevity_maybe rr` returns: -- -- * `Just Lifted` if `rr` is `LiftedRep :: RuntimeRep` -- * `Just Unlifted` if `rr` is definitely unlifted, e.g. `IntRep` @@ -1028,7 +1028,7 @@ invariant: use it. Note [Decomposing fat arrow c=>t] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Can we unify (a b) with (Eq a => ty)? If we do so, we end up with -a partial application like ((=>) Eq a) which doesn't make sense in +a partial application like ((=>) (Eq a)) which doesn't make sense in source Haskell. In contrast, we *can* unify (a b) with (t1 -> t2). Here's an example (#9858) of how you might do it: i :: (Typeable a, Typeable b) => Proxy (a b) -> TypeRep diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs index c88ddb3d55..32be6488b8 100644 --- a/compiler/GHC/Core/Utils.hs +++ b/compiler/GHC/Core/Utils.hs @@ -141,8 +141,7 @@ exprType (Lam binder expr) = mkLamType binder (exprType expr) exprType e@(App _ _) = case collectArgs e of (fun, args) -> applyTypeToArgs (pprCoreExpr e) (exprType fun) args - -exprType other = pprPanic "exprType" (pprCoreExpr other) +exprType (Type ty) = pprPanic "exprType" (ppr ty) coreAltType :: CoreAlt -> Type -- ^ Returns the type of the alternatives right hand side diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs index 4794f11075..3a6b964aa8 100644 --- a/compiler/GHC/HsToCore/Arrows.hs +++ b/compiler/GHC/HsToCore/Arrows.hs @@ -647,7 +647,7 @@ dsCmd ids local_vars stack_ty res_ty (XCmd (HsWrap wrap cmd)) env_ids = do core_wrap <- dsHsWrapper wrap return (core_wrap core_cmd, env_ids') -dsCmd _ _ _ _ c _ = pprPanic "dsCmd" (ppr c) +dsCmd _ _ _ _ c@(HsCmdLam {}) _ = pprPanic "dsCmd" (ppr c) -- D; ys |-a c : stk --> t (ys <= xs) -- --------------------- diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs index 21cab8439d..4d594e833f 100644 --- a/compiler/GHC/HsToCore/Binds.hs +++ b/compiler/GHC/HsToCore/Binds.hs @@ -307,7 +307,7 @@ dsAbsBinds dflags tyvars dicts exports ; let mk_bind (ABE { abe_wrap = wrap , abe_poly = global , abe_mono = local, abe_prags = spec_prags }) - -- See Note [AbsBinds wrappers] in "GHC.Hs.Binds" + -- See Note [ABExport wrapper] in "GHC.Hs.Binds" = do { tup_id <- newSysLocalDs ManyTy tup_ty ; core_wrap <- dsHsWrapper wrap ; let rhs = core_wrap $ mkLams tyvars $ mkLams dicts $ diff --git a/compiler/GHC/HsToCore/Foreign/JavaScript.hs b/compiler/GHC/HsToCore/Foreign/JavaScript.hs index 820ab80275..130de83ebf 100644 --- a/compiler/GHC/HsToCore/Foreign/JavaScript.hs +++ b/compiler/GHC/HsToCore/Foreign/JavaScript.hs @@ -177,14 +177,14 @@ mkFExportJSBits platform c_nm maybe_target arg_htys res_hty is_IO_res_ty _cconv text "h$foreignExport" <> parens ( ftext c_nm <> comma <> - strlit (unitIdString (moduleUnitId m)) <> comma <> - strlit (moduleNameString (moduleName m)) <> comma <> - strlit (unpackFS c_nm) <> comma <> - strlit type_string + strlit (unitIdFS (moduleUnitId m)) <> comma <> + strlit (moduleNameFS (moduleName m)) <> comma <> + strlit c_nm <> comma <> + strlit (mkFastString type_string) ) <> semi _ -> empty - strlit xs = docToSDoc (pprStringLit (mkFastString xs)) + strlit xs = docToSDoc (pprStringLit xs) -- the target which will form the root of what we ask rts_evalIO to run the_cfun @@ -382,16 +382,16 @@ dsJsCall fn_id co (CCall (CCallSpec target cconv safety)) _mDeclHeader = do mkHObj :: Type -> SDoc -mkHObj t = text "h$rts_mk" <> text (showFFIType t) +mkHObj t = text "h$rts_mk" <> showFFIType t unpackHObj :: Type -> SDoc -unpackHObj t = text "h$rts_get" <> text (showFFIType t) +unpackHObj t = text "h$rts_get" <> showFFIType t showStgType :: Type -> SDoc -showStgType t = text "Hs" <> text (showFFIType t) +showStgType t = text "Hs" <> showFFIType t -showFFIType :: Type -> String -showFFIType t = getOccString (getName (typeTyCon t)) +showFFIType :: Type -> SDoc +showFFIType t = ftext (occNameFS (getOccName (typeTyCon t))) typeTyCon :: Type -> TyCon typeTyCon ty @@ -639,7 +639,7 @@ jsResultWrapper result_ty | Just (tc,_) <- maybe_tc_app, tc `hasKey` boolTyConKey = do -- result_id <- newSysLocalDs boolTy ccall_uniq <- newUnique - let forceBool e = mkJsCall ccall_uniq "$r = !(!$1)" [e] boolTy + let forceBool e = mkJsCall ccall_uniq (fsLit "$r = !(!$1)") [e] boolTy return (Just intPrimTy, \e -> forceBool e) @@ -674,10 +674,10 @@ jsResultWrapper result_ty maybe_tc_app = splitTyConApp_maybe result_ty -- low-level primitive JavaScript call: -mkJsCall :: Unique -> String -> [CoreExpr] -> Type -> CoreExpr +mkJsCall :: Unique -> FastString -> [CoreExpr] -> Type -> CoreExpr mkJsCall u tgt args t = mkFCall u ccall args t where ccall = CCall $ CCallSpec - (StaticTarget NoSourceText (mkFastString tgt) (Just primUnit) True) + (StaticTarget NoSourceText tgt (Just primUnit) True) JavaScriptCallConv PlayRisky diff --git a/compiler/GHC/HsToCore/ListComp.hs b/compiler/GHC/HsToCore/ListComp.hs index b9f7c664ce..ca89c468ed 100644 --- a/compiler/GHC/HsToCore/ListComp.hs +++ b/compiler/GHC/HsToCore/ListComp.hs @@ -584,8 +584,8 @@ dsMcStmt (ParStmt bind_ty blocks mzip_op bind_op) stmts_rest = do { exp <- dsInnerMonadComp stmts bndrs return_op ; return (exp, mkBigCoreVarTupTy bndrs) } -dsMcStmt stmt _ = pprPanic "dsMcStmt: unexpected stmt" (ppr stmt) - +dsMcStmt stmt@(ApplicativeStmt {}) _ = pprPanic "dsMcStmt: unexpected stmt" (ppr stmt) +dsMcStmt stmt@(RecStmt {}) _ = pprPanic "dsMcStmt: unexpected stmt" (ppr stmt) matchTuple :: [Id] -> CoreExpr -> DsM CoreExpr -- (matchTuple [a,b,c] body) diff --git a/compiler/GHC/HsToCore/Pmc/Desugar.hs b/compiler/GHC/HsToCore/Pmc/Desugar.hs index 9b02e50c29..8ebe472d5f 100644 --- a/compiler/GHC/HsToCore/Pmc/Desugar.hs +++ b/compiler/GHC/HsToCore/Pmc/Desugar.hs @@ -48,7 +48,7 @@ import GHC.Data.Maybe import qualified GHC.LanguageExtensions as LangExt import GHC.Utils.Monad (concatMapM) import GHC.Types.SourceText (FractionalLit(..)) -import Control.Monad (zipWithM) +import Control.Monad (zipWithM, replicateM) import Data.List (elemIndex) import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.List.NonEmpty as NE @@ -92,7 +92,7 @@ mkPmLitGrds x (PmLit _ (PmLitString s)) = do -- 'GHC.HsToCore.Pmc.Solver.addRefutableAltCon', but it's so much simpler -- here. See Note [Representation of Strings in TmState] in -- GHC.HsToCore.Pmc.Solver - vars <- traverse mkPmId (take (lengthFS s) (repeat charTy)) + vars <- replicateM (lengthFS s) (mkPmId charTy) let mk_char_lit y c = mkPmLitGrds y (PmLit charTy (PmLitChar c)) char_grdss <- zipWithM mk_char_lit vars (unpackFS s) mkListGrds x (zip vars char_grdss) diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs index 349fc770b6..fa5c7b8532 100644 --- a/compiler/GHC/Rename/Bind.hs +++ b/compiler/GHC/Rename/Bind.hs @@ -529,7 +529,7 @@ rnBind sig_fn (PatSynBind x bind) = do { (bind', name, fvs) <- rnPatSynBind sig_fn bind ; return (PatSynBind x bind', name, fvs) } -rnBind _ b = pprPanic "rnBind" (ppr b) +rnBind _ b@(VarBind {}) = pprPanic "rnBind" (ppr b) -- See Note [Pattern bindings that bind no variables] isOkNoBindPattern :: LPat GhcRn -> Bool diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs index 4ee8870318..95931ca4a1 100644 --- a/compiler/GHC/Rename/Expr.hs +++ b/compiler/GHC/Rename/Expr.hs @@ -501,6 +501,8 @@ rnExpr (RecordUpd { rupd_expr = expr, rupd_flds = rbinds }) , plusFVs [fv_getField, fv_setField, fv_e, fv_us] ) } +rnExpr (HsRecSel x _) = dataConCantHappen x + rnExpr (ExprWithTySig _ expr pty) = do { (pty', fvTy) <- rnHsSigWcType ExprWithTySigCtx pty ; (expr', fvExpr) <- bindSigTyVarsFV (hsWcScopedTvs pty') $ @@ -588,9 +590,6 @@ rnExpr (HsProc x pat body) { (body',fvBody) <- rnCmdTop body ; return (HsProc x pat' body', fvBody) } -rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other) - -- HsWrap - {- ************************************************************************ * * diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs index c73b1edcad..9c4f3dd9fb 100644 --- a/compiler/GHC/Rename/Pat.hs +++ b/compiler/GHC/Rename/Pat.hs @@ -773,7 +773,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) mb_con = case ctxt of HsRecFieldCon con -> Just con HsRecFieldPat con -> Just con - _ {- update -} -> Nothing + HsRecFieldUpd -> Nothing rn_fld :: Bool -> Maybe Name -> LHsRecField GhcPs (LocatedA arg) -> RnM (LHsRecField GhcRn (LocatedA arg)) diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs index ec13338d0c..04743d6ba8 100644 --- a/compiler/GHC/Runtime/Heap/Inspect.hs +++ b/compiler/GHC/Runtime/Heap/Inspect.hs @@ -478,22 +478,6 @@ repPrim t = rep where | t == int64PrimTyCon = text $ show (build x :: Int64) | t == word64PrimTyCon = text $ show (build x :: Word64) | t == addrPrimTyCon = text $ show (nullPtr `plusPtr` build x) - | t == stablePtrPrimTyCon = text "<stablePtr>" - | t == stableNamePrimTyCon = text "<stableName>" - | t == statePrimTyCon = text "<statethread>" - | t == proxyPrimTyCon = text "<proxy>" - | t == realWorldTyCon = text "<realworld>" - | t == threadIdPrimTyCon = text "<ThreadId>" - | t == weakPrimTyCon = text "<Weak>" - | t == arrayPrimTyCon = text "<array>" - | t == smallArrayPrimTyCon = text "<smallArray>" - | t == byteArrayPrimTyCon = text "<bytearray>" - | t == mutableArrayPrimTyCon = text "<mutableArray>" - | t == smallMutableArrayPrimTyCon = text "<smallMutableArray>" - | t == mutableByteArrayPrimTyCon = text "<mutableByteArray>" - | t == mutVarPrimTyCon = text "<mutVar>" - | t == mVarPrimTyCon = text "<mVar>" - | t == tVarPrimTyCon = text "<tVar>" | otherwise = char '<' <> ppr t <> char '>' where build ww = unsafePerformIO $ withArray ww (peek . castPtr) -- This ^^^ relies on the representation of Haskell heap values being diff --git a/compiler/GHC/Stg/BcPrep.hs b/compiler/GHC/Stg/BcPrep.hs index e9a3c88e34..b99a0ab8c1 100644 --- a/compiler/GHC/Stg/BcPrep.hs +++ b/compiler/GHC/Stg/BcPrep.hs @@ -128,7 +128,7 @@ bcPrep us bnds = evalState (mapM bcPrepTopLvl bnds) (BcPrepM_State us) isNNLJoinPoint :: Id -> Bool isNNLJoinPoint x = isJoinId x && mightBeUnliftedType (idType x) --- Update an Id's type to take a Void# argument. +-- Update an Id's type to take a (# #) argument. -- Precondition: the Id is a not-necessarily-lifted join point. -- See Note [Not-necessarily-lifted join points] protectNNLJoinPointId :: Id -> Id @@ -200,7 +200,7 @@ Here is an example. Suppose we have Our plan is to behave is if the code was f = \(r :: RuntimeRep) (a :: TYPE r) (x :: T). - let j :: (Void# -> a) + let j :: ((# #) -> a) j = \ _ -> error @r @a "bloop" in case x of A -> j void# diff --git a/compiler/GHC/StgToByteCode.hs b/compiler/GHC/StgToByteCode.hs index 989121207d..7cf5f477b7 100644 --- a/compiler/GHC/StgToByteCode.hs +++ b/compiler/GHC/StgToByteCode.hs @@ -271,7 +271,7 @@ argBits :: Platform -> [ArgRep] -> [Bool] argBits _ [] = [] argBits platform (rep : args) | isFollowableArg rep = False : argBits platform args - | otherwise = take (argRepSizeW platform rep) (repeat True) ++ argBits platform args + | otherwise = replicate (argRepSizeW platform rep) True ++ argBits platform args non_void :: [ArgRep] -> [ArgRep] non_void = filter nv @@ -1818,8 +1818,7 @@ mkMultiBranch maybe_ncons raw_ways = do mkTree vals range_lo range_hi = let n = length vals `div` 2 - vals_lo = take n vals - vals_hi = drop n vals + (vals_lo, vals_hi) = splitAt n vals v_mid = fst (head vals_hi) in do label_geq <- getLabelBc diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs index 5b05e846d5..d465e42800 100644 --- a/compiler/GHC/StgToCmm/Layout.hs +++ b/compiler/GHC/StgToCmm/Layout.hs @@ -554,7 +554,7 @@ mkArgDescr platform args argBits :: Platform -> [ArgRep] -> [Bool] -- True for non-ptr, False for ptr argBits _ [] = [] argBits platform (P : args) = False : argBits platform args -argBits platform (arg : args) = take (argRepSizeW platform arg) (repeat True) +argBits platform (arg : args) = replicate (argRepSizeW platform arg) True ++ argBits platform args ---------------------- diff --git a/compiler/GHC/StgToJS/Deps.hs b/compiler/GHC/StgToJS/Deps.hs index 229daf51a4..bd7d2c75bd 100644 --- a/compiler/GHC/StgToJS/Deps.hs +++ b/compiler/GHC/StgToJS/Deps.hs @@ -153,7 +153,7 @@ genDependencyData mod units = do lookupOtherFun od@(OtherSymb m idTxt) = case M.lookup od unitOtherExports of Just n -> return (Right n) - Nothing | m == mod -> panic ("genDependencyData.lookupOtherFun: unknown local other id: " ++ unpackFS idTxt) + Nothing | m == mod -> pprPanic "genDependencyData.lookupOtherFun: unknown local other id:" (ftext idTxt) Nothing -> Left <$> (maybe (lookupExternalFun Nothing od) return =<< gets (M.lookup od . ddcOther)) diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs index 6ba304be16..239a55ee6e 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs +++ b/compiler/GHC/Tc/Gen/Splice.hs @@ -962,7 +962,7 @@ typedSpliceCtxtDoc n splice spliceResultDoc :: LHsExpr GhcTc -> SDoc spliceResultDoc expr = sep [ text "In the result of the splice:" - , nest 2 (char '$' <> ppr expr) + , nest 2 (text "$$" <> ppr expr) , text "To see what the splice expanded to, use -ddump-splices"] stubNestedSplice :: HsExpr GhcTc diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs index 84e0865154..8c95d6f297 100644 --- a/compiler/GHC/Tc/Utils/Zonk.hs +++ b/compiler/GHC/Tc/Utils/Zonk.hs @@ -785,7 +785,7 @@ zonkExpr env (HsUntypedBracket hsb_tc body) zonkExpr env (HsTypedSplice s _) = runTopSplice s >>= zonkExpr env -zonkExpr _ e@(HsUntypedSplice _ _) = pprPanic "zonkExpr: HsUntypedSplice" (ppr e) +zonkExpr _ (HsUntypedSplice x _) = dataConCantHappen x zonkExpr _ (OpApp x _ _ _) = dataConCantHappen x @@ -899,7 +899,11 @@ zonkExpr env (XExpr (ConLikeTc con tvs tys)) -- The tvs come straight from the data-con, and so are strictly redundant -- See Wrinkles of Note [Typechecking data constructors] in GHC.Tc.Gen.Head -zonkExpr _ expr = pprPanic "zonkExpr" (ppr expr) +zonkExpr _ (RecordUpd x _ _) = dataConCantHappen x +zonkExpr _ (HsGetField x _ _) = dataConCantHappen x +zonkExpr _ (HsProjection x _) = dataConCantHappen x +zonkExpr _ e@(XExpr (HsTick {})) = pprPanic "zonkExpr" (ppr e) +zonkExpr _ e@(XExpr (HsBinTick {})) = pprPanic "zonkExpr" (ppr e) ------------------------------------------------------------------------- {- diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs index 21a03c9c22..50ab1fd6be 100644 --- a/compiler/Language/Haskell/Syntax/Decls.hs +++ b/compiler/Language/Haskell/Syntax/Decls.hs @@ -580,7 +580,8 @@ declaration before checking all of the others, supporting polymorphic recursion. See https://gitlab.haskell.org/ghc/ghc/wikis/ghc-kinds/kind-inference#proposed-new-strategy and #9200 for lots of discussion of how we got here. -The detection of CUSKs is enabled by the -XCUSKs extension, switched on by default. +The detection of CUSKs is enabled by the -XCUSKs extension, switched off by default +in GHC2021 and on in Haskell98/2010. Under -XNoCUSKs, all declarations are treated as if they have no CUSK. See https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0036-kind-signatures.rst diff --git a/docs/users_guide/exts/poly_kinds.rst b/docs/users_guide/exts/poly_kinds.rst index f72b20b790..76a925ffd9 100644 --- a/docs/users_guide/exts/poly_kinds.rst +++ b/docs/users_guide/exts/poly_kinds.rst @@ -372,8 +372,9 @@ According to the rules above ``X`` has a CUSK. Yet, the kind of ``k`` is undeter It is thus quantified over, giving ``X`` the kind ``forall k1 (k :: k1). Proxy k -> Type``. The detection of CUSKs is enabled by the :extension:`CUSKs` flag, which is -switched on by default. This extension is scheduled for deprecation to be -replaced with :extension:`StandaloneKindSignatures`. +switched off by default in GHC2021 and on in Haskell98 and Haskell2010. +This extension is scheduled for deprecation to be replaced +with :extension:`StandaloneKindSignatures`. .. index:: single: standalone kind signature diff --git a/docs/users_guide/exts/unicode_syntax.rst b/docs/users_guide/exts/unicode_syntax.rst index aa1d8e88b4..cda9223ccc 100644 --- a/docs/users_guide/exts/unicode_syntax.rst +++ b/docs/users_guide/exts/unicode_syntax.rst @@ -47,5 +47,7 @@ sequences. The following alternatives are provided: +--------------+---------------+-------------+-----------------------------------------+ | ``|]`` | ⟧ | 0x27E7 | MATHEMATICAL RIGHT WHITE SQUARE BRACKET | +--------------+---------------+-------------+-----------------------------------------+ +| ``%1->`` | ⊸ | 0x22B8 | MULTIMAP | ++--------------+---------------+-------------+-----------------------------------------+ diff --git a/libraries/base/GHC/ST.hs b/libraries/base/GHC/ST.hs index 27749e83bb..4f17f5618b 100644 --- a/libraries/base/GHC/ST.hs +++ b/libraries/base/GHC/ST.hs @@ -131,4 +131,4 @@ instance Show (ST s a) where -- computation is inaccessible to the rest of the program. runST :: (forall s. ST s a) -> a runST (ST st_rep) = case runRW# st_rep of (# _, a #) -> a --- See Note [Definition of runRW#] in GHC.Magic +-- See Note [runRW magic] in GHC.CoreToStg.Prep diff --git a/testsuite/tests/linters/notes.stdout b/testsuite/tests/linters/notes.stdout index b50da6b3a2..edf75f2d77 100644 --- a/testsuite/tests/linters/notes.stdout +++ b/testsuite/tests/linters/notes.stdout @@ -13,7 +13,6 @@ ref compiler/GHC/Hs/Expr.hs:1704:87: Note [Lifecycle of a splice] ref compiler/GHC/Hs/Expr.hs:1740:7: Note [Pending Splices] ref compiler/GHC/Hs/Extension.hs:144:5: Note [Strict argument type constraints] ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] -ref compiler/GHC/HsToCore/Binds.hs:312:33: Note [AbsBinds wrappers] ref compiler/GHC/HsToCore/Pmc/Solver.hs:854:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1460:7: Note [How brackets and nested splices are handled] ref compiler/GHC/Rename/Pat.hs:888:29: Note [Disambiguating record fields] @@ -51,7 +50,6 @@ ref compiler/Language/Haskell/Syntax/Pat.hs:336:12: Note [Disambiguating ref configure.ac:212:10: Note [Linking ghc-bin against threaded stage0 RTS] ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders] ref hadrian/src/Expression.hs:130:30: Note [Linking ghc-bin against threaded stage0 RTS] -ref libraries/base/GHC/ST.hs:134:7: Note [Definition of runRW#] ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] ref testsuite/config/ghc:243:10: Note [WayFlags] |