Haskell.org
Sign In Sign Up
Manage this list Sign In Sign Up

Keyboard Shortcuts

Thread View

  • j: Next unread message
  • k: Previous unread message
  • j a: Jump to all threads
  • j l: Jump to MailingList overview

ghc-commits

Thread Start a new thread
Download
Threads by month
  • ----- 2026 -----
  • July
  • June
  • May
  • April
  • March
  • February
  • January
  • ----- 2025 -----
  • December
  • November
  • October
  • September
  • August
  • July
  • June
  • May
  • April
ghc-commits@haskell.org

June 2026

  • 1 participants
  • 802 discussions
[Git][ghc/ghc][wip/mangoiv/unused-type] compiler: rename ZonkAny to UnusedType and add pretty printing logic
by Magnus (@MangoIV) 19 Jun '26

19 Jun '26
Magnus pushed to branch wip/mangoiv/unused-type at Glasgow Haskell Compiler / GHC Commits: d236b88c by mangoiv at 2026-06-19T16:39:17+02:00 compiler: rename ZonkAny to UnusedType and add pretty printing logic ZonkAny is a hard to understand name for users who do not know how the compiler works internally. Additionally, it is confusing that ZonkAny, while being a concrete type *represents* a meta variable, espeically in the compiler output. This patch changes the name of ZonkAny to UnusedType which is closer to its intended semantics and adds special pretty printing logic to display this type in the same fashion the compiler displays meta variables in other places, whenever they leak from the implementation to the user. Fixes #27390 - - - - - 22 changed files: - + changelog.d/unused-type - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - libraries/ghc-internal/src/GHC/Internal/Types.hs - testsuite/tests/perf/compiler/T11068.stdout - testsuite/tests/pmcheck/should_compile/T12957.stderr - testsuite/tests/profiling/should_run/staticcallstack002.stdout - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T13156.stdout - testsuite/tests/simplCore/should_compile/T26615.stderr - testsuite/tests/typecheck/should_fail/T13292.stderr - + testsuite/tests/typecheck/should_fail/T27390-explicit-kinds.stderr - + testsuite/tests/typecheck/should_fail/T27390.hs - + testsuite/tests/typecheck/should_fail/T27390.stderr - + testsuite/tests/typecheck/should_fail/T27390a.hs - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== changelog.d/unused-type ===================================== @@ -0,0 +1,12 @@ +section: compiler +synopsis: Rename ZonkAny to UnusedType and add pretty printing logic for it. +issues: #27390 +mrs: !16212 + +description: { + After unification, GHC fills in unconstrained type variables such as ``alpha`` in + ``(length :: [alpha] -> Int) ([] :: List alpha) :: Int`` with a fixed type. + This type was, confusingly to the user, called ``ZonkAny``. + This type is now renamed ``UnusedType``, with special pretty-printing logic to make + it display like an ordinary metavariable. +} ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -1904,8 +1904,8 @@ unsatisfiableClassNameKey = mkPreludeTyConUnique 170 anyTyConKey :: Unique anyTyConKey = mkPreludeTyConUnique 171 -zonkAnyTyConKey :: Unique -zonkAnyTyConKey = mkPreludeTyConUnique 172 +unusedTypeTyConKey :: Unique +unusedTypeTyConKey = mkPreludeTyConUnique 172 -- Custom user type-errors errorMessageTypeErrorFamKey :: Unique ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -93,7 +93,7 @@ module GHC.Builtin.Types ( cTupleSelId, cTupleSelIdName, -- * Any - anyTyCon, anyTy, anyTypeOfKind, zonkAnyTyCon, + anyTyCon, anyTy, anyTypeOfKind, unusedTypeTyCon, -- * Recovery TyCon makeRecoveryTyCon, @@ -300,7 +300,7 @@ wiredInTyCons :: [TyCon] wiredInTyCons = map (dataConTyCon . snd) boxingDataCons ++ [ anyTyCon - , zonkAnyTyCon + , unusedTypeTyCon , boolTyCon , charTyCon , stringTyCon @@ -412,55 +412,88 @@ doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") {- Note [Any types] ~~~~~~~~~~~~~~~~ -The type constructors `Any` and `ZonkAny` are closed type families declared thus: +The type constructors `Any` and `UnusedType` are closed type families declared as: - type family Any :: forall k. k where { } - type family ZonkAny :: forall k. Nat -> k where { } + type family Any :: forall k. k where { } + type family UnusedType :: forall k. Nat -> Symbol -> k where { } They are used when we want a type of a particular kind, but we don't really care -what that type is. The leading example is this: `ZonkAny` is used to instantiate -un-constrained type variables after type checking. For example, consider the -term (length [] :: Int), where +what that type is. The leading example is this: - length :: forall a. [a] -> Int - [] :: forall a. [a] + `UnusedType` is used to instantiate un-constrained type variables after type + checking. For example, consider the term (length [] :: Int), where -We must type-apply `length` and `[]`, but to what type? It doesn't matter! -The typechecker will end up with + length :: forall a. [a] -> Int + [] :: forall a. [a] - length @alpha ([] @alpha) + We must type-apply `length` and `[]`, but to what type? It doesn't matter! + The typechecker will end up with -where `alpha` is an un-constrained unification variable. The "zonking" process zaps -that unconstrained `alpha` to an arbitrary type (ZonkAny @Type 3), where the `3` is -arbitrary (see wrinkle (Any5) below). This is done in `GHC.Tc.Zonk.Type.commitFlexi`. -So we end up with + length @alpha ([] @alpha) - length @(ZonkAny @Type 3) ([] @(ZonkAny @Type 3)) + where `alpha` is an un-constrained unification variable. The "zonking" process + zaps that unconstrained `alpha` to an arbitrary type (UnusedType @Type 3 "a"), + where the `3` is arbitrary (see wrinkle (Any3) below) and "a" is the name string + of the meta variable. This is done in `GHC.Tc.Zonk.Type.commitFlexi`. + So we end up with -`Any` and `ZonkAny` differ only in the presence of the `Nat` argument; see -wrinkle (Any4). + length @(UnusedType @Type 3 "a") ([] @(UnusedType @Type 3 "a")) -Wrinkles: +`Any` and `UnusedType` differ only in the presence of the `Nat` and the `Symbol` +arguments; see (Any6). -(Any1) `Any` and `ZonkAny` are kind polymorphic since in some program we may - need to use `ZonkAny` to fill in a type variable of some kind other than * - (see #959 for examples). - -(Any2) They are /closed/ type families, with no instances. For example, suppose that +(Any1) They are /closed/ type families, with no instances. For example, suppose that with alpha :: '(k1, k2) we add a given coercion g :: alpha ~ (Fst alpha, Snd alpha) - and we zonked alpha = ZonkAny @(k1,k2) n. Then, if `ZonkAny` was a /data/ type, - we'd get inconsistency because we'd have a Given equality with `ZonkAny` on one + and we zonked alpha = UnusedType @(k1,k2) n. Then, if `UnusedType` was a /data/ type, + we'd get inconsistency because we'd have a Given equality with `UnusedType` on one side and '(,) on the other. See also #9097 and #9636. - See #25244 for a suggestion that we instead use an /open/ type family for which - you cannot provide instances. Probably the difference is not very important. + They are not /data/ types, and that's important for the code generator, + because the code gen may enter a data value. + + A closed type family with no equations behaves differently than an open type + family with no equations due to Note [Insoluble fundeps] IFD0 in + GHC.Tc.Solver.FunDeps, so it was argued in #25244 that perhaps 'Any' should + rather be an open type family for which new equations cannot be written. + +(Any2) `Any` and `UnusedType` are kind polymorphic since in some programs we may + need to use `UnusedType` to fill in a type variable of some kind other than Type + e.g. TYPE r for some r, or types of the form _ -> Type. + +(Any3) `Any` and `UnusedType` are wired-in so we can easily refer to them where we + don't have a name environment. -(Any3) They do not claim to be /data/ types, and that's important for - the code generator, because the code gen may /enter/ a data value - but never enters a function value. +(Any4) `Any` is defined in ghc-internal:GHC.Internal.Types, and exported. `Any` + is available to users because it is a useful type in userspace and is thus + re-exported from base:GHC.Exts. -(Any4) `ZonkAny` takes a `Nat` argument so that we can readily make up /distinct/ + `UnusedType` /could/ be exported mainly for documentation in case a user + stumbles over it in debug output of GHC. However, since we don't want to + actually have the user use that type and discoverability of internal modules + is (and should be) low, and the fact that we cannot depend on `Natural` in + ghc-internal:GHC.Internal.Types, we do not export it. + + The key property of 'Any' is that it is safe to coerce a type to 'Any' as long + as the representation is unchanged. That is, it is OK to use 'unsafeCoerce#' to + go from 'ty :: TYPE r' to 'Any :: TYPE r' and back. + That is, it is useful when e.g. implementing dependent maps or similar typed + container types, storing values of type `Any`. + +(Any5) Warning about unused bindings of type `Any` and `UnusedType` are suppressed, + following the same rationale of supressing warning about the unit type. + + For example, consider (#25895): + + do { forever (return ()); blah } + + where forever :: forall a b. IO a -> IO b + Nothing constrains `b`, so it will be instantiated with `Any` or `UnusedType`. + But we certainly don't want to complain about a discarded do-binding. + +(Any6) Wrinkle - Pattern match checking. + + `UnusedType` takes a `Nat` argument so that we can readily make up /distinct/ types (#24817). Consider data SBool a where { STrue :: SBool True; SFalse :: SBool False } @@ -475,53 +508,32 @@ Wrinkles: Now, what are `alpha` and `beta`? If we zonk both of them to the same type `Any @Type`, the pattern-match checker will (wrongly) report that the first branch is inaccessible. So we zonk them to two /different/ types: - alpha := ZonkAny @Type 4 and beta := ZonkAny @Type k 5 + alpha := UnusedType @Type 4 "a" and beta := UnusedType @Type k 5 "b" (The actual numbers are arbitrary; they just need to differ.) The unique-name generation comes from field `tcg_zany_n` of `TcGblEnv`; and - `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newZonkAnyType` to + `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newUnusedTypeType` to make up a fresh type. If this example seems unconvincing (e.g. in this case foo must be bottom) see #24817 for larger but more compelling examples. -(Any5) `Any` and `ZonkAny` are wired-in so we can easily refer to it where we - don't have a name environment (e.g. see Rules.matchRule for one example) - -(Any6) `Any` is defined in library module ghc-prim:GHC.Types, and exported so that - it is available to users. For this reason it's treated like any other - wired-in type: - - has a fixed unique, anyTyConKey, - - lives in the global name cache - Currently `ZonkAny` is not available to users; but it could easily be. - -(Any7) Properties of `Any`: - * When `Any` is instantiated at a lifted type it is inhabited by at least one value, - namely bottom. - - * You can safely coerce any /lifted/ type to `Any` and back with `unsafeCoerce`. - - * You can safely coerce any /unlifted/ type to `Any` and back with `unsafeCoerceUnlifted`. +(Any7) Wrinkle - Error reporting. - * You can coerce /any/ type to `Any` and back with `unsafeCoerce#`, but it's only safe when - the kinds of both the type and `Any` match. + `UnusedType` takes a `Symbol` argument, which we use to neatly display zonked + unfilled metavariables without leaking implementation details of code generation. - * For lifted/unlifted types `unsafeCoerce[Unlifted]` should be preferred over - `unsafeCoerce#` as they prevent accidentally coercing between types with kinds - that don't match. + `UnusedType` is handled specially in the pretty-printer to avoid confusing + compiler output. For example, `UnusedType 3 "foo" :: Type` is displayed as `foo3`. - See examples in ghc-prim:GHC.Types + That special handling is implemented in GHC.Iface.Type.pprTyTcApp and more + specifically ppr_iface_unused_ty_tycon. -(Any8) Warning about unused bindings of type `Any` and `ZonkAny` are suppressed, - following the same rationale of supressing warning about the unit type. - - For example, consider (#25895): + See testcase T27390 for an example of the pretty-printing in action. - do { forever (return ()); blah } - - where forever :: forall a b. IO a -> IO b - Nothing constrains `b`, so it will be instantiates with `Any` or `ZonkAny`. - But we certainly don't want to complain about a discarded do-binding. + Historical note: in the past, `UnusedType` was called `ZonkAny` (or `Any` before that). + We renamed it to `UnusedType` and added this special treatment in the pretty-printer to avoid + confusing mentions of zonking. The Any tycon used to be quite magic, but we have since been able to implement it merely with an empty kind polymorphic type family. See #10886 for a @@ -550,22 +562,23 @@ anyTy = mkTyConTy anyTyCon anyTypeOfKind :: Kind -> Type anyTypeOfKind kind = mkTyConApp anyTyCon [kind] -zonkAnyTyConName :: Name -zonkAnyTyConName = - mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "ZonkAny") zonkAnyTyConKey zonkAnyTyCon +unusedTypeTyConName :: Name +unusedTypeTyConName = + mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "UnusedType") unusedTypeTyConKey unusedTypeTyCon -zonkAnyTyCon :: TyCon --- ZonkAnyTyCon :: forall k. Nat -> k +unusedTypeTyCon :: TyCon +-- unusedTypeTyCon :: forall k. Nat -> Symbol -> k -- See Note [Any types] -zonkAnyTyCon = mkFamilyTyCon zonkAnyTyConName kind bndrs 0 res_kind +unusedTypeTyCon = mkFamilyTyCon unusedTypeTyConName kind bndrs 0 res_kind Nothing (ClosedSynFamilyTyCon Nothing) Nothing NotInjective where - [kv,nat_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy] + [kv,nat_kv,sym_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy, typeSymbolKind] bndrs = [ mkNamedTyConBinder Specified kv - , mkAnonTyConBinder nat_kv ] + , mkAnonTyConBinder nat_kv + , mkAnonTyConBinder sym_kv ] res_kind = mkTyVarTy kv kind = mkTyConKind bndrs res_kind ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -1281,11 +1281,11 @@ warnDiscardedDoBindings rhs@(L rhs_loc _) m_ty elt_ty do { fam_inst_envs <- dsGetFamInstEnvs ; let norm_elt_ty = topNormaliseType fam_inst_envs elt_ty supressible_ty = - isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isZonkAnyTy norm_elt_ty + isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isUnusedTypeTy norm_elt_ty -- Warn about discarding things in 'monadic' binding, -- however few types are excluded: -- * Unit type `()` - -- * `ZonkAny` or `Any` type see (Any8) of Note [Any types] + -- * `UnusedType` or `Any` type see (Any5) of Note [Any types] ; if warn_unused && not supressible_ty then diagnosticDs (DsUnusedDoBind rhs elt_ty) else ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -7,7 +7,7 @@ This module defines interface types and binders -} -{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE MultiWayIf, OverloadedRecordDot #-} module GHC.Iface.Type ( IfExtName, IfLclName(..), mkIfLclName, ifLclNameFS, @@ -1740,6 +1740,7 @@ pprTyTcApp ctxt_prec tc tys = sdocOption sdocPrintExplicitKinds $ \print_kinds -> sdocOption sdocPrintTypeAbbreviations $ \print_type_abbreviations -> getPprDebug $ \debug -> + getPprStyle $ \style -> if | ifaceTyConName tc `hasKey` ipClassKey , IA_Arg (IfaceLitTy (IfaceStrTyLit n)) @@ -1791,6 +1792,14 @@ pprTyTcApp ctxt_prec tc tys = | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys) -> doc + -- See Note [Any types], specifically (Any6) and (Any7) + | ifaceTyConName tc `hasKey` unusedTypeTyConKey + , ((arg_k, _) : (IfaceLitTy (IfaceNumTyLit arg_n), _) : (IfaceLitTy (IfaceStrTyLit arg_nm), _) : args_usr) + <- appArgsIfaceTypesForAllTyFlags tys + -- if arg_k is a kind with more than 0 arguments, then _ might not be [] here + , userStyle style + -> ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm args_usr + | otherwise -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc $ appArgsIfaceTypesForAllTyFlags $ stripInvisArgs (PrintExplicitKinds print_kinds) tys @@ -1802,6 +1811,23 @@ ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case False -> pprPrefixOcc liftedTypeKindTyConName True -> maybeParen ctxt_prec starPrec starLit +-- | user-style printer that pretty-prints an 'UnusedType @k 3 "foo" to foo3. +-- If -fprint-explicit-kinds or -fprint-explicit-runtime-reps are set, instead +-- prints them to (foo3 :: k). +-- See Note [Any types], specifically (Any6) and (Any7) for why this is useful. +ppr_iface_unused_ty_tycon :: PprPrec -> IfaceType -> Integer -> LexicalFastString -> [(IfaceType, ForAllTyFlag)] -> SDoc +ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm args_usr + = sdocOption sdocPrintExplicitKinds $ \print_kinds -> + sdocOption sdocPrintExplicitRuntimeReps $ \print_reps -> + if print_kinds || print_reps + then prettyMeta $ \nm -> + maybeParen sig_prec sigPrec $ nm <+> text "::" <+> pprIfaceType arg_k + else prettyMeta id + where sig_prec = if null args_usr then ctxt_prec else appPrec + prettyMeta add_ty + = pprIfacePrefixApp ctxt_prec (add_ty $ ppr arg_nm <> ppr arg_n) + $ map (ppr_app_arg appPrec) args_usr + -- | Pretty-print a type-level equality. -- Returns (Just doc) if the argument is a /saturated/ application -- of eqTyCon (~) @@ -2190,7 +2216,8 @@ instance Binary IfaceTyConSort where 0 -> return IfaceNormalTyCon 1 -> IfaceTupleTyCon <$> get bh <*> get bh 2 -> IfaceSumTyCon <$> get bh - _ -> return IfaceEqualityTyCon + 3 -> return IfaceEqualityTyCon + _ -> panic "get IfaceTyConSort" instance Binary IfaceTyConInfo where put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -582,8 +582,8 @@ data TcGblEnv -- ^ Allows us to choose unique DFun names. tcg_zany_n :: TcRef Integer, - -- ^ A source of unique identities for ZonkAny instances - -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) + -- ^ A source of unique identities for UnusedType instances + -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any6) tcg_merged :: [(Module, Fingerprint)], -- ^ The requirements we merged with; we always have to recompile ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -154,7 +154,7 @@ module GHC.Tc.Utils.Monad( getCCIndexM, getCCIndexTcM, -- * Zonking - liftZonkM, newZonkAnyType, + liftZonkM, newUnusedType, -- * Complete matches localAndImportedCompleteMatches, getCompleteMatchesTcM, @@ -168,7 +168,7 @@ import GHC.Prelude import GHC.Builtin.Names -import GHC.Builtin.Types( zonkAnyTyCon ) +import GHC.Builtin.Types( unusedTypeTyCon ) import GHC.Tc.Errors.Types import GHC.Tc.Errors.Hole.Plugin ( HoleFitPlugin, HoleFitPluginR (..) ) @@ -197,7 +197,7 @@ import GHC.Core.Coercion ( isReflCo ) import GHC.Core.Multiplicity import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import GHC.Core.Type( mkNumLitTy ) +import GHC.Core.Type( mkNumLitTy, mkStrLitTy ) import GHC.Core.TyCo.Rep( CoercionHole(..) ) import GHC.Core.TyCo.FVs( coVarsOfCo ) import GHC.Core.TyCon ( TyCon ) @@ -2258,17 +2258,17 @@ chooseUniqueOccTc fn = ; writeTcRef dfun_n_var (extendOccSet set occ) ; return occ } -newZonkAnyType :: Kind -> TcM Type --- Return a type (ZonkAny @k n), where n is fresh --- Recall ZonkAny :: forall k. Natural -> k --- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) -newZonkAnyType kind +newUnusedType :: Name -> Kind -> TcM Type +-- Return a type (UnusedType @k n sym), where n is fresh +-- Recall UnusedType :: forall k. Natural -> Symbol -> k +-- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any6) +newUnusedType name kind = do { env <- getGblEnv ; let zany_n_var = tcg_zany_n env ; i <- readTcRef zany_n_var ; let !i2 = i+1 ; writeTcRef zany_n_var i2 - ; return (mkTyConApp zonkAnyTyCon [kind, mkNumLitTy i]) } + ; return (mkTyConApp unusedTypeTyCon [kind, mkNumLitTy i, mkStrLitTy $ getOccFS name ]) } getConstraintVar :: TcM (TcRef WantedConstraints) getConstraintVar = do { env <- getLclEnv; return (tcl_lie env) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -85,7 +85,7 @@ module GHC.Tc.Utils.TcType ( isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy, isFloatingPrimTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, - isBoolTy, isUnitTy, isAnyTy, isZonkAnyTy, isCharTy, + isBoolTy, isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy, isTauTy, isTauTyCon, tcIsTyVarTy, isPredTy, isSimplePredTy, isTyVarClassPred, checkValidClsArgs, hasTyVarHead, @@ -2057,7 +2057,7 @@ isFloatTy, isDoubleTy, isFloatPrimTy, isDoublePrimTy, isIntegerTy, isNaturalTy, isIntTy, isWordTy, isBoolTy, - isUnitTy, isAnyTy, isZonkAnyTy, isCharTy :: Type -> Bool + isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy :: Type -> Bool isFloatTy = is_tc floatTyConKey isDoubleTy = is_tc doubleTyConKey isFloatPrimTy = is_tc floatPrimTyConKey @@ -2069,7 +2069,7 @@ isWordTy = is_tc wordTyConKey isBoolTy = is_tc boolTyConKey isUnitTy = is_tc unitTyConKey isAnyTy = is_tc anyTyConKey -isZonkAnyTy = is_tc zonkAnyTyConKey +isUnusedTypeTy = is_tc unusedTypeTyConKey isCharTy = is_tc charTyConKey -- | Check whether the type is of the form @Any :: k@, ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedRecordDot #-} {- (c) The University of Glasgow 2006 (c) The AQUA Project, Glasgow University, 1996-1998 @@ -43,7 +44,7 @@ import GHC.Tc.Types.TcRef import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo ) import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) import GHC.Tc.Utils.TcType -import GHC.Tc.Utils.Monad ( newZonkAnyType, setSrcSpanA, liftZonkM, traceTc, addErr ) +import GHC.Tc.Utils.Monad ( newUnusedType, setSrcSpanA, liftZonkM, traceTc, addErr ) import GHC.Tc.Types.Evidence import GHC.Tc.Errors.Types import GHC.Tc.Zonk.Env @@ -470,11 +471,11 @@ commitFlexi DefaultFlexi tv zonked_kind ; return manyDataConTy } | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv = do { addErr $ TcRnZonkerMessage (ZonkerCannotDefaultConcrete origin) - ; newZonkAnyType zonked_kind } + ; newUnusedType tv.varName zonked_kind } | otherwise - = do { traceTc "Defaulting flexi tyvar to ZonkAny:" (pprTyVar tv) - -- See Note [Any types] in GHC.Builtin.Types, esp wrinkle (Any4) - ; newZonkAnyType zonked_kind } + = do { traceTc "Defaulting flexi tyvar to UnusedType:" (pprTyVar tv) + -- See Note [Any types] in GHC.Builtin.Types, esp wrinkle (Any6) + ; newUnusedType tv.varName zonked_kind } zonkCoVarOcc :: CoVar -> ZonkTcM Coercion zonkCoVarOcc cv ===================================== libraries/ghc-internal/src/GHC/Internal/Types.hs ===================================== @@ -284,43 +284,33 @@ data Symbol * * ********************************************************************* -} --- | The type constructor @Any :: forall k. k@ is a type to which you can unsafely coerce any type, and back. +-- | The type constructor @Any :: forall k. k@ allows creating an arbitrary type +-- of the given kind. -- --- For @unsafeCoerce@ this means for all lifted types @t@ that --- @unsafeCoerce (unsafeCoerce x :: Any) :: t@ is equivalent to @x@ and safe. +-- It can be used to create a placeholder type when you only have a kind in hand. -- --- The same is true for *all* types when using --- @ --- unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) --- (a :: TYPE r1) (b :: TYPE r2). --- a -> b --- @ --- but /only/ if you instantiate @r1@ and @r2@ to the /same/ runtime representation. --- For example using @(unsafeCoerce# :: forall (a :: TYPE IntRep) (b :: TYPE IntRep). a -> b) x@ --- is fine, but @(unsafeCoerce# :: forall (a :: TYPE IntRep) (b :: TYPE FloatRep). a -> b)@ --- will likely cause seg-faults or worse. --- For this resason, users should always prefer unsafeCoerce over unsafeCoerce# when possible. +-- You can use 'unsafeCoerce#' to unsafely coerce a value from @ty :: k@ to @Any \@k@ +-- and back. As per the documentation of 'unsafeCoerce#', this is only sound if both +-- sides have the __exact same__runtime representation. Some examples: -- --- Here are some more examples: -- @ --- bad_a1 :: Any @(TYPE 'IntRep) --- bad_a1 = unsafeCoerce# True --- --- bad_a2 :: Any @(TYPE ('BoxedRep 'UnliftedRep)) --- bad_a2 = unsafeCoerce# True +-- unsafeCoerce# True :: (Any :: Type) -- OK +-- unsafeCoerce# (1# :: Int#) :: (Any :: TYPE IntRep) -- OK +-- unsafeCoerce# True :: (Any :: Type IntRep) -- INVALID +-- unsafeCoerce True :: (Any :: UnliftedType) -- INVALID +-- unsafeCoerce (ba :: ByteArray#) :: (Any :: Type) -- INVALID -- @ --- Here @bad_a1@ is bad because we started with @True :: (Bool :: Type)@, represented by a boxed heap pointer, --- and coerced it to @a1 :: Any @(TYPE 'IntRep)@, whose representation is a non-pointer integer. --- That's why we had to use `unsafeCoerce#`; it is really unsafe because it can change representations. --- Similarly @bad_a2@ is bad because although both @True@ and @bad_a2@ are represented by a heap pointer, --- @True@ is lifted but @bad_a2@ is not; bugs here may be rather subtle. -- --- If you must use unsafeCoerce# to cast to `Any`, type annotations are recommended --- to make sure that @Any@ has the correct kind. As casting between different runtimereps is --- unsound. For example to cast a @ByteArray#@ to @Any@ you might use: --- @ --- unsafeCoerce# b :: (Any :: TYPE ('BoxedRep 'Unlifted)) --- @ +-- To avoid accidentally unsafe-coercing between different representations, +-- it is recommended to: +-- - use explicit type annotations or type applications at every use-site +-- of 'unsafeCoerce#' +-- - use representation-monomorphic variants such as 'unsafeCoerce' or +-- 'unsafeCoerceUnlifted'. +-- +-- In particular, this also implies it is safe to round-trip unsafe-coercion via 'Any', +-- as long as the kinds line up e.g. @unsafeCoerce (unsafeCoerce (val :: a) :: 'Any') :: a@ +-- is safe in that way. type family Any :: k where { } -- See Note [Any types] in GHC.Builtin.Types. Also, for a bit of history on Any see -- #10886. Note that this must be a *closed* type family: we need to ensure ===================================== testsuite/tests/perf/compiler/T11068.stdout ===================================== @@ -23,137 +23,137 @@ `cast` (GHC.Internal.Generics.N:M1 `cast` (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 ===================================== testsuite/tests/pmcheck/should_compile/T12957.stderr ===================================== @@ -1,7 +1,6 @@ T12957.hs:4:5: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive - In a case alternative: - Patterns of type ‘[GHC.Internal.Types.ZonkAny 0]’ not matched: [] + In a case alternative: Patterns of type ‘[a0]’ not matched: [] T12957.hs:4:16: warning: [GHC-53633] [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant ===================================== testsuite/tests/profiling/should_run/staticcallstack002.stdout ===================================== @@ -1,4 +1,4 @@ -Just (InfoProv {ipName = "sat_s1Rh_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 0", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) -Just (InfoProv {ipName = "sat_s1RB_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 1", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) -Just (InfoProv {ipName = "sat_s1RV_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 2", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) -Just (InfoProv {ipName = "sat_s1Sf_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 3", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) +Just (InfoProv {ipName = "main_sat_t2fs_info", ipDesc = THUNK, ipTyDesc = "UnusedType 0 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) +Just (InfoProv {ipName = "main_sat_t2fJ_info", ipDesc = THUNK, ipTyDesc = "UnusedType 1 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) +Just (InfoProv {ipName = "main_sat_t2g0_info", ipDesc = THUNK, ipTyDesc = "UnusedType 2 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) +Just (InfoProv {ipName = "main_sat_t2gh_info", ipDesc = THUNK, ipTyDesc = "UnusedType 3 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -188,7 +188,7 @@ T13155: T13156: $(RM) -f T13156.hi T13156.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T13156.hs -O -ddump-prep -dsuppress-uniques | grep "case.*Any" + '$(TEST_HC)' $(TEST_HC_OPTS) -c T13156.hs -O -ddump-prep -dsuppress-uniques | grep "case.*UnusedType" # There should be a single 'case r @ GHC.Types.Any' .PHONY: T4138 ===================================== testsuite/tests/simplCore/should_compile/T13156.stdout ===================================== @@ -1,2 +1,2 @@ - case r @(GHC.Internal.Types.ZonkAny 0) of { __DEFAULT -> - case r @(GHC.Internal.Types.ZonkAny 1) of { __DEFAULT -> r @a } + case r @(GHC.Internal.Types.UnusedType 0 "a") of { __DEFAULT -> + case r @(GHC.Internal.Types.UnusedType 1 "a") of { __DEFAULT -> ===================================== testsuite/tests/simplCore/should_compile/T26615.stderr ===================================== @@ -2,7 +2,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 1,209, types: 1,139, coercions: 18, joins: 17/29} + = {terms: 1,209, types: 1,155, coercions: 18, joins: 17/29} -- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} unArray :: forall a. Array a -> SmallArray# a @@ -15,45 +15,29 @@ unArray :: forall a. Array a -> SmallArray# a unArray = \ (@a) (ds :: Array a) -> case ds of { Array ds1 -> ds1 } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule4 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$trModule4 = "main"# +$trModule1 :: Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule3 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule3 = GHC.Internal.Types.TrNameS T26615a.$trModule4 +$trModule2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$trModule2 = "T26615a"# +$trModule3 :: Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "T26615a"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule1 = GHC.Internal.Types.TrNameS T26615a.$trModule2 +$trModule4 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule :: GHC.Internal.Types.Module -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule - = GHC.Internal.Types.Module T26615a.$trModule3 T26615a.$trModule1 +T26615a.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module +[GblId, Unf=OtherCon []] +T26615a.$trModule = GHC.Internal.Types.Module $trModule2 $trModule4 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Internal.Types.KindRep @@ -104,33 +88,24 @@ $krep6 GHC.Internal.Types.$tcSmallArray# $krep5 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$tcLeaf2 = "Leaf"# +$tcLeaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tcLeaf1 = "Leaf"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcLeaf1 = GHC.Internal.Types.TrNameS T26615a.$tcLeaf2 +$tcLeaf2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcLeaf2 = GHC.Internal.Types.TrNameS $tcLeaf1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcLeaf [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcLeaf = GHC.Internal.Types.TyCon 13798714324392902582#Word64 3237499036029031497#Word64 T26615a.$trModule - T26615a.$tcLeaf1 + $tcLeaf2 0# GHC.Internal.Types.krep$*->*->* @@ -160,372 +135,284 @@ $krep10 :: GHC.Internal.Types.KindRep $krep10 = GHC.Internal.Types.KindRepFun $krep2 $krep9 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep11 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'L1 = GHC.Internal.Types.KindRepFun $krep3 $krep10 +$krep11 = GHC.Internal.Types.KindRepFun $krep3 $krep10 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$tc'L3 = "'L"# +$tc'L1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'L1 = "'L"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'L2 = GHC.Internal.Types.TrNameS T26615a.$tc'L3 +$tc'L2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'L2 = GHC.Internal.Types.TrNameS $tc'L1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'L [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'L = GHC.Internal.Types.TyCon 8570419491837374712#Word64 2090006989092642392#Word64 T26615a.$trModule - T26615a.$tc'L2 + $tc'L2 2# - T26615a.$tc'L1 + $krep11 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tcArray2 = "Array"# +$tcArray1 :: Addr# +[GblId, Unf=OtherCon []] +$tcArray1 = "Array"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcArray1 = GHC.Internal.Types.TrNameS T26615a.$tcArray2 +$tcArray2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcArray2 = GHC.Internal.Types.TrNameS $tcArray1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcArray [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcArray = GHC.Internal.Types.TyCon 10495761415291712389#Word64 7580086293698619153#Word64 T26615a.$trModule - T26615a.$tcArray1 + $tcArray2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11 :: GHC.Internal.Types.KindRep +$krep12 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep11 +$krep12 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep4 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep13 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Array1 = GHC.Internal.Types.KindRepFun $krep6 $krep11 +$krep13 = GHC.Internal.Types.KindRepFun $krep6 $krep12 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Array3 = "'Array"# +$tc'Array1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Array1 = "'Array"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Array2 = GHC.Internal.Types.TrNameS T26615a.$tc'Array3 +$tc'Array2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Array2 = GHC.Internal.Types.TrNameS $tc'Array1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Array [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Array = GHC.Internal.Types.TyCon 12424115309881832159#Word64 15542868641947707803#Word64 T26615a.$trModule - T26615a.$tc'Array2 + $tc'Array2 1# - T26615a.$tc'Array1 + $krep13 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep12 :: [GHC.Internal.Types.KindRep] +$krep14 :: [GHC.Internal.Types.KindRep] [GblId, Unf=OtherCon []] -$krep12 +$krep14 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep9 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep13 :: GHC.Internal.Types.KindRep +$krep15 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep13 - = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep12 +$krep15 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep14 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tcHashMap2 = "HashMap"# +$tcHashMap1 :: Addr# +[GblId, Unf=OtherCon []] +$tcHashMap1 = "HashMap"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcHashMap1 - = GHC.Internal.Types.TrNameS T26615a.$tcHashMap2 +$tcHashMap2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcHashMap2 = GHC.Internal.Types.TrNameS $tcHashMap1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcHashMap [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcHashMap = GHC.Internal.Types.TyCon 2021755758654901686#Word64 8209241086311595496#Word64 T26615a.$trModule - T26615a.$tcHashMap1 + $tcHashMap2 0# GHC.Internal.Types.krep$*->*->* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep16 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Empty1 +$krep16 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcHashMap $krep8 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Empty3 = "'Empty"# +$tc'Empty1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Empty1 = "'Empty"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Empty2 = GHC.Internal.Types.TrNameS T26615a.$tc'Empty3 +$tc'Empty2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Empty2 = GHC.Internal.Types.TrNameS $tc'Empty1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Empty [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Empty = GHC.Internal.Types.TyCon 2520556399233147460#Word64 17224648764450205443#Word64 T26615a.$trModule - T26615a.$tc'Empty2 + $tc'Empty2 2# - T26615a.$tc'Empty1 + $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep14 :: GHC.Internal.Types.KindRep +$krep17 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep14 = GHC.Internal.Types.KindRepFun $krep9 T26615a.$tc'Empty1 +$krep17 = GHC.Internal.Types.KindRepFun $krep9 $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep18 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Leaf1 = GHC.Internal.Types.KindRepFun $krep1 $krep14 +$krep18 = GHC.Internal.Types.KindRepFun $krep1 $krep17 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Leaf3 = "'Leaf"# +$tc'Leaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Leaf1 = "'Leaf"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Leaf2 = GHC.Internal.Types.TrNameS T26615a.$tc'Leaf3 +$tc'Leaf2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Leaf2 = GHC.Internal.Types.TrNameS $tc'Leaf1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Leaf [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Leaf = GHC.Internal.Types.TyCon 5773656560257991946#Word64 17028074687139582545#Word64 T26615a.$trModule - T26615a.$tc'Leaf2 + $tc'Leaf2 2# - T26615a.$tc'Leaf1 + $krep18 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep15 :: GHC.Internal.Types.KindRep +$krep19 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep15 = GHC.Internal.Types.KindRepFun $krep13 T26615a.$tc'Empty1 +$krep19 = GHC.Internal.Types.KindRepFun $krep15 $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep20 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Collision1 - = GHC.Internal.Types.KindRepFun $krep1 $krep15 +$krep20 = GHC.Internal.Types.KindRepFun $krep1 $krep19 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 40 0}] -T26615a.$tc'Collision3 = "'Collision"# +$tc'Collision1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Collision1 = "'Collision"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Collision2 - = GHC.Internal.Types.TrNameS T26615a.$tc'Collision3 +$tc'Collision2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Collision2 = GHC.Internal.Types.TrNameS $tc'Collision1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Collision [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Collision = GHC.Internal.Types.TyCon 18175105753528304021#Word64 13986842878006680511#Word64 T26615a.$trModule - T26615a.$tc'Collision2 + $tc'Collision2 2# - T26615a.$tc'Collision1 + $krep20 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep16 :: [GHC.Internal.Types.KindRep] +$krep21 :: [GHC.Internal.Types.KindRep] [GblId, Unf=OtherCon []] -$krep16 +$krep21 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep - T26615a.$tc'Empty1 + $krep16 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep17 :: GHC.Internal.Types.KindRep +$krep22 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep17 - = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep16 +$krep22 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep21 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep23 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Full1 - = GHC.Internal.Types.KindRepFun $krep17 T26615a.$tc'Empty1 +$krep23 = GHC.Internal.Types.KindRepFun $krep22 $krep16 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Full3 = "'Full"# +$tc'Full1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Full1 = "'Full"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Full2 = GHC.Internal.Types.TrNameS T26615a.$tc'Full3 +$tc'Full2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Full2 = GHC.Internal.Types.TrNameS $tc'Full1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Full [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Full = GHC.Internal.Types.TyCon 12008762105994325570#Word64 13514145886440831186#Word64 T26615a.$trModule - T26615a.$tc'Full2 + $tc'Full2 2# - T26615a.$tc'Full1 + $krep23 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed1 [InlPrag=[~]] - :: GHC.Internal.Types.KindRep +$krep24 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'BitmapIndexed1 - = GHC.Internal.Types.KindRepFun $krep1 T26615a.$tc'Full1 +$krep24 = GHC.Internal.Types.KindRepFun $krep1 $krep23 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 50 0}] -T26615a.$tc'BitmapIndexed3 = "'BitmapIndexed"# +$tc'BitmapIndexed1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'BitmapIndexed1 = "'BitmapIndexed"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'BitmapIndexed2 - = GHC.Internal.Types.TrNameS T26615a.$tc'BitmapIndexed3 +$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'BitmapIndexed2 = GHC.Internal.Types.TrNameS $tc'BitmapIndexed1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'BitmapIndexed [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'BitmapIndexed = GHC.Internal.Types.TyCon 15226751910432948177#Word64 957331387129868915#Word64 T26615a.$trModule - T26615a.$tc'BitmapIndexed2 + $tc'BitmapIndexed2 2# - T26615a.$tc'BitmapIndexed1 + $krep24 -- RHS size: {terms: 98, types: 109, coercions: 0, joins: 3/4} T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] @@ -538,7 +425,7 @@ T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] Str=<LP(SC(S,C(1,L)),A)><L><1L><L><L>, Unf=Unf{Src=StableUser, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [30 0 20 0 0] 406 10 + Guidance=IF_ARGS [90 0 20 0 0] 406 10 Tmpl= \ (@k) (@a) (@b) @@ -586,7 +473,7 @@ T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary1 [Occ=Once1!] :: Array (Leaf k b)) (i1 [Occ=Once1!] :: Int) @@ -654,24 +541,23 @@ T26615a.$wdisjointCollisions $s$wfoldr_ [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Bool -> Int# -> Int# -> SmallArray# (Leaf k a) -> Bool + :: SmallArray# (Leaf k a) -> Int# -> Int# -> Bool -> Bool [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><L><L><L>, Unf=OtherCon []] - $s$wfoldr_ (sc :: Bool) + $s$wfoldr_ (sc :: SmallArray# (Leaf k a)) (sc1 :: Int#) (sc2 :: Int#) - (sc3 :: SmallArray# (Leaf k a)) - = case >=# sc1 sc2 of { + (sc3 :: Bool) + = case >=# sc2 sc1 of { __DEFAULT -> - case indexSmallArray# @Lifted @(Leaf k a) sc3 sc1 of - { (# ipv1 #) -> + case indexSmallArray# @Lifted @(Leaf k a) sc sc2 of { (# ipv1 #) -> case ipv1 of { L kA ds1 -> join { $j :: Bool [LclId[JoinId(0)(Nothing)]] - $j = jump $s$wfoldr_ sc (+# sc1 1#) sc2 sc3 } in + $j = jump $s$wfoldr_ sc sc1 (+# sc2 1#) sc3 } in joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, @@ -703,13 +589,13 @@ T26615a.$wdisjointCollisions jump $wlookupInArrayCont_ kA ww2 0# lvl2 } }; - 1# -> sc + 1# -> sc3 }; } in jump $s$wfoldr_ - GHC.Internal.Types.True - 0# - (sizeofSmallArray# @Lifted @(Leaf k a) ipv) ipv + (sizeofSmallArray# @Lifted @(Leaf k a) ipv) + 0# + GHC.Internal.Types.True } } @@ -728,28 +614,28 @@ Rec { -- RHS size: {terms: 133, types: 126, coercions: 0, joins: 1/2} T26615a.disjointSubtrees_$s$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] - :: forall b a k. - Word# - -> SmallArray# (Leaf k a) -> Int# -> Eq k => HashMap k b -> Bool + :: forall k a b. + Eq k => + Int# -> Word# -> SmallArray# (Leaf k a) -> HashMap k b -> Bool [GblId[StrictWorker([~, ~, ~, ~, !])], Arity=5, - Str=<L><L><L><LP(SC(S,C(1,L)),A)><1L>, + Str=<LP(SC(S,C(1,L)),A)><L><L><L><1L>, Unf=OtherCon []] T26615a.disjointSubtrees_$s$wdisjointSubtrees - = \ (@b) + = \ (@k) (@a) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) - (sc2 :: Int#) - (sc3 :: Eq k) + (@b) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k a)) (_b :: HashMap k b) -> case _b of { Empty -> GHC.Internal.Types.True; Leaf bx ds -> case ds of { L kB ds1 -> case kB of k0 { __DEFAULT -> - case eqWord# bx sc of { + case eqWord# bx sc2 of { __DEFAULT -> GHC.Internal.Types.True; 1# -> joinrec { @@ -770,7 +656,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees __DEFAULT -> case indexSmallArray# @Lifted @(Leaf k a) ww ww1 of { (# ipv #) -> case ipv of { L kx v -> - case == @k sc3 k2 kx of { + case == @k sc k2 kx of { False -> jump $wlookupInArrayCont_ k2 ww (+# ww1 1#) ww2; True -> GHC.Internal.Types.False } @@ -780,19 +666,19 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - k0 sc1 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc1) + k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3) } } }; Collision bx bx1 -> T26615a.$wdisjointCollisions - @k @a @b sc3 sc (T26615a.Array @(Leaf k a) sc1) bx bx1; + @k @a @b sc sc2 (T26615a.Array @(Leaf k a) sc3) bx bx1; BitmapIndexed bx bx1 -> let { m :: Word# [LclId] m = uncheckedShiftL# - 1## (word2Int# (and# (uncheckedShiftRL# sc sc2) 31##)) } in + 1## (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) } in case and# m bx of { __DEFAULT -> case indexSmallArray# @@ -803,7 +689,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 (+# sc2 5#) sc3 ipv + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv }; 0## -> GHC.Internal.Types.True }; @@ -812,17 +698,17 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees @Lifted @(HashMap k b) bx - (word2Int# (and# (uncheckedShiftRL# sc sc2) 31##)) + (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 (+# sc2 5#) sc3 ipv + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv } } end Rec } Rec { --- RHS size: {terms: 705, types: 732, coercions: 18, joins: 13/23} +-- RHS size: {terms: 705, types: 748, coercions: 18, joins: 13/23} T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] :: forall k a b. Eq k => Int# -> HashMap k a -> HashMap k b -> Bool [GblId[StrictWorker([~, ~, !])], @@ -841,7 +727,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] join { fail [Occ=Once3!T[1]] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of wild [Occ=Once1] { __DEFAULT -> case GHC.Internal.Control.Exception.Base.patError @@ -860,7 +746,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupCont_ _ [Occ=Dead] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) (ds4 [Occ=Once1!] :: Word) (ds5 [Occ=Once1] :: k) (ds6 [Occ=Once1!] :: Int) @@ -896,7 +782,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary [Occ=Once1!] :: Array (Leaf k a)) (i [Occ=Once1!] :: Int) @@ -1000,7 +886,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupCont_ _ [Occ=Dead] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) (ds3 [Occ=Once1!] :: Word) (ds4 [Occ=Once1] :: k) (ds5 [Occ=Once1!] :: Int) @@ -1034,7 +920,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary [Occ=Once1!] :: Array (Leaf k b)) (i [Occ=Once1!] :: Int) @@ -1179,23 +1065,23 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -1324,51 +1210,49 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] }; } in jump go (GHC.Internal.Types.W# (and# 4294967295## bx1)); Full bx1 -> + joinrec { + go [Occ=LoopBreakerT[1]] :: Int -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + go (i :: Int) + = case GHC.Internal.Classes.ltInt i (GHC.Internal.Types.I# 0#) of { + False -> + case i of { I# i# -> + case indexSmallArray# @Lifted @(HashMap k a) bx i# of + { (# ipv [Occ=Once1] #) -> + case indexSmallArray# @Lifted @(HashMap k b) bx1 i# of + { (# ipv1 [Occ=Once1] #) -> + case T26615a.$wdisjointSubtrees @k @a @b $dEq (+# ww 5#) ipv ipv1 + of { + False -> GHC.Internal.Types.False; + True -> jump go (GHC.Internal.Types.I# (-# i# 1#)) + } + } + } + }; + True -> GHC.Internal.Types.True + }; } in case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { - __DEFAULT -> - joinrec { - go [Occ=LoopBreakerT[1]] :: Int -> Bool - [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] - go (i :: Int) - = case GHC.Internal.Classes.ltInt i (GHC.Internal.Types.I# 0#) of { - False -> - case i of { I# i# -> - case indexSmallArray# @Lifted @(HashMap k a) bx i# of - { (# ipv [Occ=Once1] #) -> - case indexSmallArray# @Lifted @(HashMap k b) bx1 i# of - { (# ipv1 [Occ=Once1] #) -> - case T26615a.$wdisjointSubtrees - @k @a @b $dEq (+# ww 5#) ipv ipv1 - of { - False -> GHC.Internal.Types.False; - True -> jump go (GHC.Internal.Types.I# (-# i# 1#)) - } - } - } - }; - True -> GHC.Internal.Types.True - }; } in - jump go (GHC.Internal.Types.I# 31#); + __DEFAULT -> jump go (GHC.Internal.Types.I# 31#); 1# -> GHC.Internal.Types.False } } @@ -1385,7 +1269,7 @@ T26615a.$wdisjointSubtrees join { fail [Dmd=MC(1,L)] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of { __DEFAULT -> case lvl1 of {}; Empty -> GHC.Internal.Types.True; @@ -1508,7 +1392,7 @@ T26615a.$wdisjointSubtrees }; Collision bx bx1 -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @a @b @k bx bx1 ww $dEq ds + @k @b @a $dEq ww bx bx1 ds } } in case ds of { Empty -> GHC.Internal.Types.True; @@ -1661,7 +1545,7 @@ T26615a.$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k bx bx1 (+# ww 5#) $dEq ipv + @k @a @b $dEq (+# ww 5#) bx bx1 ipv }; 0## -> GHC.Internal.Types.True }; @@ -1674,7 +1558,7 @@ T26615a.$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k bx bx1 (+# ww 5#) $dEq ipv + @k @a @b $dEq (+# ww 5#) bx bx1 ipv } }; BitmapIndexed bx bx1 -> @@ -1686,21 +1570,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) - :: SmallArray# (HashMap k a) ~R# GHC.Internal.Types.ZonkAny 0)) + :: SmallArray# (HashMap k a) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) - :: SmallArray# (HashMap k b) ~R# GHC.Internal.Types.ZonkAny 1)) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> let { @@ -1829,21 +1715,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) - :: SmallArray# (HashMap k a) ~R# GHC.Internal.Types.ZonkAny 0)) + :: SmallArray# (HashMap k a) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) - :: SmallArray# (HashMap k b) ~R# GHC.Internal.Types.ZonkAny 1)) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> let { @@ -1910,88 +1798,72 @@ disjointSubtrees ------ Local rules for imported ids -------- "SC:$wdisjointSubtrees1" [1] - forall (@a) + forall (@k) (@b) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) + (@a) + (sc :: Eq k) + (sc1 :: Int#) (sc2 :: Word#) (sc3 :: SmallArray# (Leaf k b)) - (sc4 :: Int#) - (sc5 :: Eq k). + (sc4 :: Word#) + (sc5 :: SmallArray# (Leaf k a)). T26615a.$wdisjointSubtrees @k @b @a - sc5 - sc4 + sc + sc1 (T26615a.Collision @k @b sc2 sc3) - (T26615a.Collision @k @a sc sc1) + (T26615a.Collision @k @a sc4 sc5) = T26615a.$wdisjointCollisions - @k @b @a sc5 sc2 (T26615a.Array @(Leaf k b) sc3) sc sc1 + @k @b @a sc sc2 (T26615a.Array @(Leaf k b) sc3) sc4 sc5 "SC:$wdisjointSubtrees0" [1] - forall (@b) + forall (@k) (@a) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) - (sc2 :: Int#) - (sc3 :: Eq k). + (@b) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k a)). T26615a.$wdisjointSubtrees @k @a @b - sc3 - sc2 - (T26615a.Collision @k @a sc sc1) + sc + sc1 + (T26615a.Collision @k @a sc2 sc3) = T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 sc2 sc3 + @k @a @b sc sc1 sc2 sc3 [2 of 2] Compiling T26615 ( T26615.hs, T26615.o ) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 614, types: 666, coercions: 18, joins: 8/14} + = {terms: 614, types: 682, coercions: 18, joins: 8/14} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule2 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615.$trModule2 = "T26615"# +$trModule1 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "T26615"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule1 = GHC.Internal.Types.TrNameS T26615.$trModule2 +$trModule2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule4 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615.$trModule4 = "main"# +$trModule3 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule3 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule3 = GHC.Internal.Types.TrNameS T26615.$trModule4 +$trModule4 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule :: GHC.Internal.Types.Module -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule - = GHC.Internal.Types.Module T26615.$trModule3 T26615.$trModule1 +T26615.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module +[GblId, Unf=OtherCon []] +T26615.$trModule = GHC.Internal.Types.Module $trModule4 $trModule2 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} lvl :: GHC.Internal.Prim.Addr# @@ -2128,7 +2000,7 @@ $wpoly_lookupCont_ end Rec } Rec { --- RHS size: {terms: 448, types: 507, coercions: 18, joins: 8/13} +-- RHS size: {terms: 448, types: 523, coercions: 18, joins: 8/13} T26615.$s$wdisjointSubtrees [InlPrag=[~], Occ=LoopBreaker] :: forall a b. GHC.Internal.Prim.Int# @@ -2143,7 +2015,7 @@ T26615.$s$wdisjointSubtrees join { fail [Dmd=MC(1,L)] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of wild { __DEFAULT -> case lvl1 of {}; T26615a.Empty -> GHC.Internal.Types.True; @@ -2190,30 +2062,28 @@ T26615.$s$wdisjointSubtrees $s$wfoldr_ [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Bool - -> GHC.Internal.Prim.Int# - -> GHC.Internal.Prim.Int# - -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a) - -> Bool + :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a) + -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> Bool -> Bool [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><L><L><L>, Unf=OtherCon []] - $s$wfoldr_ (sc :: Bool) + $s$wfoldr_ (sc + :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)) (sc1 :: GHC.Internal.Prim.Int#) (sc2 :: GHC.Internal.Prim.Int#) - (sc3 :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)) - = case GHC.Internal.Prim.>=# sc1 sc2 of { + (sc3 :: Bool) + = case GHC.Internal.Prim.>=# sc2 sc1 of { __DEFAULT -> case GHC.Internal.Prim.indexSmallArray# - @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) sc3 sc1 + @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) sc sc2 of { (# ipv1 #) -> case ipv1 of { T26615a.L kA ds2 -> join { $j :: Bool [LclId[JoinId(0)(Nothing)]] - $j = jump $s$wfoldr_ sc (GHC.Internal.Prim.+# sc1 1#) sc2 sc3 } in + $j = jump $s$wfoldr_ sc sc1 (GHC.Internal.Prim.+# sc2 1#) sc3 } in joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, @@ -2258,14 +2128,14 @@ T26615.$s$wdisjointSubtrees jump $wlookupInArrayCont_ kA bx3 0# lvl2 } }; - 1# -> sc + 1# -> sc3 }; } in jump $s$wfoldr_ - GHC.Internal.Types.True - 0# + bx1 (GHC.Internal.Prim.sizeofSmallArray# @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) bx1) - bx1 + 0# + GHC.Internal.Types.True }; T26615a.BitmapIndexed bx2 bx3 -> let { @@ -2317,23 +2187,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -2495,23 +2365,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -2564,7 +2434,7 @@ f = \ (@a) ------ Local rules for imported ids -------- "SPEC/T26615 $wdisjointSubtrees @String @_ @_" [2] - forall (@a) (@b) ($dEq :: Eq String). + forall (@a) (@b) ($dEq [Occ=Dead] :: Eq String). T26615a.$wdisjointSubtrees @String @a @b $dEq = T26615.$s$wdisjointSubtrees @a @b ===================================== testsuite/tests/typecheck/should_fail/T13292.stderr ===================================== @@ -14,15 +14,15 @@ T13292a.hs:4:12: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] In an equation for ‘someFunc’: someFunc = return () T13292.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘GHC.Internal.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m00’ with ‘IO’ Expected: IO () - Actual: GHC.Internal.Types.ZonkAny 0 () + Actual: m00 () • When checking the type of the IO action ‘main’ T13292.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘GHC.Internal.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m00’ with ‘IO’ Expected: IO () - Actual: GHC.Internal.Types.ZonkAny 0 () + Actual: m00 () • In the expression: main When checking the type of the IO action ‘main’ ===================================== testsuite/tests/typecheck/should_fail/T27390-explicit-kinds.stderr ===================================== @@ -0,0 +1,28 @@ +T27390a.hs:4:12: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] + • Ambiguous type variable ‘m0’ arising from a use of ‘return’ + prevents the constraint ‘(Monad m0)’ from being solved. + Relevant bindings include + someFunc :: m0 () (bound at T27390a.hs:4:1) + Probable fix: use a type annotation to specify what ‘m0’ should be. + Potentially matching instances: + instance Monad IO -- Defined in ‘GHC.Internal.Base’ + instance Monad Maybe -- Defined in ‘GHC.Internal.Base’ + ...plus six others + ...plus one instance involving out-of-scope types + (use -fprint-potential-instances to see them all) + • In the expression: return () + In an equation for ‘someFunc’: someFunc = return () + +T27390.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘m00 :: Type -> Type’ with ‘IO’ + Expected: IO () + Actual: (m00 :: Type -> Type) () + • When checking the type of the IO action ‘main’ + +T27390.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘m00 :: Type -> Type’ with ‘IO’ + Expected: IO () + Actual: (m00 :: Type -> Type) () + • In the expression: main + When checking the type of the IO action ‘main’ + ===================================== testsuite/tests/typecheck/should_fail/T27390.hs ===================================== @@ -0,0 +1,6 @@ +{-# language NoStarIsType #-} +module Main where + +import T27390a + +main = someFunc ===================================== testsuite/tests/typecheck/should_fail/T27390.stderr ===================================== @@ -0,0 +1,28 @@ +T27390a.hs:4:12: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] + • Ambiguous type variable ‘m0’ arising from a use of ‘return’ + prevents the constraint ‘(Monad m0)’ from being solved. + Relevant bindings include + someFunc :: m0 () (bound at T27390a.hs:4:1) + Probable fix: use a type annotation to specify what ‘m0’ should be. + Potentially matching instances: + instance Monad IO -- Defined in ‘GHC.Internal.Base’ + instance Monad Maybe -- Defined in ‘GHC.Internal.Base’ + ...plus six others + ...plus one instance involving out-of-scope types + (use -fprint-potential-instances to see them all) + • In the expression: return () + In an equation for ‘someFunc’: someFunc = return () + +T27390.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘m00’ with ‘IO’ + Expected: IO () + Actual: m00 () + • When checking the type of the IO action ‘main’ + +T27390.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘m00’ with ‘IO’ + Expected: IO () + Actual: m00 () + • In the expression: main + When checking the type of the IO action ‘main’ + ===================================== testsuite/tests/typecheck/should_fail/T27390a.hs ===================================== @@ -0,0 +1,4 @@ +module T27390a where + + +someFunc = return () ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -448,6 +448,8 @@ test('T13075', normal, compile_fail, ['']) test('LevPolyBounded', normal, compile_fail, ['']) test('T13487', normal, compile, ['']) test('T13292', normal, multimod_compile, ['T13292', '-v0 -fdefer-type-errors']) +test('T27390', normal, multimod_compile, ['T27390', '-v0 -fdefer-type-errors']) +test('T27390-explicit-kinds', [extra_files(['T27390.hs', 'T27390a.hs'])], multimod_compile, ['T27390', '-v0 -fdefer-type-errors -fprint-explicit-kinds']) test('T13300', normal, compile_fail, ['']) test('T13311', normal, compile_fail, ['']) test('T13446', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d236b88cb18aed3c70f3ed02cd6c646… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d236b88cb18aed3c70f3ed02cd6c646… You're receiving this email because of your account on gitlab.haskell.org.
1 0
0 0
[Git][ghc/ghc][wip/davide/windows-dlls] 3 commits: Hadrian: create a ghc-internal .def file per ghc-internal dll
by David Eichmann (@DavidEichmann) 19 Jun '26

19 Jun '26
David Eichmann pushed to branch wip/davide/windows-dlls at Glasgow Haskell Compiler / GHC Commits: 4456f207 by David Eichmann at 2026-06-15T16:18:24+01:00 Hadrian: create a ghc-internal .def file per ghc-internal dll The .def file generated from rts/win32/libHSghc-internal.def.in contains the name of the ghc-internal dll. The correct dll name differs based on if the dll is inplace/final and if using the Dynamic way. Previously, this was not accounted for and inconsistent dlls names where used. That led to failure when loading dlls at runtime in experiments with windows dynamic linking. - - - - - 96c59586 by David Eichmann at 2026-06-15T16:18:45+01:00 Hadrian: fix ghc-internal .def file name - - - - - 3432392f by David Eichmann at 2026-06-19T14:33:31+01:00 WIP place SRT info tables into .rdata on windows - - - - - 6 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Rts.hs - rts/win32/libHSghc-internal.def.in Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -106,6 +106,7 @@ module GHC.Cmm.CLabel ( labelDynamic, isLocalCLabel, mayRedirectTo, + isSRTInfoLabel, isInfoTableLabel, isCmmInfoTableLabel, isConInfoTableLabel, @@ -730,6 +731,27 @@ mkOutOfBoundsAccessLabel = mkForeignLabel (fsLit "rtsOutOfBoundsAccess") mkMemcpyRangeOverlapLabel = mkForeignLabel (fsLit "rtsMemcpyRangeOverlap") ForeignLabelInExternalPackage ForeignLabelIsFunction mkMUT_VAR_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_VAR_CLEAN") CmmInfo +isSRTInfoLabel :: CLabel -> Bool +isSRTInfoLabel clbl = case clbl of + CmmLabel _ _ lbl CmmInfo -> + lbl == fsLit "stg_SRT_1" + || lbl == fsLit "stg_SRT_2" + || lbl == fsLit "stg_SRT_3" + || lbl == fsLit "stg_SRT_4" + || lbl == fsLit "stg_SRT_5" + || lbl == fsLit "stg_SRT_6" + || lbl == fsLit "stg_SRT_7" + || lbl == fsLit "stg_SRT_8" + || lbl == fsLit "stg_SRT_9" + || lbl == fsLit "stg_SRT_10" + || lbl == fsLit "stg_SRT_11" + || lbl == fsLit "stg_SRT_12" + || lbl == fsLit "stg_SRT_13" + || lbl == fsLit "stg_SRT_14" + || lbl == fsLit "stg_SRT_15" + || lbl == fsLit "stg_SRT_16" + _ -> False + mkSRTInfoLabel :: Int -> CLabel mkSRTInfoLabel n = CmmLabel rtsUnitId (NeedExternDecl False) lbl CmmInfo where ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -33,7 +33,7 @@ import GHC.CmmToAsm.Ppr import GHC.Cmm hiding (topInfoTable) import GHC.Cmm.Dataflow.Label import GHC.Cmm.BlockId -import GHC.Cmm.CLabel +import GHC.Cmm.CLabel as CLabel import GHC.Cmm.InitFini import GHC.Cmm.DebugBlock (pprUnwindTable) @@ -96,10 +96,16 @@ pprNatCmmDecl config proc@(CmmProc top_info entry_lbl _ (ListGraph blocks)) = ) | otherwise = (empty,empty) + section = if platformOS platform == OSMinGW32 + && externallyVisibleCLabel proc_lbl + && isSRTInfoLabel proc_lbl + then ReadOnlyData + else Text + in vcat [ -- section directive. Requires proc_lbl when split-section is enabled to -- use as a subsection name. - pprSectionAlign config (Section Text proc_lbl) + pprSectionAlign config (Section section proc_lbl) -- section alignment. Note that when there is an info table, we align the -- info table and not the entry code! ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -377,7 +377,6 @@ templateRules = do , interpolateSetting "ProjectPatchLevel1" ProjectPatchLevel1 , interpolateSetting "ProjectPatchLevel2" ProjectPatchLevel2 ] - templateRule "rts/win32/libHSghc-internal.def" projectVersion templateRule "docs/index.html" $ packageUnitIds Stage1 templateRule "docs/users_guide/ghc_config.py" $ mconcat [ projectVersion ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -9,6 +9,7 @@ import GHC.Toolchain.Target (Target(tgtArchOs)) import Base import Context +import qualified Data.List as List import Expression hiding (way, package, stage) import Oracles.ModuleFiles import Packages @@ -20,6 +21,7 @@ import Utilities import Data.Time.Clock import Rules.Generate (generatedDependencies) import Oracles.Flag +import Way.Type (wayToUnits) -- * Library 'Rules' @@ -203,13 +205,32 @@ extraObjects context | package context == rts = do target <- interpretInContext context getStagedTarget - builddir <- buildPath context - return [ builddir -/- "libHSghc-internal.dll.a" - | archOS_OS (tgtArchOs target) == OSMinGW32 - , Dynamic `wayUnit` way context ] + if not (archOS_OS (tgtArchOs target) == OSMinGW32 + && Dynamic `wayUnit` way context) + then return [] + else do + -- Find the ghc-internal library file name. Note that the + -- ghc-internal's .dll.a file is placed in the RTS build dir and not + -- the ghc-internal build dir as we only use it when building the + -- RTS and not other libraries. + ghcInternalDllName <- takeFileName <$> pkgLibraryFile Context { + stage = stage context, + way = rtsWayToLibraryWay (way context), + iplace = iplace context, + package = ghcInternal + } + + builddir <- buildPath context + return [ builddir -/- ghcInternalDllName <> ".a"] | otherwise = return [] +-- | The rts is compiled in many different ways, but libraries are only built in +-- (non)Dynamic and (non)Profiled ways. This function converts the rts way into +-- compatible library way. +rtsWayToLibraryWay :: Way -> Way +rtsWayToLibraryWay = wayFromUnits . List.intersect [Dynamic, Profiling] . wayToUnits + -- | Return all the object files to be put into the library we're building for -- the given 'Context'. libraryObjects :: Context -> Action [FilePath] ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -13,11 +13,19 @@ rtsRules = priority 3 $ do -- to be linked into the rts dll. forM_ [Stage1, Stage2, Stage3 ] $ \ stage -> do let buildPath = root -/- buildDir (rtsContext stage) - buildPath -/- "libHSghc-internal.dll.a" %> buildGhcInternalImportLib + buildPath -/- "libHSghc-internal-*.def" %> buildGhcInternalImportDef + buildPath -/- "libHSghc-internal-*.dll.a" %> buildGhcInternalImportLib + +buildGhcInternalImportDef :: FilePath -> Action () +buildGhcInternalImportDef target = do + templateIn <- readFile' "rts/win32/libHSghc-internal.def.in" + let dllName = takeFileName target -<.> "dll" + templateOut = replace "@GhcInternalDll@" dllName templateIn + writeFile' target templateOut buildGhcInternalImportLib :: FilePath -> Action () buildGhcInternalImportLib target = do - let input = "rts/win32/libHSghc-internal.def" + let input = dropExtension (dropExtension target) <.> "def" -- the .def file output = target -- the .dll.a import lib need [input] runBuilder Dlltool ["-d", input, "-l", output] [input] [output] ===================================== rts/win32/libHSghc-internal.def.in ===================================== @@ -1,4 +1,4 @@ -LIBRARY libHSghc-internal-@ProjectVersionForLib@.0-ghc@ProjectVersion@.dll +LIBRARY @GhcInternalDll@ EXPORTS init_ghc_hs_iface View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/edf8e8e3966494dbe74449dc4d7e54… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/edf8e8e3966494dbe74449dc4d7e54… You're receiving this email because of your account on gitlab.haskell.org.
1 0
0 0
[Git][ghc/ghc][wip/davide/windows-dlls] WIP place SRT info tables into .rdata on windows
by David Eichmann (@DavidEichmann) 19 Jun '26

19 Jun '26
David Eichmann pushed to branch wip/davide/windows-dlls at Glasgow Haskell Compiler / GHC Commits: edf8e8e3 by David Eichmann at 2026-06-19T13:59:16+01:00 WIP place SRT info tables into .rdata on windows - - - - - 2 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -106,6 +106,7 @@ module GHC.Cmm.CLabel ( labelDynamic, isLocalCLabel, mayRedirectTo, + isSRTInfoLabel, isInfoTableLabel, isCmmInfoTableLabel, isConInfoTableLabel, @@ -730,6 +731,27 @@ mkOutOfBoundsAccessLabel = mkForeignLabel (fsLit "rtsOutOfBoundsAccess") mkMemcpyRangeOverlapLabel = mkForeignLabel (fsLit "rtsMemcpyRangeOverlap") ForeignLabelInExternalPackage ForeignLabelIsFunction mkMUT_VAR_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_VAR_CLEAN") CmmInfo +isSRTInfoLabel :: CLabel -> Bool +isSRTInfoLabel clbl = case clbl of + CmmLabel _ _ lbl CmmInfo -> + lbl == fsLit "stg_SRT_1" + || lbl == fsLit "stg_SRT_2" + || lbl == fsLit "stg_SRT_3" + || lbl == fsLit "stg_SRT_4" + || lbl == fsLit "stg_SRT_5" + || lbl == fsLit "stg_SRT_6" + || lbl == fsLit "stg_SRT_7" + || lbl == fsLit "stg_SRT_8" + || lbl == fsLit "stg_SRT_9" + || lbl == fsLit "stg_SRT_10" + || lbl == fsLit "stg_SRT_11" + || lbl == fsLit "stg_SRT_12" + || lbl == fsLit "stg_SRT_13" + || lbl == fsLit "stg_SRT_14" + || lbl == fsLit "stg_SRT_15" + || lbl == fsLit "stg_SRT_16" + _ -> False + mkSRTInfoLabel :: Int -> CLabel mkSRTInfoLabel n = CmmLabel rtsUnitId (NeedExternDecl False) lbl CmmInfo where ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -33,7 +33,7 @@ import GHC.CmmToAsm.Ppr import GHC.Cmm hiding (topInfoTable) import GHC.Cmm.Dataflow.Label import GHC.Cmm.BlockId -import GHC.Cmm.CLabel +import GHC.Cmm.CLabel as CLabel import GHC.Cmm.InitFini import GHC.Cmm.DebugBlock (pprUnwindTable) @@ -96,10 +96,16 @@ pprNatCmmDecl config proc@(CmmProc top_info entry_lbl _ (ListGraph blocks)) = ) | otherwise = (empty,empty) + section = if platformOS platform == OSMinGW32 + && externallyVisibleCLabel proc_lbl + && isSRTInfoLabel proc_lbl + then ReadOnlyData + else Text + in vcat [ -- section directive. Requires proc_lbl when split-section is enabled to -- use as a subsection name. - pprSectionAlign config (Section Text proc_lbl) + pprSectionAlign config (Section section proc_lbl) -- section alignment. Note that when there is an info table, we align the -- info table and not the entry code! View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/edf8e8e3966494dbe74449dc4d7e54d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/edf8e8e3966494dbe74449dc4d7e54d… You're receiving this email because of your account on gitlab.haskell.org.
1 0
0 0
[Git][ghc/ghc][wip/mangoiv/unused-type] compiler: rename ZonkAny to UnusedType and add pretty printing logic
by Magnus (@MangoIV) 19 Jun '26

19 Jun '26
Magnus pushed to branch wip/mangoiv/unused-type at Glasgow Haskell Compiler / GHC Commits: fcfef0e4 by mangoiv at 2026-06-19T13:57:38+02:00 compiler: rename ZonkAny to UnusedType and add pretty printing logic ZonkAny is a hard to understand name for users who do not know how the compiler works internally. Additionally, it is confusing that ZonkAny, while being a concrete type *represents* a meta variable, espeically in the compiler output. This patch changes the name of ZonkAny to UnusedType which is closer to its intended semantics and adds special pretty printing logic to display this type in the same fashion the compiler displays meta variables in other places, whenever they leak from the implementation to the user. Fixes #27390 - - - - - 17 changed files: - + changelog.d/unused-type - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - libraries/ghc-internal/src/GHC/Internal/Types.hs - testsuite/tests/perf/compiler/T11068.stdout - testsuite/tests/pmcheck/should_compile/T12957.stderr - testsuite/tests/profiling/should_run/staticcallstack002.stdout - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T13156.stdout - testsuite/tests/simplCore/should_compile/T26615.stderr - testsuite/tests/typecheck/should_fail/T13292.stderr Changes: ===================================== changelog.d/unused-type ===================================== @@ -0,0 +1,12 @@ +section: compiler +synopsis: Rename ZonkAny to UnusedType and add pretty printing logic for it. +issues: #27390 +mrs: !16212 + +description: { + After unification, GHC fills in unconstrained type variables such as ``alpha`` in + ``(length :: [alpha] -> Int) ([] :: List alpha) :: Int`` with a fixed type. + This type was, confusingly to the user, called ``ZonkAny``. + This type is now renamed ``UnusedType``, with special pretty-printing logic to make + it display like an ordinary metavariable. +} ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -1904,8 +1904,8 @@ unsatisfiableClassNameKey = mkPreludeTyConUnique 170 anyTyConKey :: Unique anyTyConKey = mkPreludeTyConUnique 171 -zonkAnyTyConKey :: Unique -zonkAnyTyConKey = mkPreludeTyConUnique 172 +unusedTypeTyConKey :: Unique +unusedTypeTyConKey = mkPreludeTyConUnique 172 -- Custom user type-errors errorMessageTypeErrorFamKey :: Unique ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -93,7 +93,7 @@ module GHC.Builtin.Types ( cTupleSelId, cTupleSelIdName, -- * Any - anyTyCon, anyTy, anyTypeOfKind, zonkAnyTyCon, + anyTyCon, anyTy, anyTypeOfKind, unusedTypeTyCon, -- * Recovery TyCon makeRecoveryTyCon, @@ -300,7 +300,7 @@ wiredInTyCons :: [TyCon] wiredInTyCons = map (dataConTyCon . snd) boxingDataCons ++ [ anyTyCon - , zonkAnyTyCon + , unusedTypeTyCon , boolTyCon , charTyCon , stringTyCon @@ -412,13 +412,13 @@ doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") {- Note [Any types] ~~~~~~~~~~~~~~~~ -The type constructors `Any` and `ZonkAny` are closed type families declared thus: +The type constructors `Any` and `UnusedType` are closed type families declared thus: - type family Any :: forall k. k where { } - type family ZonkAny :: forall k. Nat -> k where { } + type family Any :: forall k. k where { } + type family UnusedType :: forall k. Nat -> Symbol -> k where { } They are used when we want a type of a particular kind, but we don't really care -what that type is. The leading example is this: `ZonkAny` is used to instantiate +what that type is. The leading example is this: `UnusedType` is used to instantiate un-constrained type variables after type checking. For example, consider the term (length [] :: Int), where @@ -431,26 +431,26 @@ The typechecker will end up with length @alpha ([] @alpha) where `alpha` is an un-constrained unification variable. The "zonking" process zaps -that unconstrained `alpha` to an arbitrary type (ZonkAny @Type 3), where the `3` is -arbitrary (see wrinkle (Any5) below). This is done in `GHC.Tc.Zonk.Type.commitFlexi`. -So we end up with +that unconstrained `alpha` to an arbitrary type (UnusedType @Type 3 "a"), where the `3` is +arbitrary (see wrinkle (Any5) below) and "a" is the name string of the meta variable. +This is done in `GHC.Tc.Zonk.Type.commitFlexi`. So we end up with - length @(ZonkAny @Type 3) ([] @(ZonkAny @Type 3)) + length @(UnusedType @Type 3 "a") ([] @(UnusedType @Type 3 "a")) -`Any` and `ZonkAny` differ only in the presence of the `Nat` argument; see -wrinkle (Any4). +`Any` and `UnusedType` differ only in the presence of the `Nat` and the `Symbol` arguments; +see wrinkle (Any4). Wrinkles: -(Any1) `Any` and `ZonkAny` are kind polymorphic since in some program we may - need to use `ZonkAny` to fill in a type variable of some kind other than * +(Any1) `Any` and `UnusedType` are kind polymorphic since in some program we may + need to use `UnusedType` to fill in a type variable of some kind other than * (see #959 for examples). (Any2) They are /closed/ type families, with no instances. For example, suppose that with alpha :: '(k1, k2) we add a given coercion g :: alpha ~ (Fst alpha, Snd alpha) - and we zonked alpha = ZonkAny @(k1,k2) n. Then, if `ZonkAny` was a /data/ type, - we'd get inconsistency because we'd have a Given equality with `ZonkAny` on one + and we zonked alpha = UnusedType @(k1,k2) n. Then, if `UnusedType` was a /data/ type, + we'd get inconsistency because we'd have a Given equality with `UnusedType` on one side and '(,) on the other. See also #9097 and #9636. See #25244 for a suggestion that we instead use an /open/ type family for which @@ -460,7 +460,7 @@ Wrinkles: the code generator, because the code gen may /enter/ a data value but never enters a function value. -(Any4) `ZonkAny` takes a `Nat` argument so that we can readily make up /distinct/ +(Any4) `UnusedType` takes a `Nat` argument so that we can readily make up /distinct/ types (#24817). Consider data SBool a where { STrue :: SBool True; SFalse :: SBool False } @@ -475,44 +475,57 @@ Wrinkles: Now, what are `alpha` and `beta`? If we zonk both of them to the same type `Any @Type`, the pattern-match checker will (wrongly) report that the first branch is inaccessible. So we zonk them to two /different/ types: - alpha := ZonkAny @Type 4 and beta := ZonkAny @Type k 5 + alpha := UnusedType @Type 4 "a" and beta := UnusedType @Type k 5 "b" (The actual numbers are arbitrary; they just need to differ.) The unique-name generation comes from field `tcg_zany_n` of `TcGblEnv`; and - `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newZonkAnyType` to + `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newUnusedTypeType` to make up a fresh type. If this example seems unconvincing (e.g. in this case foo must be bottom) see #24817 for larger but more compelling examples. -(Any5) `Any` and `ZonkAny` are wired-in so we can easily refer to it where we - don't have a name environment (e.g. see Rules.matchRule for one example) +(Any9) + `UnusedType` takes a `Symbol` argument, which we use to neatly display zonked unfilled + metavariables without leaking internal type families. -(Any6) `Any` is defined in library module ghc-prim:GHC.Types, and exported so that - it is available to users. For this reason it's treated like any other - wired-in type: - - has a fixed unique, anyTyConKey, - - lives in the global name cache - Currently `ZonkAny` is not available to users; but it could easily be. + See T13292 for an example of this in action. + + `UnusedType` is handled specially in the pretty-printer to avoid confusing compiler output. + For example, `UnusedType 3 "foo" :: Type` is displayed as `foo3` -(Any7) Properties of `Any`: - * When `Any` is instantiated at a lifted type it is inhabited by at least one value, - namely bottom. + That special handling is implemented in GHC.Iface.Type.pprTyTcApp and more specifically + ppr_iface_unused_ty_tycon. - * You can safely coerce any /lifted/ type to `Any` and back with `unsafeCoerce`. + Historical note: in the past, `UnusedType` was called `ZonkAny` (or `Any` before that). + We renamed it to `UnusedType` and added this special treatment in the pretty-printer to avoid + confusing mentions of zonking. - * You can safely coerce any /unlifted/ type to `Any` and back with `unsafeCoerceUnlifted`. +(Any5) `Any` and `UnusedType` are wired-in so we can easily refer to it where we + don't have a name environment (e.g. see Rules.matchRule for one example) + +(Any6) `Any` is defined in library module ghc-internal:GHC.Internal.Types, and exported. + `Any` should be available to users mainly because it is a useful type in userspace + and is thus re-exported from `GHC.Exts`. - * You can coerce /any/ type to `Any` and back with `unsafeCoerce#`, but it's only safe when - the kinds of both the type and `Any` match. + `UnusedType` *could* be exported mainly for documentation in case a user stumbles over it + in debug output of GHC. However, since we don't want to actually have the user use that type + and discoverability of internal modules is (and should be) low, and the fact that we + cannot depend on `Natural` in ghc-internal:GHC.Internal.Types, we do not export it. - * For lifted/unlifted types `unsafeCoerce[Unlifted]` should be preferred over - `unsafeCoerce#` as they prevent accidentally coercing between types with kinds - that don't match. + `Any` is treated like any other wired-in types: + - it has a fixed unique, anyTyConKey + - lives in the global name cache - See examples in ghc-prim:GHC.Types + The key property of 'Any' is that it is safe to coerce a type to 'Any' as long + as the representation is unchanged. That is, it is OK to use 'unsafeCoerce#' to + go from 'ty :: TYPE r to 'Any :: TYPE r' and back, but it is never OK to coerce + between types of different representations (including between lifted and unlifted + boxed representations). + That is, it is useful when e.g. implementing dependent maps or similar typed container + types, storing values of type `Any`. -(Any8) Warning about unused bindings of type `Any` and `ZonkAny` are suppressed, +(Any8) Warning about unused bindings of type `Any` and `UnusedType` are suppressed, following the same rationale of supressing warning about the unit type. For example, consider (#25895): @@ -520,7 +533,7 @@ Wrinkles: do { forever (return ()); blah } where forever :: forall a b. IO a -> IO b - Nothing constrains `b`, so it will be instantiates with `Any` or `ZonkAny`. + Nothing constrains `b`, so it will be instantiates with `Any` or `UnusedType`. But we certainly don't want to complain about a discarded do-binding. The Any tycon used to be quite magic, but we have since been able to @@ -550,22 +563,23 @@ anyTy = mkTyConTy anyTyCon anyTypeOfKind :: Kind -> Type anyTypeOfKind kind = mkTyConApp anyTyCon [kind] -zonkAnyTyConName :: Name -zonkAnyTyConName = - mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "ZonkAny") zonkAnyTyConKey zonkAnyTyCon +unusedTypeTyConName :: Name +unusedTypeTyConName = + mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "UnusedType") unusedTypeTyConKey unusedTypeTyCon -zonkAnyTyCon :: TyCon --- ZonkAnyTyCon :: forall k. Nat -> k +unusedTypeTyCon :: TyCon +-- unusedTypeTyCon :: forall k. Nat -> Symbol -> k -- See Note [Any types] -zonkAnyTyCon = mkFamilyTyCon zonkAnyTyConName kind bndrs 0 res_kind +unusedTypeTyCon = mkFamilyTyCon unusedTypeTyConName kind bndrs 0 res_kind Nothing (ClosedSynFamilyTyCon Nothing) Nothing NotInjective where - [kv,nat_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy] + [kv,nat_kv,sym_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy, typeSymbolKind] bndrs = [ mkNamedTyConBinder Specified kv - , mkAnonTyConBinder nat_kv ] + , mkAnonTyConBinder nat_kv + , mkAnonTyConBinder sym_kv ] res_kind = mkTyVarTy kv kind = mkTyConKind bndrs res_kind ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -1281,11 +1281,11 @@ warnDiscardedDoBindings rhs@(L rhs_loc _) m_ty elt_ty do { fam_inst_envs <- dsGetFamInstEnvs ; let norm_elt_ty = topNormaliseType fam_inst_envs elt_ty supressible_ty = - isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isZonkAnyTy norm_elt_ty + isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isUnusedTypeTy norm_elt_ty -- Warn about discarding things in 'monadic' binding, -- however few types are excluded: -- * Unit type `()` - -- * `ZonkAny` or `Any` type see (Any8) of Note [Any types] + -- * `UnusedType` or `Any` type see (Any8) of Note [Any types] ; if warn_unused && not supressible_ty then diagnosticDs (DsUnusedDoBind rhs elt_ty) else ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -7,7 +7,7 @@ This module defines interface types and binders -} -{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE MultiWayIf, OverloadedRecordDot #-} module GHC.Iface.Type ( IfExtName, IfLclName(..), mkIfLclName, ifLclNameFS, @@ -1740,6 +1740,7 @@ pprTyTcApp ctxt_prec tc tys = sdocOption sdocPrintExplicitKinds $ \print_kinds -> sdocOption sdocPrintTypeAbbreviations $ \print_type_abbreviations -> getPprDebug $ \debug -> + getPprStyle $ \style -> if | ifaceTyConName tc `hasKey` ipClassKey , IA_Arg (IfaceLitTy (IfaceStrTyLit n)) @@ -1791,6 +1792,13 @@ pprTyTcApp ctxt_prec tc tys = | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys) -> doc + -- See Note [Any types], specifically (Any4) and (Any9) + | ifaceTyConName tc `hasKey` unusedTypeTyConKey + , (arg_k : IfaceLitTy (IfaceNumTyLit arg_n) : IfaceLitTy (IfaceStrTyLit arg_nm) : _) <- appArgsIfaceTypes tys + -- if arg_k is a kind with more than 0 arguments, then _ might not be [] here + , userStyle style + -> ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm + | otherwise -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc $ appArgsIfaceTypesForAllTyFlags $ stripInvisArgs (PrintExplicitKinds print_kinds) tys @@ -1802,6 +1810,19 @@ ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case False -> pprPrefixOcc liftedTypeKindTyConName True -> maybeParen ctxt_prec starPrec starLit +-- | user-style printer that pretty-prints an 'UnusedType @k 3 "foo" to foo3. +-- If -fprint-explicit-kinds or -fprint-explicit-runtime-reps are set, instead +-- prints them to (foo3 :: k). +-- See Note [Any types], specifically (Any4) and (Any9) for why this is useful. +ppr_iface_unused_ty_tycon :: PprPrec -> IfaceType -> Integer -> LexicalFastString -> SDoc +ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm + = sdocOption sdocPrintExplicitKinds $ \print_kinds -> + sdocOption sdocPrintExplicitRuntimeReps $ \print_reps -> + if print_kinds || print_reps + then maybeParen ctxt_prec sigPrec $ prettyMeta <+> text "::" <+> pprIfaceType arg_k + else prettyMeta + where prettyMeta = ppr arg_nm <> ppr arg_n + -- | Pretty-print a type-level equality. -- Returns (Just doc) if the argument is a /saturated/ application -- of eqTyCon (~) @@ -2190,7 +2211,8 @@ instance Binary IfaceTyConSort where 0 -> return IfaceNormalTyCon 1 -> IfaceTupleTyCon <$> get bh <*> get bh 2 -> IfaceSumTyCon <$> get bh - _ -> return IfaceEqualityTyCon + 3 -> return IfaceEqualityTyCon + _ -> panic "get IfaceTyConSort" instance Binary IfaceTyConInfo where put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -582,7 +582,7 @@ data TcGblEnv -- ^ Allows us to choose unique DFun names. tcg_zany_n :: TcRef Integer, - -- ^ A source of unique identities for ZonkAny instances + -- ^ A source of unique identities for UnusedType instances -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) tcg_merged :: [(Module, Fingerprint)], ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -154,7 +154,7 @@ module GHC.Tc.Utils.Monad( getCCIndexM, getCCIndexTcM, -- * Zonking - liftZonkM, newZonkAnyType, + liftZonkM, newUnusedType, -- * Complete matches localAndImportedCompleteMatches, getCompleteMatchesTcM, @@ -168,7 +168,7 @@ import GHC.Prelude import GHC.Builtin.Names -import GHC.Builtin.Types( zonkAnyTyCon ) +import GHC.Builtin.Types( unusedTypeTyCon ) import GHC.Tc.Errors.Types import GHC.Tc.Errors.Hole.Plugin ( HoleFitPlugin, HoleFitPluginR (..) ) @@ -197,7 +197,7 @@ import GHC.Core.Coercion ( isReflCo ) import GHC.Core.Multiplicity import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import GHC.Core.Type( mkNumLitTy ) +import GHC.Core.Type( mkNumLitTy, mkStrLitTy ) import GHC.Core.TyCo.Rep( CoercionHole(..) ) import GHC.Core.TyCo.FVs( coVarsOfCo ) import GHC.Core.TyCon ( TyCon ) @@ -2258,17 +2258,17 @@ chooseUniqueOccTc fn = ; writeTcRef dfun_n_var (extendOccSet set occ) ; return occ } -newZonkAnyType :: Kind -> TcM Type --- Return a type (ZonkAny @k n), where n is fresh --- Recall ZonkAny :: forall k. Natural -> k +newUnusedType :: Name -> Kind -> TcM Type +-- Return a type (UnusedType @k n sym), where n is fresh +-- Recall UnusedType :: forall k. Natural -> Symbol -> k -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) -newZonkAnyType kind +newUnusedType name kind = do { env <- getGblEnv ; let zany_n_var = tcg_zany_n env ; i <- readTcRef zany_n_var ; let !i2 = i+1 ; writeTcRef zany_n_var i2 - ; return (mkTyConApp zonkAnyTyCon [kind, mkNumLitTy i]) } + ; return (mkTyConApp unusedTypeTyCon [kind, mkNumLitTy i, mkStrLitTy $ getOccFS name ]) } getConstraintVar :: TcM (TcRef WantedConstraints) getConstraintVar = do { env <- getLclEnv; return (tcl_lie env) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -85,7 +85,7 @@ module GHC.Tc.Utils.TcType ( isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy, isFloatingPrimTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, - isBoolTy, isUnitTy, isAnyTy, isZonkAnyTy, isCharTy, + isBoolTy, isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy, isTauTy, isTauTyCon, tcIsTyVarTy, isPredTy, isSimplePredTy, isTyVarClassPred, checkValidClsArgs, hasTyVarHead, @@ -2057,7 +2057,7 @@ isFloatTy, isDoubleTy, isFloatPrimTy, isDoublePrimTy, isIntegerTy, isNaturalTy, isIntTy, isWordTy, isBoolTy, - isUnitTy, isAnyTy, isZonkAnyTy, isCharTy :: Type -> Bool + isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy :: Type -> Bool isFloatTy = is_tc floatTyConKey isDoubleTy = is_tc doubleTyConKey isFloatPrimTy = is_tc floatPrimTyConKey @@ -2069,7 +2069,7 @@ isWordTy = is_tc wordTyConKey isBoolTy = is_tc boolTyConKey isUnitTy = is_tc unitTyConKey isAnyTy = is_tc anyTyConKey -isZonkAnyTy = is_tc zonkAnyTyConKey +isUnusedTypeTy = is_tc unusedTypeTyConKey isCharTy = is_tc charTyConKey -- | Check whether the type is of the form @Any :: k@, ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedRecordDot #-} {- (c) The University of Glasgow 2006 (c) The AQUA Project, Glasgow University, 1996-1998 @@ -43,7 +44,7 @@ import GHC.Tc.Types.TcRef import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo ) import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) import GHC.Tc.Utils.TcType -import GHC.Tc.Utils.Monad ( newZonkAnyType, setSrcSpanA, liftZonkM, traceTc, addErr ) +import GHC.Tc.Utils.Monad ( newUnusedType, setSrcSpanA, liftZonkM, traceTc, addErr ) import GHC.Tc.Types.Evidence import GHC.Tc.Errors.Types import GHC.Tc.Zonk.Env @@ -470,11 +471,11 @@ commitFlexi DefaultFlexi tv zonked_kind ; return manyDataConTy } | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv = do { addErr $ TcRnZonkerMessage (ZonkerCannotDefaultConcrete origin) - ; newZonkAnyType zonked_kind } + ; newUnusedType tv.varName zonked_kind } | otherwise - = do { traceTc "Defaulting flexi tyvar to ZonkAny:" (pprTyVar tv) + = do { traceTc "Defaulting flexi tyvar to UnusedType:" (pprTyVar tv) -- See Note [Any types] in GHC.Builtin.Types, esp wrinkle (Any4) - ; newZonkAnyType zonked_kind } + ; newUnusedType tv.varName zonked_kind } zonkCoVarOcc :: CoVar -> ZonkTcM Coercion zonkCoVarOcc cv ===================================== libraries/ghc-internal/src/GHC/Internal/Types.hs ===================================== @@ -35,6 +35,7 @@ module GHC.Internal.Types ( SPEC(..), Symbol, Any, + UnusedType, -- * Type equality type (~), type (~~), Coercible, @@ -284,43 +285,33 @@ data Symbol * * ********************************************************************* -} --- | The type constructor @Any :: forall k. k@ is a type to which you can unsafely coerce any type, and back. +-- | The type constructor @Any :: forall k. k@ allows creating an arbitrary type +-- of the given kind. -- --- For @unsafeCoerce@ this means for all lifted types @t@ that --- @unsafeCoerce (unsafeCoerce x :: Any) :: t@ is equivalent to @x@ and safe. +-- It can be used to create a placeholder type when you only have a kind in hand. -- --- The same is true for *all* types when using --- @ --- unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) --- (a :: TYPE r1) (b :: TYPE r2). --- a -> b --- @ --- but /only/ if you instantiate @r1@ and @r2@ to the /same/ runtime representation. --- For example using @(unsafeCoerce# :: forall (a :: TYPE IntRep) (b :: TYPE IntRep). a -> b) x@ --- is fine, but @(unsafeCoerce# :: forall (a :: TYPE IntRep) (b :: TYPE FloatRep). a -> b)@ --- will likely cause seg-faults or worse. --- For this resason, users should always prefer unsafeCoerce over unsafeCoerce# when possible. +-- You can use 'unsafeCoerce#' to unsafely coerce a value from @ty :: k@ to @Any \@k@ +-- and back. As per the documentation of 'unsafeCoerce#', this is only sound if both +-- sides have the __exact same__runtime representation. Some examples: -- --- Here are some more examples: -- @ --- bad_a1 :: Any @(TYPE 'IntRep) --- bad_a1 = unsafeCoerce# True --- --- bad_a2 :: Any @(TYPE ('BoxedRep 'UnliftedRep)) --- bad_a2 = unsafeCoerce# True +-- unsafeCoerce# True :: (Any :: Type) -- OK +-- unsafeCoerce# (1# :: Int#) :: (Any :: TYPE IntRep) -- OK +-- unsafeCoerce# True :: (Any :: Type IntRep) -- INVALID +-- unsafeCoerce True :: (Any :: UnliftedType) -- INVALID +-- unsafeCoerce (ba :: ByteArray#) :: (Any :: Type) -- INVALID -- @ --- Here @bad_a1@ is bad because we started with @True :: (Bool :: Type)@, represented by a boxed heap pointer, --- and coerced it to @a1 :: Any @(TYPE 'IntRep)@, whose representation is a non-pointer integer. --- That's why we had to use `unsafeCoerce#`; it is really unsafe because it can change representations. --- Similarly @bad_a2@ is bad because although both @True@ and @bad_a2@ are represented by a heap pointer, --- @True@ is lifted but @bad_a2@ is not; bugs here may be rather subtle. -- --- If you must use unsafeCoerce# to cast to `Any`, type annotations are recommended --- to make sure that @Any@ has the correct kind. As casting between different runtimereps is --- unsound. For example to cast a @ByteArray#@ to @Any@ you might use: --- @ --- unsafeCoerce# b :: (Any :: TYPE ('BoxedRep 'Unlifted)) --- @ +-- To avoid accidentally unsafe-coercing between different representations, +-- it is recommended to: +-- - use explicit type annotations or type applications at every use-site +-- of 'unsafeCoerce#' +-- - use representation-monomorphic variants such as 'unsafeCoerce' or +-- 'unsafeCoerceUnlifted'. +-- +-- In particular, this also implies it is safe to round-trip unsafe-coercion via 'Any', +-- as long as the kinds line up e.g. @unsafeCoerce (unsafeCoerce (val :: a) :: 'Any') :: a@ +-- is safe in that way. type family Any :: k where { } -- See Note [Any types] in GHC.Builtin.Types. Also, for a bit of history on Any see -- #10886. Note that this must be a *closed* type family: we need to ensure ===================================== testsuite/tests/perf/compiler/T11068.stdout ===================================== @@ -23,137 +23,137 @@ `cast` (GHC.Internal.Generics.N:M1 `cast` (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 ===================================== testsuite/tests/pmcheck/should_compile/T12957.stderr ===================================== @@ -1,7 +1,6 @@ T12957.hs:4:5: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive - In a case alternative: - Patterns of type ‘[GHC.Internal.Types.ZonkAny 0]’ not matched: [] + In a case alternative: Patterns of type ‘[a0]’ not matched: [] T12957.hs:4:16: warning: [GHC-53633] [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant ===================================== testsuite/tests/profiling/should_run/staticcallstack002.stdout ===================================== @@ -1,4 +1,4 @@ -Just (InfoProv {ipName = "sat_s1Rh_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 0", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) -Just (InfoProv {ipName = "sat_s1RB_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 1", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) -Just (InfoProv {ipName = "sat_s1RV_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 2", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) -Just (InfoProv {ipName = "sat_s1Sf_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 3", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) +Just (InfoProv {ipName = "main_sat_t2fs_info", ipDesc = THUNK, ipTyDesc = "UnusedType 0 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) +Just (InfoProv {ipName = "main_sat_t2fJ_info", ipDesc = THUNK, ipTyDesc = "UnusedType 1 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) +Just (InfoProv {ipName = "main_sat_t2g0_info", ipDesc = THUNK, ipTyDesc = "UnusedType 2 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) +Just (InfoProv {ipName = "main_sat_t2gh_info", ipDesc = THUNK, ipTyDesc = "UnusedType 3 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -188,7 +188,7 @@ T13155: T13156: $(RM) -f T13156.hi T13156.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T13156.hs -O -ddump-prep -dsuppress-uniques | grep "case.*Any" + '$(TEST_HC)' $(TEST_HC_OPTS) -c T13156.hs -O -ddump-prep -dsuppress-uniques | grep "case.*UnusedType" # There should be a single 'case r @ GHC.Types.Any' .PHONY: T4138 ===================================== testsuite/tests/simplCore/should_compile/T13156.stdout ===================================== @@ -1,2 +1,2 @@ - case r @(GHC.Internal.Types.ZonkAny 0) of { __DEFAULT -> - case r @(GHC.Internal.Types.ZonkAny 1) of { __DEFAULT -> r @a } + case r @(GHC.Internal.Types.UnusedType 0 "a") of { __DEFAULT -> + case r @(GHC.Internal.Types.UnusedType 1 "a") of { __DEFAULT -> ===================================== testsuite/tests/simplCore/should_compile/T26615.stderr ===================================== @@ -2,7 +2,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 1,209, types: 1,139, coercions: 18, joins: 17/29} + = {terms: 1,209, types: 1,155, coercions: 18, joins: 17/29} -- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} unArray :: forall a. Array a -> SmallArray# a @@ -15,45 +15,29 @@ unArray :: forall a. Array a -> SmallArray# a unArray = \ (@a) (ds :: Array a) -> case ds of { Array ds1 -> ds1 } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule4 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$trModule4 = "main"# +$trModule1 :: Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule3 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule3 = GHC.Internal.Types.TrNameS T26615a.$trModule4 +$trModule2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$trModule2 = "T26615a"# +$trModule3 :: Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "T26615a"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule1 = GHC.Internal.Types.TrNameS T26615a.$trModule2 +$trModule4 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule :: GHC.Internal.Types.Module -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule - = GHC.Internal.Types.Module T26615a.$trModule3 T26615a.$trModule1 +T26615a.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module +[GblId, Unf=OtherCon []] +T26615a.$trModule = GHC.Internal.Types.Module $trModule2 $trModule4 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Internal.Types.KindRep @@ -104,33 +88,24 @@ $krep6 GHC.Internal.Types.$tcSmallArray# $krep5 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$tcLeaf2 = "Leaf"# +$tcLeaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tcLeaf1 = "Leaf"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcLeaf1 = GHC.Internal.Types.TrNameS T26615a.$tcLeaf2 +$tcLeaf2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcLeaf2 = GHC.Internal.Types.TrNameS $tcLeaf1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcLeaf [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcLeaf = GHC.Internal.Types.TyCon 13798714324392902582#Word64 3237499036029031497#Word64 T26615a.$trModule - T26615a.$tcLeaf1 + $tcLeaf2 0# GHC.Internal.Types.krep$*->*->* @@ -160,372 +135,284 @@ $krep10 :: GHC.Internal.Types.KindRep $krep10 = GHC.Internal.Types.KindRepFun $krep2 $krep9 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep11 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'L1 = GHC.Internal.Types.KindRepFun $krep3 $krep10 +$krep11 = GHC.Internal.Types.KindRepFun $krep3 $krep10 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$tc'L3 = "'L"# +$tc'L1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'L1 = "'L"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'L2 = GHC.Internal.Types.TrNameS T26615a.$tc'L3 +$tc'L2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'L2 = GHC.Internal.Types.TrNameS $tc'L1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'L [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'L = GHC.Internal.Types.TyCon 8570419491837374712#Word64 2090006989092642392#Word64 T26615a.$trModule - T26615a.$tc'L2 + $tc'L2 2# - T26615a.$tc'L1 + $krep11 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tcArray2 = "Array"# +$tcArray1 :: Addr# +[GblId, Unf=OtherCon []] +$tcArray1 = "Array"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcArray1 = GHC.Internal.Types.TrNameS T26615a.$tcArray2 +$tcArray2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcArray2 = GHC.Internal.Types.TrNameS $tcArray1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcArray [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcArray = GHC.Internal.Types.TyCon 10495761415291712389#Word64 7580086293698619153#Word64 T26615a.$trModule - T26615a.$tcArray1 + $tcArray2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11 :: GHC.Internal.Types.KindRep +$krep12 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep11 +$krep12 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep4 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep13 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Array1 = GHC.Internal.Types.KindRepFun $krep6 $krep11 +$krep13 = GHC.Internal.Types.KindRepFun $krep6 $krep12 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Array3 = "'Array"# +$tc'Array1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Array1 = "'Array"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Array2 = GHC.Internal.Types.TrNameS T26615a.$tc'Array3 +$tc'Array2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Array2 = GHC.Internal.Types.TrNameS $tc'Array1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Array [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Array = GHC.Internal.Types.TyCon 12424115309881832159#Word64 15542868641947707803#Word64 T26615a.$trModule - T26615a.$tc'Array2 + $tc'Array2 1# - T26615a.$tc'Array1 + $krep13 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep12 :: [GHC.Internal.Types.KindRep] +$krep14 :: [GHC.Internal.Types.KindRep] [GblId, Unf=OtherCon []] -$krep12 +$krep14 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep9 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep13 :: GHC.Internal.Types.KindRep +$krep15 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep13 - = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep12 +$krep15 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep14 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tcHashMap2 = "HashMap"# +$tcHashMap1 :: Addr# +[GblId, Unf=OtherCon []] +$tcHashMap1 = "HashMap"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcHashMap1 - = GHC.Internal.Types.TrNameS T26615a.$tcHashMap2 +$tcHashMap2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcHashMap2 = GHC.Internal.Types.TrNameS $tcHashMap1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcHashMap [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcHashMap = GHC.Internal.Types.TyCon 2021755758654901686#Word64 8209241086311595496#Word64 T26615a.$trModule - T26615a.$tcHashMap1 + $tcHashMap2 0# GHC.Internal.Types.krep$*->*->* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep16 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Empty1 +$krep16 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcHashMap $krep8 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Empty3 = "'Empty"# +$tc'Empty1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Empty1 = "'Empty"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Empty2 = GHC.Internal.Types.TrNameS T26615a.$tc'Empty3 +$tc'Empty2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Empty2 = GHC.Internal.Types.TrNameS $tc'Empty1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Empty [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Empty = GHC.Internal.Types.TyCon 2520556399233147460#Word64 17224648764450205443#Word64 T26615a.$trModule - T26615a.$tc'Empty2 + $tc'Empty2 2# - T26615a.$tc'Empty1 + $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep14 :: GHC.Internal.Types.KindRep +$krep17 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep14 = GHC.Internal.Types.KindRepFun $krep9 T26615a.$tc'Empty1 +$krep17 = GHC.Internal.Types.KindRepFun $krep9 $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep18 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Leaf1 = GHC.Internal.Types.KindRepFun $krep1 $krep14 +$krep18 = GHC.Internal.Types.KindRepFun $krep1 $krep17 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Leaf3 = "'Leaf"# +$tc'Leaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Leaf1 = "'Leaf"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Leaf2 = GHC.Internal.Types.TrNameS T26615a.$tc'Leaf3 +$tc'Leaf2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Leaf2 = GHC.Internal.Types.TrNameS $tc'Leaf1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Leaf [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Leaf = GHC.Internal.Types.TyCon 5773656560257991946#Word64 17028074687139582545#Word64 T26615a.$trModule - T26615a.$tc'Leaf2 + $tc'Leaf2 2# - T26615a.$tc'Leaf1 + $krep18 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep15 :: GHC.Internal.Types.KindRep +$krep19 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep15 = GHC.Internal.Types.KindRepFun $krep13 T26615a.$tc'Empty1 +$krep19 = GHC.Internal.Types.KindRepFun $krep15 $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep20 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Collision1 - = GHC.Internal.Types.KindRepFun $krep1 $krep15 +$krep20 = GHC.Internal.Types.KindRepFun $krep1 $krep19 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 40 0}] -T26615a.$tc'Collision3 = "'Collision"# +$tc'Collision1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Collision1 = "'Collision"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Collision2 - = GHC.Internal.Types.TrNameS T26615a.$tc'Collision3 +$tc'Collision2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Collision2 = GHC.Internal.Types.TrNameS $tc'Collision1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Collision [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Collision = GHC.Internal.Types.TyCon 18175105753528304021#Word64 13986842878006680511#Word64 T26615a.$trModule - T26615a.$tc'Collision2 + $tc'Collision2 2# - T26615a.$tc'Collision1 + $krep20 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep16 :: [GHC.Internal.Types.KindRep] +$krep21 :: [GHC.Internal.Types.KindRep] [GblId, Unf=OtherCon []] -$krep16 +$krep21 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep - T26615a.$tc'Empty1 + $krep16 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep17 :: GHC.Internal.Types.KindRep +$krep22 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep17 - = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep16 +$krep22 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep21 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep23 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Full1 - = GHC.Internal.Types.KindRepFun $krep17 T26615a.$tc'Empty1 +$krep23 = GHC.Internal.Types.KindRepFun $krep22 $krep16 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Full3 = "'Full"# +$tc'Full1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Full1 = "'Full"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Full2 = GHC.Internal.Types.TrNameS T26615a.$tc'Full3 +$tc'Full2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Full2 = GHC.Internal.Types.TrNameS $tc'Full1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Full [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Full = GHC.Internal.Types.TyCon 12008762105994325570#Word64 13514145886440831186#Word64 T26615a.$trModule - T26615a.$tc'Full2 + $tc'Full2 2# - T26615a.$tc'Full1 + $krep23 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed1 [InlPrag=[~]] - :: GHC.Internal.Types.KindRep +$krep24 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'BitmapIndexed1 - = GHC.Internal.Types.KindRepFun $krep1 T26615a.$tc'Full1 +$krep24 = GHC.Internal.Types.KindRepFun $krep1 $krep23 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 50 0}] -T26615a.$tc'BitmapIndexed3 = "'BitmapIndexed"# +$tc'BitmapIndexed1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'BitmapIndexed1 = "'BitmapIndexed"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'BitmapIndexed2 - = GHC.Internal.Types.TrNameS T26615a.$tc'BitmapIndexed3 +$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'BitmapIndexed2 = GHC.Internal.Types.TrNameS $tc'BitmapIndexed1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'BitmapIndexed [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'BitmapIndexed = GHC.Internal.Types.TyCon 15226751910432948177#Word64 957331387129868915#Word64 T26615a.$trModule - T26615a.$tc'BitmapIndexed2 + $tc'BitmapIndexed2 2# - T26615a.$tc'BitmapIndexed1 + $krep24 -- RHS size: {terms: 98, types: 109, coercions: 0, joins: 3/4} T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] @@ -538,7 +425,7 @@ T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] Str=<LP(SC(S,C(1,L)),A)><L><1L><L><L>, Unf=Unf{Src=StableUser, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [30 0 20 0 0] 406 10 + Guidance=IF_ARGS [90 0 20 0 0] 406 10 Tmpl= \ (@k) (@a) (@b) @@ -586,7 +473,7 @@ T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary1 [Occ=Once1!] :: Array (Leaf k b)) (i1 [Occ=Once1!] :: Int) @@ -654,24 +541,23 @@ T26615a.$wdisjointCollisions $s$wfoldr_ [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Bool -> Int# -> Int# -> SmallArray# (Leaf k a) -> Bool + :: SmallArray# (Leaf k a) -> Int# -> Int# -> Bool -> Bool [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><L><L><L>, Unf=OtherCon []] - $s$wfoldr_ (sc :: Bool) + $s$wfoldr_ (sc :: SmallArray# (Leaf k a)) (sc1 :: Int#) (sc2 :: Int#) - (sc3 :: SmallArray# (Leaf k a)) - = case >=# sc1 sc2 of { + (sc3 :: Bool) + = case >=# sc2 sc1 of { __DEFAULT -> - case indexSmallArray# @Lifted @(Leaf k a) sc3 sc1 of - { (# ipv1 #) -> + case indexSmallArray# @Lifted @(Leaf k a) sc sc2 of { (# ipv1 #) -> case ipv1 of { L kA ds1 -> join { $j :: Bool [LclId[JoinId(0)(Nothing)]] - $j = jump $s$wfoldr_ sc (+# sc1 1#) sc2 sc3 } in + $j = jump $s$wfoldr_ sc sc1 (+# sc2 1#) sc3 } in joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, @@ -703,13 +589,13 @@ T26615a.$wdisjointCollisions jump $wlookupInArrayCont_ kA ww2 0# lvl2 } }; - 1# -> sc + 1# -> sc3 }; } in jump $s$wfoldr_ - GHC.Internal.Types.True - 0# - (sizeofSmallArray# @Lifted @(Leaf k a) ipv) ipv + (sizeofSmallArray# @Lifted @(Leaf k a) ipv) + 0# + GHC.Internal.Types.True } } @@ -728,28 +614,28 @@ Rec { -- RHS size: {terms: 133, types: 126, coercions: 0, joins: 1/2} T26615a.disjointSubtrees_$s$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] - :: forall b a k. - Word# - -> SmallArray# (Leaf k a) -> Int# -> Eq k => HashMap k b -> Bool + :: forall k a b. + Eq k => + Int# -> Word# -> SmallArray# (Leaf k a) -> HashMap k b -> Bool [GblId[StrictWorker([~, ~, ~, ~, !])], Arity=5, - Str=<L><L><L><LP(SC(S,C(1,L)),A)><1L>, + Str=<LP(SC(S,C(1,L)),A)><L><L><L><1L>, Unf=OtherCon []] T26615a.disjointSubtrees_$s$wdisjointSubtrees - = \ (@b) + = \ (@k) (@a) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) - (sc2 :: Int#) - (sc3 :: Eq k) + (@b) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k a)) (_b :: HashMap k b) -> case _b of { Empty -> GHC.Internal.Types.True; Leaf bx ds -> case ds of { L kB ds1 -> case kB of k0 { __DEFAULT -> - case eqWord# bx sc of { + case eqWord# bx sc2 of { __DEFAULT -> GHC.Internal.Types.True; 1# -> joinrec { @@ -770,7 +656,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees __DEFAULT -> case indexSmallArray# @Lifted @(Leaf k a) ww ww1 of { (# ipv #) -> case ipv of { L kx v -> - case == @k sc3 k2 kx of { + case == @k sc k2 kx of { False -> jump $wlookupInArrayCont_ k2 ww (+# ww1 1#) ww2; True -> GHC.Internal.Types.False } @@ -780,19 +666,19 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - k0 sc1 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc1) + k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3) } } }; Collision bx bx1 -> T26615a.$wdisjointCollisions - @k @a @b sc3 sc (T26615a.Array @(Leaf k a) sc1) bx bx1; + @k @a @b sc sc2 (T26615a.Array @(Leaf k a) sc3) bx bx1; BitmapIndexed bx bx1 -> let { m :: Word# [LclId] m = uncheckedShiftL# - 1## (word2Int# (and# (uncheckedShiftRL# sc sc2) 31##)) } in + 1## (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) } in case and# m bx of { __DEFAULT -> case indexSmallArray# @@ -803,7 +689,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 (+# sc2 5#) sc3 ipv + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv }; 0## -> GHC.Internal.Types.True }; @@ -812,17 +698,17 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees @Lifted @(HashMap k b) bx - (word2Int# (and# (uncheckedShiftRL# sc sc2) 31##)) + (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 (+# sc2 5#) sc3 ipv + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv } } end Rec } Rec { --- RHS size: {terms: 705, types: 732, coercions: 18, joins: 13/23} +-- RHS size: {terms: 705, types: 748, coercions: 18, joins: 13/23} T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] :: forall k a b. Eq k => Int# -> HashMap k a -> HashMap k b -> Bool [GblId[StrictWorker([~, ~, !])], @@ -841,7 +727,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] join { fail [Occ=Once3!T[1]] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of wild [Occ=Once1] { __DEFAULT -> case GHC.Internal.Control.Exception.Base.patError @@ -860,7 +746,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupCont_ _ [Occ=Dead] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) (ds4 [Occ=Once1!] :: Word) (ds5 [Occ=Once1] :: k) (ds6 [Occ=Once1!] :: Int) @@ -896,7 +782,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary [Occ=Once1!] :: Array (Leaf k a)) (i [Occ=Once1!] :: Int) @@ -1000,7 +886,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupCont_ _ [Occ=Dead] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) (ds3 [Occ=Once1!] :: Word) (ds4 [Occ=Once1] :: k) (ds5 [Occ=Once1!] :: Int) @@ -1034,7 +920,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary [Occ=Once1!] :: Array (Leaf k b)) (i [Occ=Once1!] :: Int) @@ -1179,23 +1065,23 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -1324,51 +1210,49 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] }; } in jump go (GHC.Internal.Types.W# (and# 4294967295## bx1)); Full bx1 -> + joinrec { + go [Occ=LoopBreakerT[1]] :: Int -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + go (i :: Int) + = case GHC.Internal.Classes.ltInt i (GHC.Internal.Types.I# 0#) of { + False -> + case i of { I# i# -> + case indexSmallArray# @Lifted @(HashMap k a) bx i# of + { (# ipv [Occ=Once1] #) -> + case indexSmallArray# @Lifted @(HashMap k b) bx1 i# of + { (# ipv1 [Occ=Once1] #) -> + case T26615a.$wdisjointSubtrees @k @a @b $dEq (+# ww 5#) ipv ipv1 + of { + False -> GHC.Internal.Types.False; + True -> jump go (GHC.Internal.Types.I# (-# i# 1#)) + } + } + } + }; + True -> GHC.Internal.Types.True + }; } in case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { - __DEFAULT -> - joinrec { - go [Occ=LoopBreakerT[1]] :: Int -> Bool - [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] - go (i :: Int) - = case GHC.Internal.Classes.ltInt i (GHC.Internal.Types.I# 0#) of { - False -> - case i of { I# i# -> - case indexSmallArray# @Lifted @(HashMap k a) bx i# of - { (# ipv [Occ=Once1] #) -> - case indexSmallArray# @Lifted @(HashMap k b) bx1 i# of - { (# ipv1 [Occ=Once1] #) -> - case T26615a.$wdisjointSubtrees - @k @a @b $dEq (+# ww 5#) ipv ipv1 - of { - False -> GHC.Internal.Types.False; - True -> jump go (GHC.Internal.Types.I# (-# i# 1#)) - } - } - } - }; - True -> GHC.Internal.Types.True - }; } in - jump go (GHC.Internal.Types.I# 31#); + __DEFAULT -> jump go (GHC.Internal.Types.I# 31#); 1# -> GHC.Internal.Types.False } } @@ -1385,7 +1269,7 @@ T26615a.$wdisjointSubtrees join { fail [Dmd=MC(1,L)] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of { __DEFAULT -> case lvl1 of {}; Empty -> GHC.Internal.Types.True; @@ -1508,7 +1392,7 @@ T26615a.$wdisjointSubtrees }; Collision bx bx1 -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @a @b @k bx bx1 ww $dEq ds + @k @b @a $dEq ww bx bx1 ds } } in case ds of { Empty -> GHC.Internal.Types.True; @@ -1661,7 +1545,7 @@ T26615a.$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k bx bx1 (+# ww 5#) $dEq ipv + @k @a @b $dEq (+# ww 5#) bx bx1 ipv }; 0## -> GHC.Internal.Types.True }; @@ -1674,7 +1558,7 @@ T26615a.$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k bx bx1 (+# ww 5#) $dEq ipv + @k @a @b $dEq (+# ww 5#) bx bx1 ipv } }; BitmapIndexed bx bx1 -> @@ -1686,21 +1570,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) - :: SmallArray# (HashMap k a) ~R# GHC.Internal.Types.ZonkAny 0)) + :: SmallArray# (HashMap k a) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) - :: SmallArray# (HashMap k b) ~R# GHC.Internal.Types.ZonkAny 1)) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> let { @@ -1829,21 +1715,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) - :: SmallArray# (HashMap k a) ~R# GHC.Internal.Types.ZonkAny 0)) + :: SmallArray# (HashMap k a) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) - :: SmallArray# (HashMap k b) ~R# GHC.Internal.Types.ZonkAny 1)) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> let { @@ -1910,88 +1798,72 @@ disjointSubtrees ------ Local rules for imported ids -------- "SC:$wdisjointSubtrees1" [1] - forall (@a) + forall (@k) (@b) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) + (@a) + (sc :: Eq k) + (sc1 :: Int#) (sc2 :: Word#) (sc3 :: SmallArray# (Leaf k b)) - (sc4 :: Int#) - (sc5 :: Eq k). + (sc4 :: Word#) + (sc5 :: SmallArray# (Leaf k a)). T26615a.$wdisjointSubtrees @k @b @a - sc5 - sc4 + sc + sc1 (T26615a.Collision @k @b sc2 sc3) - (T26615a.Collision @k @a sc sc1) + (T26615a.Collision @k @a sc4 sc5) = T26615a.$wdisjointCollisions - @k @b @a sc5 sc2 (T26615a.Array @(Leaf k b) sc3) sc sc1 + @k @b @a sc sc2 (T26615a.Array @(Leaf k b) sc3) sc4 sc5 "SC:$wdisjointSubtrees0" [1] - forall (@b) + forall (@k) (@a) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) - (sc2 :: Int#) - (sc3 :: Eq k). + (@b) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k a)). T26615a.$wdisjointSubtrees @k @a @b - sc3 - sc2 - (T26615a.Collision @k @a sc sc1) + sc + sc1 + (T26615a.Collision @k @a sc2 sc3) = T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 sc2 sc3 + @k @a @b sc sc1 sc2 sc3 [2 of 2] Compiling T26615 ( T26615.hs, T26615.o ) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 614, types: 666, coercions: 18, joins: 8/14} + = {terms: 614, types: 682, coercions: 18, joins: 8/14} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule2 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615.$trModule2 = "T26615"# +$trModule1 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "T26615"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule1 = GHC.Internal.Types.TrNameS T26615.$trModule2 +$trModule2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule4 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615.$trModule4 = "main"# +$trModule3 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule3 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule3 = GHC.Internal.Types.TrNameS T26615.$trModule4 +$trModule4 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule :: GHC.Internal.Types.Module -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule - = GHC.Internal.Types.Module T26615.$trModule3 T26615.$trModule1 +T26615.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module +[GblId, Unf=OtherCon []] +T26615.$trModule = GHC.Internal.Types.Module $trModule4 $trModule2 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} lvl :: GHC.Internal.Prim.Addr# @@ -2128,7 +2000,7 @@ $wpoly_lookupCont_ end Rec } Rec { --- RHS size: {terms: 448, types: 507, coercions: 18, joins: 8/13} +-- RHS size: {terms: 448, types: 523, coercions: 18, joins: 8/13} T26615.$s$wdisjointSubtrees [InlPrag=[~], Occ=LoopBreaker] :: forall a b. GHC.Internal.Prim.Int# @@ -2143,7 +2015,7 @@ T26615.$s$wdisjointSubtrees join { fail [Dmd=MC(1,L)] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of wild { __DEFAULT -> case lvl1 of {}; T26615a.Empty -> GHC.Internal.Types.True; @@ -2190,30 +2062,28 @@ T26615.$s$wdisjointSubtrees $s$wfoldr_ [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Bool - -> GHC.Internal.Prim.Int# - -> GHC.Internal.Prim.Int# - -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a) - -> Bool + :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a) + -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> Bool -> Bool [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><L><L><L>, Unf=OtherCon []] - $s$wfoldr_ (sc :: Bool) + $s$wfoldr_ (sc + :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)) (sc1 :: GHC.Internal.Prim.Int#) (sc2 :: GHC.Internal.Prim.Int#) - (sc3 :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)) - = case GHC.Internal.Prim.>=# sc1 sc2 of { + (sc3 :: Bool) + = case GHC.Internal.Prim.>=# sc2 sc1 of { __DEFAULT -> case GHC.Internal.Prim.indexSmallArray# - @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) sc3 sc1 + @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) sc sc2 of { (# ipv1 #) -> case ipv1 of { T26615a.L kA ds2 -> join { $j :: Bool [LclId[JoinId(0)(Nothing)]] - $j = jump $s$wfoldr_ sc (GHC.Internal.Prim.+# sc1 1#) sc2 sc3 } in + $j = jump $s$wfoldr_ sc sc1 (GHC.Internal.Prim.+# sc2 1#) sc3 } in joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, @@ -2258,14 +2128,14 @@ T26615.$s$wdisjointSubtrees jump $wlookupInArrayCont_ kA bx3 0# lvl2 } }; - 1# -> sc + 1# -> sc3 }; } in jump $s$wfoldr_ - GHC.Internal.Types.True - 0# + bx1 (GHC.Internal.Prim.sizeofSmallArray# @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) bx1) - bx1 + 0# + GHC.Internal.Types.True }; T26615a.BitmapIndexed bx2 bx3 -> let { @@ -2317,23 +2187,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -2495,23 +2365,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -2564,7 +2434,7 @@ f = \ (@a) ------ Local rules for imported ids -------- "SPEC/T26615 $wdisjointSubtrees @String @_ @_" [2] - forall (@a) (@b) ($dEq :: Eq String). + forall (@a) (@b) ($dEq [Occ=Dead] :: Eq String). T26615a.$wdisjointSubtrees @String @a @b $dEq = T26615.$s$wdisjointSubtrees @a @b ===================================== testsuite/tests/typecheck/should_fail/T13292.stderr ===================================== @@ -14,15 +14,15 @@ T13292a.hs:4:12: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] In an equation for ‘someFunc’: someFunc = return () T13292.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘GHC.Internal.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m00’ with ‘IO’ Expected: IO () - Actual: GHC.Internal.Types.ZonkAny 0 () + Actual: m00 • When checking the type of the IO action ‘main’ T13292.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘GHC.Internal.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m00’ with ‘IO’ Expected: IO () - Actual: GHC.Internal.Types.ZonkAny 0 () + Actual: m00 • In the expression: main When checking the type of the IO action ‘main’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fcfef0e4c6a4e8a27b56399196a4693… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fcfef0e4c6a4e8a27b56399196a4693… You're receiving this email because of your account on gitlab.haskell.org.
1 0
0 0
[Git][ghc/ghc][wip/mangoiv/unused-type] compiler: rename ZonkAny to UnusedType and add pretty printing logic
by Magnus (@MangoIV) 19 Jun '26

19 Jun '26
Magnus pushed to branch wip/mangoiv/unused-type at Glasgow Haskell Compiler / GHC Commits: f0b676d9 by mangoiv at 2026-06-19T13:56:46+02:00 compiler: rename ZonkAny to UnusedType and add pretty printing logic ZonkAny is a hard to understand name for users who do not know how the compiler works internally. Additionally, it is confusing that ZonkAny, while being a concrete type *represents* a meta variable, espeically in the compiler output. This patch changes the name of ZonkAny to UnusedType which is closer to its intended semantics and adds special pretty printing logic to display this type in the same fashion the compiler displays meta variables in other places, whenever they leak from the implementation to the user. Fixes #27390 - - - - - 17 changed files: - + changelog.d/unused-type - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - libraries/ghc-internal/src/GHC/Internal/Types.hs - testsuite/tests/perf/compiler/T11068.stdout - testsuite/tests/pmcheck/should_compile/T12957.stderr - testsuite/tests/profiling/should_run/staticcallstack002.stdout - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T13156.stdout - testsuite/tests/simplCore/should_compile/T26615.stderr - testsuite/tests/typecheck/should_fail/T13292.stderr Changes: ===================================== changelog.d/unused-type ===================================== @@ -0,0 +1,14 @@ +section: compiler +synopsis: Rename ZonkAny to UnusedType and add pretty printing logic for it. +issues: #27390 +mrs: !16212 + +description: { + After unification GHC fills in unused type variables with a fixed kind like in + ``(length :: [alpha] -> Int) ([] :: List alpha) :: Int`` with a fixed type. + This type was, confusingly to the user, called ``ZonkAny``. + We rename this type to ``UnusedType``, store naming information, and try hard to + pretty print it to something that is more resemblant of an unused in non-debugging + compiler output. We also export ``UnusedType`` from ``GHC.Internal.Types`` to make + it easier to discover without reading the GHC source code. +} ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -1904,8 +1904,8 @@ unsatisfiableClassNameKey = mkPreludeTyConUnique 170 anyTyConKey :: Unique anyTyConKey = mkPreludeTyConUnique 171 -zonkAnyTyConKey :: Unique -zonkAnyTyConKey = mkPreludeTyConUnique 172 +unusedTypeTyConKey :: Unique +unusedTypeTyConKey = mkPreludeTyConUnique 172 -- Custom user type-errors errorMessageTypeErrorFamKey :: Unique ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -93,7 +93,7 @@ module GHC.Builtin.Types ( cTupleSelId, cTupleSelIdName, -- * Any - anyTyCon, anyTy, anyTypeOfKind, zonkAnyTyCon, + anyTyCon, anyTy, anyTypeOfKind, unusedTypeTyCon, -- * Recovery TyCon makeRecoveryTyCon, @@ -300,7 +300,7 @@ wiredInTyCons :: [TyCon] wiredInTyCons = map (dataConTyCon . snd) boxingDataCons ++ [ anyTyCon - , zonkAnyTyCon + , unusedTypeTyCon , boolTyCon , charTyCon , stringTyCon @@ -412,13 +412,13 @@ doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") {- Note [Any types] ~~~~~~~~~~~~~~~~ -The type constructors `Any` and `ZonkAny` are closed type families declared thus: +The type constructors `Any` and `UnusedType` are closed type families declared thus: - type family Any :: forall k. k where { } - type family ZonkAny :: forall k. Nat -> k where { } + type family Any :: forall k. k where { } + type family UnusedType :: forall k. Nat -> Symbol -> k where { } They are used when we want a type of a particular kind, but we don't really care -what that type is. The leading example is this: `ZonkAny` is used to instantiate +what that type is. The leading example is this: `UnusedType` is used to instantiate un-constrained type variables after type checking. For example, consider the term (length [] :: Int), where @@ -431,26 +431,26 @@ The typechecker will end up with length @alpha ([] @alpha) where `alpha` is an un-constrained unification variable. The "zonking" process zaps -that unconstrained `alpha` to an arbitrary type (ZonkAny @Type 3), where the `3` is -arbitrary (see wrinkle (Any5) below). This is done in `GHC.Tc.Zonk.Type.commitFlexi`. -So we end up with +that unconstrained `alpha` to an arbitrary type (UnusedType @Type 3 "a"), where the `3` is +arbitrary (see wrinkle (Any5) below) and "a" is the name string of the meta variable. +This is done in `GHC.Tc.Zonk.Type.commitFlexi`. So we end up with - length @(ZonkAny @Type 3) ([] @(ZonkAny @Type 3)) + length @(UnusedType @Type 3 "a") ([] @(UnusedType @Type 3 "a")) -`Any` and `ZonkAny` differ only in the presence of the `Nat` argument; see -wrinkle (Any4). +`Any` and `UnusedType` differ only in the presence of the `Nat` and the `Symbol` arguments; +see wrinkle (Any4). Wrinkles: -(Any1) `Any` and `ZonkAny` are kind polymorphic since in some program we may - need to use `ZonkAny` to fill in a type variable of some kind other than * +(Any1) `Any` and `UnusedType` are kind polymorphic since in some program we may + need to use `UnusedType` to fill in a type variable of some kind other than * (see #959 for examples). (Any2) They are /closed/ type families, with no instances. For example, suppose that with alpha :: '(k1, k2) we add a given coercion g :: alpha ~ (Fst alpha, Snd alpha) - and we zonked alpha = ZonkAny @(k1,k2) n. Then, if `ZonkAny` was a /data/ type, - we'd get inconsistency because we'd have a Given equality with `ZonkAny` on one + and we zonked alpha = UnusedType @(k1,k2) n. Then, if `UnusedType` was a /data/ type, + we'd get inconsistency because we'd have a Given equality with `UnusedType` on one side and '(,) on the other. See also #9097 and #9636. See #25244 for a suggestion that we instead use an /open/ type family for which @@ -460,7 +460,7 @@ Wrinkles: the code generator, because the code gen may /enter/ a data value but never enters a function value. -(Any4) `ZonkAny` takes a `Nat` argument so that we can readily make up /distinct/ +(Any4) `UnusedType` takes a `Nat` argument so that we can readily make up /distinct/ types (#24817). Consider data SBool a where { STrue :: SBool True; SFalse :: SBool False } @@ -475,44 +475,57 @@ Wrinkles: Now, what are `alpha` and `beta`? If we zonk both of them to the same type `Any @Type`, the pattern-match checker will (wrongly) report that the first branch is inaccessible. So we zonk them to two /different/ types: - alpha := ZonkAny @Type 4 and beta := ZonkAny @Type k 5 + alpha := UnusedType @Type 4 "a" and beta := UnusedType @Type k 5 "b" (The actual numbers are arbitrary; they just need to differ.) The unique-name generation comes from field `tcg_zany_n` of `TcGblEnv`; and - `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newZonkAnyType` to + `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newUnusedTypeType` to make up a fresh type. If this example seems unconvincing (e.g. in this case foo must be bottom) see #24817 for larger but more compelling examples. -(Any5) `Any` and `ZonkAny` are wired-in so we can easily refer to it where we - don't have a name environment (e.g. see Rules.matchRule for one example) +(Any9) + `UnusedType` takes a `Symbol` argument, which we use to neatly display zonked unfilled + metavariables without leaking internal type families. -(Any6) `Any` is defined in library module ghc-prim:GHC.Types, and exported so that - it is available to users. For this reason it's treated like any other - wired-in type: - - has a fixed unique, anyTyConKey, - - lives in the global name cache - Currently `ZonkAny` is not available to users; but it could easily be. + See T13292 for an example of this in action. + + `UnusedType` is handled specially in the pretty-printer to avoid confusing compiler output. + For example, `UnusedType 3 "foo" :: Type` is displayed as `foo3` -(Any7) Properties of `Any`: - * When `Any` is instantiated at a lifted type it is inhabited by at least one value, - namely bottom. + That special handling is implemented in GHC.Iface.Type.pprTyTcApp and more specifically + ppr_iface_unused_ty_tycon. - * You can safely coerce any /lifted/ type to `Any` and back with `unsafeCoerce`. + Historical note: in the past, `UnusedType` was called `ZonkAny` (or `Any` before that). + We renamed it to `UnusedType` and added this special treatment in the pretty-printer to avoid + confusing mentions of zonking. - * You can safely coerce any /unlifted/ type to `Any` and back with `unsafeCoerceUnlifted`. +(Any5) `Any` and `UnusedType` are wired-in so we can easily refer to it where we + don't have a name environment (e.g. see Rules.matchRule for one example) + +(Any6) `Any` is defined in library module ghc-internal:GHC.Internal.Types, and exported. + `Any` should be available to users mainly because it is a useful type in userspace + and is thus re-exported from `GHC.Exts`. - * You can coerce /any/ type to `Any` and back with `unsafeCoerce#`, but it's only safe when - the kinds of both the type and `Any` match. + `UnusedType` *could* be exported mainly for documentation in case a user stumbles over it + in debug output of GHC. However, since we don't want to actually have the user use that type + and discoverability of internal modules is (and should be) low, and the fact that we + cannot depend on `Natural` in ghc-internal:GHC.Internal.Types, we do not export it. - * For lifted/unlifted types `unsafeCoerce[Unlifted]` should be preferred over - `unsafeCoerce#` as they prevent accidentally coercing between types with kinds - that don't match. + `Any` is treated like any other wired-in types: + - it has a fixed unique, anyTyConKey + - lives in the global name cache - See examples in ghc-prim:GHC.Types + The key property of 'Any' is that it is safe to coerce a type to 'Any' as long + as the representation is unchanged. That is, it is OK to use 'unsafeCoerce#' to + go from 'ty :: TYPE r to 'Any :: TYPE r' and back, but it is never OK to coerce + between types of different representations (including between lifted and unlifted + boxed representations). + That is, it is useful when e.g. implementing dependent maps or similar typed container + types, storing values of type `Any`. -(Any8) Warning about unused bindings of type `Any` and `ZonkAny` are suppressed, +(Any8) Warning about unused bindings of type `Any` and `UnusedType` are suppressed, following the same rationale of supressing warning about the unit type. For example, consider (#25895): @@ -520,7 +533,7 @@ Wrinkles: do { forever (return ()); blah } where forever :: forall a b. IO a -> IO b - Nothing constrains `b`, so it will be instantiates with `Any` or `ZonkAny`. + Nothing constrains `b`, so it will be instantiates with `Any` or `UnusedType`. But we certainly don't want to complain about a discarded do-binding. The Any tycon used to be quite magic, but we have since been able to @@ -550,22 +563,23 @@ anyTy = mkTyConTy anyTyCon anyTypeOfKind :: Kind -> Type anyTypeOfKind kind = mkTyConApp anyTyCon [kind] -zonkAnyTyConName :: Name -zonkAnyTyConName = - mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "ZonkAny") zonkAnyTyConKey zonkAnyTyCon +unusedTypeTyConName :: Name +unusedTypeTyConName = + mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "UnusedType") unusedTypeTyConKey unusedTypeTyCon -zonkAnyTyCon :: TyCon --- ZonkAnyTyCon :: forall k. Nat -> k +unusedTypeTyCon :: TyCon +-- unusedTypeTyCon :: forall k. Nat -> Symbol -> k -- See Note [Any types] -zonkAnyTyCon = mkFamilyTyCon zonkAnyTyConName kind bndrs 0 res_kind +unusedTypeTyCon = mkFamilyTyCon unusedTypeTyConName kind bndrs 0 res_kind Nothing (ClosedSynFamilyTyCon Nothing) Nothing NotInjective where - [kv,nat_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy] + [kv,nat_kv,sym_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy, typeSymbolKind] bndrs = [ mkNamedTyConBinder Specified kv - , mkAnonTyConBinder nat_kv ] + , mkAnonTyConBinder nat_kv + , mkAnonTyConBinder sym_kv ] res_kind = mkTyVarTy kv kind = mkTyConKind bndrs res_kind ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -1281,11 +1281,11 @@ warnDiscardedDoBindings rhs@(L rhs_loc _) m_ty elt_ty do { fam_inst_envs <- dsGetFamInstEnvs ; let norm_elt_ty = topNormaliseType fam_inst_envs elt_ty supressible_ty = - isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isZonkAnyTy norm_elt_ty + isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isUnusedTypeTy norm_elt_ty -- Warn about discarding things in 'monadic' binding, -- however few types are excluded: -- * Unit type `()` - -- * `ZonkAny` or `Any` type see (Any8) of Note [Any types] + -- * `UnusedType` or `Any` type see (Any8) of Note [Any types] ; if warn_unused && not supressible_ty then diagnosticDs (DsUnusedDoBind rhs elt_ty) else ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -7,7 +7,7 @@ This module defines interface types and binders -} -{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE MultiWayIf, OverloadedRecordDot #-} module GHC.Iface.Type ( IfExtName, IfLclName(..), mkIfLclName, ifLclNameFS, @@ -1740,6 +1740,7 @@ pprTyTcApp ctxt_prec tc tys = sdocOption sdocPrintExplicitKinds $ \print_kinds -> sdocOption sdocPrintTypeAbbreviations $ \print_type_abbreviations -> getPprDebug $ \debug -> + getPprStyle $ \style -> if | ifaceTyConName tc `hasKey` ipClassKey , IA_Arg (IfaceLitTy (IfaceStrTyLit n)) @@ -1791,6 +1792,13 @@ pprTyTcApp ctxt_prec tc tys = | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys) -> doc + -- See Note [Any types], specifically (Any4) and (Any9) + | ifaceTyConName tc `hasKey` unusedTypeTyConKey + , (arg_k : IfaceLitTy (IfaceNumTyLit arg_n) : IfaceLitTy (IfaceStrTyLit arg_nm) : _) <- appArgsIfaceTypes tys + -- if arg_k is a kind with more than 0 arguments, then _ might not be [] here + , userStyle style + -> ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm + | otherwise -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc $ appArgsIfaceTypesForAllTyFlags $ stripInvisArgs (PrintExplicitKinds print_kinds) tys @@ -1802,6 +1810,19 @@ ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case False -> pprPrefixOcc liftedTypeKindTyConName True -> maybeParen ctxt_prec starPrec starLit +-- | user-style printer that pretty-prints an 'UnusedType @k 3 "foo" to foo3. +-- If -fprint-explicit-kinds or -fprint-explicit-runtime-reps are set, instead +-- prints them to (foo3 :: k). +-- See Note [Any types], specifically (Any4) and (Any9) for why this is useful. +ppr_iface_unused_ty_tycon :: PprPrec -> IfaceType -> Integer -> LexicalFastString -> SDoc +ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm + = sdocOption sdocPrintExplicitKinds $ \print_kinds -> + sdocOption sdocPrintExplicitRuntimeReps $ \print_reps -> + if print_kinds || print_reps + then maybeParen ctxt_prec sigPrec $ prettyMeta <+> text "::" <+> pprIfaceType arg_k + else prettyMeta + where prettyMeta = ppr arg_nm <> ppr arg_n + -- | Pretty-print a type-level equality. -- Returns (Just doc) if the argument is a /saturated/ application -- of eqTyCon (~) @@ -2190,7 +2211,8 @@ instance Binary IfaceTyConSort where 0 -> return IfaceNormalTyCon 1 -> IfaceTupleTyCon <$> get bh <*> get bh 2 -> IfaceSumTyCon <$> get bh - _ -> return IfaceEqualityTyCon + 3 -> return IfaceEqualityTyCon + _ -> panic "get IfaceTyConSort" instance Binary IfaceTyConInfo where put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -582,7 +582,7 @@ data TcGblEnv -- ^ Allows us to choose unique DFun names. tcg_zany_n :: TcRef Integer, - -- ^ A source of unique identities for ZonkAny instances + -- ^ A source of unique identities for UnusedType instances -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) tcg_merged :: [(Module, Fingerprint)], ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -154,7 +154,7 @@ module GHC.Tc.Utils.Monad( getCCIndexM, getCCIndexTcM, -- * Zonking - liftZonkM, newZonkAnyType, + liftZonkM, newUnusedType, -- * Complete matches localAndImportedCompleteMatches, getCompleteMatchesTcM, @@ -168,7 +168,7 @@ import GHC.Prelude import GHC.Builtin.Names -import GHC.Builtin.Types( zonkAnyTyCon ) +import GHC.Builtin.Types( unusedTypeTyCon ) import GHC.Tc.Errors.Types import GHC.Tc.Errors.Hole.Plugin ( HoleFitPlugin, HoleFitPluginR (..) ) @@ -197,7 +197,7 @@ import GHC.Core.Coercion ( isReflCo ) import GHC.Core.Multiplicity import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import GHC.Core.Type( mkNumLitTy ) +import GHC.Core.Type( mkNumLitTy, mkStrLitTy ) import GHC.Core.TyCo.Rep( CoercionHole(..) ) import GHC.Core.TyCo.FVs( coVarsOfCo ) import GHC.Core.TyCon ( TyCon ) @@ -2258,17 +2258,17 @@ chooseUniqueOccTc fn = ; writeTcRef dfun_n_var (extendOccSet set occ) ; return occ } -newZonkAnyType :: Kind -> TcM Type --- Return a type (ZonkAny @k n), where n is fresh --- Recall ZonkAny :: forall k. Natural -> k +newUnusedType :: Name -> Kind -> TcM Type +-- Return a type (UnusedType @k n sym), where n is fresh +-- Recall UnusedType :: forall k. Natural -> Symbol -> k -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) -newZonkAnyType kind +newUnusedType name kind = do { env <- getGblEnv ; let zany_n_var = tcg_zany_n env ; i <- readTcRef zany_n_var ; let !i2 = i+1 ; writeTcRef zany_n_var i2 - ; return (mkTyConApp zonkAnyTyCon [kind, mkNumLitTy i]) } + ; return (mkTyConApp unusedTypeTyCon [kind, mkNumLitTy i, mkStrLitTy $ getOccFS name ]) } getConstraintVar :: TcM (TcRef WantedConstraints) getConstraintVar = do { env <- getLclEnv; return (tcl_lie env) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -85,7 +85,7 @@ module GHC.Tc.Utils.TcType ( isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy, isFloatingPrimTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, - isBoolTy, isUnitTy, isAnyTy, isZonkAnyTy, isCharTy, + isBoolTy, isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy, isTauTy, isTauTyCon, tcIsTyVarTy, isPredTy, isSimplePredTy, isTyVarClassPred, checkValidClsArgs, hasTyVarHead, @@ -2057,7 +2057,7 @@ isFloatTy, isDoubleTy, isFloatPrimTy, isDoublePrimTy, isIntegerTy, isNaturalTy, isIntTy, isWordTy, isBoolTy, - isUnitTy, isAnyTy, isZonkAnyTy, isCharTy :: Type -> Bool + isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy :: Type -> Bool isFloatTy = is_tc floatTyConKey isDoubleTy = is_tc doubleTyConKey isFloatPrimTy = is_tc floatPrimTyConKey @@ -2069,7 +2069,7 @@ isWordTy = is_tc wordTyConKey isBoolTy = is_tc boolTyConKey isUnitTy = is_tc unitTyConKey isAnyTy = is_tc anyTyConKey -isZonkAnyTy = is_tc zonkAnyTyConKey +isUnusedTypeTy = is_tc unusedTypeTyConKey isCharTy = is_tc charTyConKey -- | Check whether the type is of the form @Any :: k@, ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedRecordDot #-} {- (c) The University of Glasgow 2006 (c) The AQUA Project, Glasgow University, 1996-1998 @@ -43,7 +44,7 @@ import GHC.Tc.Types.TcRef import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo ) import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) import GHC.Tc.Utils.TcType -import GHC.Tc.Utils.Monad ( newZonkAnyType, setSrcSpanA, liftZonkM, traceTc, addErr ) +import GHC.Tc.Utils.Monad ( newUnusedType, setSrcSpanA, liftZonkM, traceTc, addErr ) import GHC.Tc.Types.Evidence import GHC.Tc.Errors.Types import GHC.Tc.Zonk.Env @@ -470,11 +471,11 @@ commitFlexi DefaultFlexi tv zonked_kind ; return manyDataConTy } | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv = do { addErr $ TcRnZonkerMessage (ZonkerCannotDefaultConcrete origin) - ; newZonkAnyType zonked_kind } + ; newUnusedType tv.varName zonked_kind } | otherwise - = do { traceTc "Defaulting flexi tyvar to ZonkAny:" (pprTyVar tv) + = do { traceTc "Defaulting flexi tyvar to UnusedType:" (pprTyVar tv) -- See Note [Any types] in GHC.Builtin.Types, esp wrinkle (Any4) - ; newZonkAnyType zonked_kind } + ; newUnusedType tv.varName zonked_kind } zonkCoVarOcc :: CoVar -> ZonkTcM Coercion zonkCoVarOcc cv ===================================== libraries/ghc-internal/src/GHC/Internal/Types.hs ===================================== @@ -35,6 +35,7 @@ module GHC.Internal.Types ( SPEC(..), Symbol, Any, + UnusedType, -- * Type equality type (~), type (~~), Coercible, @@ -284,43 +285,33 @@ data Symbol * * ********************************************************************* -} --- | The type constructor @Any :: forall k. k@ is a type to which you can unsafely coerce any type, and back. +-- | The type constructor @Any :: forall k. k@ allows creating an arbitrary type +-- of the given kind. -- --- For @unsafeCoerce@ this means for all lifted types @t@ that --- @unsafeCoerce (unsafeCoerce x :: Any) :: t@ is equivalent to @x@ and safe. +-- It can be used to create a placeholder type when you only have a kind in hand. -- --- The same is true for *all* types when using --- @ --- unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) --- (a :: TYPE r1) (b :: TYPE r2). --- a -> b --- @ --- but /only/ if you instantiate @r1@ and @r2@ to the /same/ runtime representation. --- For example using @(unsafeCoerce# :: forall (a :: TYPE IntRep) (b :: TYPE IntRep). a -> b) x@ --- is fine, but @(unsafeCoerce# :: forall (a :: TYPE IntRep) (b :: TYPE FloatRep). a -> b)@ --- will likely cause seg-faults or worse. --- For this resason, users should always prefer unsafeCoerce over unsafeCoerce# when possible. +-- You can use 'unsafeCoerce#' to unsafely coerce a value from @ty :: k@ to @Any \@k@ +-- and back. As per the documentation of 'unsafeCoerce#', this is only sound if both +-- sides have the __exact same__runtime representation. Some examples: -- --- Here are some more examples: -- @ --- bad_a1 :: Any @(TYPE 'IntRep) --- bad_a1 = unsafeCoerce# True --- --- bad_a2 :: Any @(TYPE ('BoxedRep 'UnliftedRep)) --- bad_a2 = unsafeCoerce# True +-- unsafeCoerce# True :: (Any :: Type) -- OK +-- unsafeCoerce# (1# :: Int#) :: (Any :: TYPE IntRep) -- OK +-- unsafeCoerce# True :: (Any :: Type IntRep) -- INVALID +-- unsafeCoerce True :: (Any :: UnliftedType) -- INVALID +-- unsafeCoerce (ba :: ByteArray#) :: (Any :: Type) -- INVALID -- @ --- Here @bad_a1@ is bad because we started with @True :: (Bool :: Type)@, represented by a boxed heap pointer, --- and coerced it to @a1 :: Any @(TYPE 'IntRep)@, whose representation is a non-pointer integer. --- That's why we had to use `unsafeCoerce#`; it is really unsafe because it can change representations. --- Similarly @bad_a2@ is bad because although both @True@ and @bad_a2@ are represented by a heap pointer, --- @True@ is lifted but @bad_a2@ is not; bugs here may be rather subtle. -- --- If you must use unsafeCoerce# to cast to `Any`, type annotations are recommended --- to make sure that @Any@ has the correct kind. As casting between different runtimereps is --- unsound. For example to cast a @ByteArray#@ to @Any@ you might use: --- @ --- unsafeCoerce# b :: (Any :: TYPE ('BoxedRep 'Unlifted)) --- @ +-- To avoid accidentally unsafe-coercing between different representations, +-- it is recommended to: +-- - use explicit type annotations or type applications at every use-site +-- of 'unsafeCoerce#' +-- - use representation-monomorphic variants such as 'unsafeCoerce' or +-- 'unsafeCoerceUnlifted'. +-- +-- In particular, this also implies it is safe to round-trip unsafe-coercion via 'Any', +-- as long as the kinds line up e.g. @unsafeCoerce (unsafeCoerce (val :: a) :: 'Any') :: a@ +-- is safe in that way. type family Any :: k where { } -- See Note [Any types] in GHC.Builtin.Types. Also, for a bit of history on Any see -- #10886. Note that this must be a *closed* type family: we need to ensure ===================================== testsuite/tests/perf/compiler/T11068.stdout ===================================== @@ -23,137 +23,137 @@ `cast` (GHC.Internal.Generics.N:M1 `cast` (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 ===================================== testsuite/tests/pmcheck/should_compile/T12957.stderr ===================================== @@ -1,7 +1,6 @@ T12957.hs:4:5: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive - In a case alternative: - Patterns of type ‘[GHC.Internal.Types.ZonkAny 0]’ not matched: [] + In a case alternative: Patterns of type ‘[a0]’ not matched: [] T12957.hs:4:16: warning: [GHC-53633] [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant ===================================== testsuite/tests/profiling/should_run/staticcallstack002.stdout ===================================== @@ -1,4 +1,4 @@ -Just (InfoProv {ipName = "sat_s1Rh_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 0", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) -Just (InfoProv {ipName = "sat_s1RB_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 1", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) -Just (InfoProv {ipName = "sat_s1RV_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 2", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) -Just (InfoProv {ipName = "sat_s1Sf_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 3", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) +Just (InfoProv {ipName = "main_sat_t2fs_info", ipDesc = THUNK, ipTyDesc = "UnusedType 0 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) +Just (InfoProv {ipName = "main_sat_t2fJ_info", ipDesc = THUNK, ipTyDesc = "UnusedType 1 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) +Just (InfoProv {ipName = "main_sat_t2g0_info", ipDesc = THUNK, ipTyDesc = "UnusedType 2 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) +Just (InfoProv {ipName = "main_sat_t2gh_info", ipDesc = THUNK, ipTyDesc = "UnusedType 3 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -188,7 +188,7 @@ T13155: T13156: $(RM) -f T13156.hi T13156.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T13156.hs -O -ddump-prep -dsuppress-uniques | grep "case.*Any" + '$(TEST_HC)' $(TEST_HC_OPTS) -c T13156.hs -O -ddump-prep -dsuppress-uniques | grep "case.*UnusedType" # There should be a single 'case r @ GHC.Types.Any' .PHONY: T4138 ===================================== testsuite/tests/simplCore/should_compile/T13156.stdout ===================================== @@ -1,2 +1,2 @@ - case r @(GHC.Internal.Types.ZonkAny 0) of { __DEFAULT -> - case r @(GHC.Internal.Types.ZonkAny 1) of { __DEFAULT -> r @a } + case r @(GHC.Internal.Types.UnusedType 0 "a") of { __DEFAULT -> + case r @(GHC.Internal.Types.UnusedType 1 "a") of { __DEFAULT -> ===================================== testsuite/tests/simplCore/should_compile/T26615.stderr ===================================== @@ -2,7 +2,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 1,209, types: 1,139, coercions: 18, joins: 17/29} + = {terms: 1,209, types: 1,155, coercions: 18, joins: 17/29} -- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} unArray :: forall a. Array a -> SmallArray# a @@ -15,45 +15,29 @@ unArray :: forall a. Array a -> SmallArray# a unArray = \ (@a) (ds :: Array a) -> case ds of { Array ds1 -> ds1 } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule4 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$trModule4 = "main"# +$trModule1 :: Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule3 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule3 = GHC.Internal.Types.TrNameS T26615a.$trModule4 +$trModule2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$trModule2 = "T26615a"# +$trModule3 :: Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "T26615a"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule1 = GHC.Internal.Types.TrNameS T26615a.$trModule2 +$trModule4 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule :: GHC.Internal.Types.Module -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule - = GHC.Internal.Types.Module T26615a.$trModule3 T26615a.$trModule1 +T26615a.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module +[GblId, Unf=OtherCon []] +T26615a.$trModule = GHC.Internal.Types.Module $trModule2 $trModule4 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Internal.Types.KindRep @@ -104,33 +88,24 @@ $krep6 GHC.Internal.Types.$tcSmallArray# $krep5 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$tcLeaf2 = "Leaf"# +$tcLeaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tcLeaf1 = "Leaf"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcLeaf1 = GHC.Internal.Types.TrNameS T26615a.$tcLeaf2 +$tcLeaf2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcLeaf2 = GHC.Internal.Types.TrNameS $tcLeaf1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcLeaf [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcLeaf = GHC.Internal.Types.TyCon 13798714324392902582#Word64 3237499036029031497#Word64 T26615a.$trModule - T26615a.$tcLeaf1 + $tcLeaf2 0# GHC.Internal.Types.krep$*->*->* @@ -160,372 +135,284 @@ $krep10 :: GHC.Internal.Types.KindRep $krep10 = GHC.Internal.Types.KindRepFun $krep2 $krep9 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep11 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'L1 = GHC.Internal.Types.KindRepFun $krep3 $krep10 +$krep11 = GHC.Internal.Types.KindRepFun $krep3 $krep10 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$tc'L3 = "'L"# +$tc'L1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'L1 = "'L"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'L2 = GHC.Internal.Types.TrNameS T26615a.$tc'L3 +$tc'L2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'L2 = GHC.Internal.Types.TrNameS $tc'L1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'L [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'L = GHC.Internal.Types.TyCon 8570419491837374712#Word64 2090006989092642392#Word64 T26615a.$trModule - T26615a.$tc'L2 + $tc'L2 2# - T26615a.$tc'L1 + $krep11 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tcArray2 = "Array"# +$tcArray1 :: Addr# +[GblId, Unf=OtherCon []] +$tcArray1 = "Array"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcArray1 = GHC.Internal.Types.TrNameS T26615a.$tcArray2 +$tcArray2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcArray2 = GHC.Internal.Types.TrNameS $tcArray1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcArray [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcArray = GHC.Internal.Types.TyCon 10495761415291712389#Word64 7580086293698619153#Word64 T26615a.$trModule - T26615a.$tcArray1 + $tcArray2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11 :: GHC.Internal.Types.KindRep +$krep12 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep11 +$krep12 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep4 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep13 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Array1 = GHC.Internal.Types.KindRepFun $krep6 $krep11 +$krep13 = GHC.Internal.Types.KindRepFun $krep6 $krep12 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Array3 = "'Array"# +$tc'Array1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Array1 = "'Array"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Array2 = GHC.Internal.Types.TrNameS T26615a.$tc'Array3 +$tc'Array2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Array2 = GHC.Internal.Types.TrNameS $tc'Array1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Array [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Array = GHC.Internal.Types.TyCon 12424115309881832159#Word64 15542868641947707803#Word64 T26615a.$trModule - T26615a.$tc'Array2 + $tc'Array2 1# - T26615a.$tc'Array1 + $krep13 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep12 :: [GHC.Internal.Types.KindRep] +$krep14 :: [GHC.Internal.Types.KindRep] [GblId, Unf=OtherCon []] -$krep12 +$krep14 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep9 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep13 :: GHC.Internal.Types.KindRep +$krep15 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep13 - = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep12 +$krep15 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep14 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tcHashMap2 = "HashMap"# +$tcHashMap1 :: Addr# +[GblId, Unf=OtherCon []] +$tcHashMap1 = "HashMap"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcHashMap1 - = GHC.Internal.Types.TrNameS T26615a.$tcHashMap2 +$tcHashMap2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcHashMap2 = GHC.Internal.Types.TrNameS $tcHashMap1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcHashMap [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcHashMap = GHC.Internal.Types.TyCon 2021755758654901686#Word64 8209241086311595496#Word64 T26615a.$trModule - T26615a.$tcHashMap1 + $tcHashMap2 0# GHC.Internal.Types.krep$*->*->* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep16 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Empty1 +$krep16 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcHashMap $krep8 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Empty3 = "'Empty"# +$tc'Empty1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Empty1 = "'Empty"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Empty2 = GHC.Internal.Types.TrNameS T26615a.$tc'Empty3 +$tc'Empty2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Empty2 = GHC.Internal.Types.TrNameS $tc'Empty1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Empty [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Empty = GHC.Internal.Types.TyCon 2520556399233147460#Word64 17224648764450205443#Word64 T26615a.$trModule - T26615a.$tc'Empty2 + $tc'Empty2 2# - T26615a.$tc'Empty1 + $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep14 :: GHC.Internal.Types.KindRep +$krep17 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep14 = GHC.Internal.Types.KindRepFun $krep9 T26615a.$tc'Empty1 +$krep17 = GHC.Internal.Types.KindRepFun $krep9 $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep18 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Leaf1 = GHC.Internal.Types.KindRepFun $krep1 $krep14 +$krep18 = GHC.Internal.Types.KindRepFun $krep1 $krep17 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Leaf3 = "'Leaf"# +$tc'Leaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Leaf1 = "'Leaf"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Leaf2 = GHC.Internal.Types.TrNameS T26615a.$tc'Leaf3 +$tc'Leaf2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Leaf2 = GHC.Internal.Types.TrNameS $tc'Leaf1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Leaf [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Leaf = GHC.Internal.Types.TyCon 5773656560257991946#Word64 17028074687139582545#Word64 T26615a.$trModule - T26615a.$tc'Leaf2 + $tc'Leaf2 2# - T26615a.$tc'Leaf1 + $krep18 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep15 :: GHC.Internal.Types.KindRep +$krep19 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep15 = GHC.Internal.Types.KindRepFun $krep13 T26615a.$tc'Empty1 +$krep19 = GHC.Internal.Types.KindRepFun $krep15 $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep20 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Collision1 - = GHC.Internal.Types.KindRepFun $krep1 $krep15 +$krep20 = GHC.Internal.Types.KindRepFun $krep1 $krep19 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 40 0}] -T26615a.$tc'Collision3 = "'Collision"# +$tc'Collision1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Collision1 = "'Collision"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Collision2 - = GHC.Internal.Types.TrNameS T26615a.$tc'Collision3 +$tc'Collision2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Collision2 = GHC.Internal.Types.TrNameS $tc'Collision1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Collision [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Collision = GHC.Internal.Types.TyCon 18175105753528304021#Word64 13986842878006680511#Word64 T26615a.$trModule - T26615a.$tc'Collision2 + $tc'Collision2 2# - T26615a.$tc'Collision1 + $krep20 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep16 :: [GHC.Internal.Types.KindRep] +$krep21 :: [GHC.Internal.Types.KindRep] [GblId, Unf=OtherCon []] -$krep16 +$krep21 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep - T26615a.$tc'Empty1 + $krep16 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep17 :: GHC.Internal.Types.KindRep +$krep22 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep17 - = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep16 +$krep22 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep21 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep23 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Full1 - = GHC.Internal.Types.KindRepFun $krep17 T26615a.$tc'Empty1 +$krep23 = GHC.Internal.Types.KindRepFun $krep22 $krep16 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Full3 = "'Full"# +$tc'Full1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Full1 = "'Full"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Full2 = GHC.Internal.Types.TrNameS T26615a.$tc'Full3 +$tc'Full2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Full2 = GHC.Internal.Types.TrNameS $tc'Full1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Full [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Full = GHC.Internal.Types.TyCon 12008762105994325570#Word64 13514145886440831186#Word64 T26615a.$trModule - T26615a.$tc'Full2 + $tc'Full2 2# - T26615a.$tc'Full1 + $krep23 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed1 [InlPrag=[~]] - :: GHC.Internal.Types.KindRep +$krep24 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'BitmapIndexed1 - = GHC.Internal.Types.KindRepFun $krep1 T26615a.$tc'Full1 +$krep24 = GHC.Internal.Types.KindRepFun $krep1 $krep23 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 50 0}] -T26615a.$tc'BitmapIndexed3 = "'BitmapIndexed"# +$tc'BitmapIndexed1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'BitmapIndexed1 = "'BitmapIndexed"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'BitmapIndexed2 - = GHC.Internal.Types.TrNameS T26615a.$tc'BitmapIndexed3 +$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'BitmapIndexed2 = GHC.Internal.Types.TrNameS $tc'BitmapIndexed1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'BitmapIndexed [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'BitmapIndexed = GHC.Internal.Types.TyCon 15226751910432948177#Word64 957331387129868915#Word64 T26615a.$trModule - T26615a.$tc'BitmapIndexed2 + $tc'BitmapIndexed2 2# - T26615a.$tc'BitmapIndexed1 + $krep24 -- RHS size: {terms: 98, types: 109, coercions: 0, joins: 3/4} T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] @@ -538,7 +425,7 @@ T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] Str=<LP(SC(S,C(1,L)),A)><L><1L><L><L>, Unf=Unf{Src=StableUser, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [30 0 20 0 0] 406 10 + Guidance=IF_ARGS [90 0 20 0 0] 406 10 Tmpl= \ (@k) (@a) (@b) @@ -586,7 +473,7 @@ T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary1 [Occ=Once1!] :: Array (Leaf k b)) (i1 [Occ=Once1!] :: Int) @@ -654,24 +541,23 @@ T26615a.$wdisjointCollisions $s$wfoldr_ [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Bool -> Int# -> Int# -> SmallArray# (Leaf k a) -> Bool + :: SmallArray# (Leaf k a) -> Int# -> Int# -> Bool -> Bool [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><L><L><L>, Unf=OtherCon []] - $s$wfoldr_ (sc :: Bool) + $s$wfoldr_ (sc :: SmallArray# (Leaf k a)) (sc1 :: Int#) (sc2 :: Int#) - (sc3 :: SmallArray# (Leaf k a)) - = case >=# sc1 sc2 of { + (sc3 :: Bool) + = case >=# sc2 sc1 of { __DEFAULT -> - case indexSmallArray# @Lifted @(Leaf k a) sc3 sc1 of - { (# ipv1 #) -> + case indexSmallArray# @Lifted @(Leaf k a) sc sc2 of { (# ipv1 #) -> case ipv1 of { L kA ds1 -> join { $j :: Bool [LclId[JoinId(0)(Nothing)]] - $j = jump $s$wfoldr_ sc (+# sc1 1#) sc2 sc3 } in + $j = jump $s$wfoldr_ sc sc1 (+# sc2 1#) sc3 } in joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, @@ -703,13 +589,13 @@ T26615a.$wdisjointCollisions jump $wlookupInArrayCont_ kA ww2 0# lvl2 } }; - 1# -> sc + 1# -> sc3 }; } in jump $s$wfoldr_ - GHC.Internal.Types.True - 0# - (sizeofSmallArray# @Lifted @(Leaf k a) ipv) ipv + (sizeofSmallArray# @Lifted @(Leaf k a) ipv) + 0# + GHC.Internal.Types.True } } @@ -728,28 +614,28 @@ Rec { -- RHS size: {terms: 133, types: 126, coercions: 0, joins: 1/2} T26615a.disjointSubtrees_$s$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] - :: forall b a k. - Word# - -> SmallArray# (Leaf k a) -> Int# -> Eq k => HashMap k b -> Bool + :: forall k a b. + Eq k => + Int# -> Word# -> SmallArray# (Leaf k a) -> HashMap k b -> Bool [GblId[StrictWorker([~, ~, ~, ~, !])], Arity=5, - Str=<L><L><L><LP(SC(S,C(1,L)),A)><1L>, + Str=<LP(SC(S,C(1,L)),A)><L><L><L><1L>, Unf=OtherCon []] T26615a.disjointSubtrees_$s$wdisjointSubtrees - = \ (@b) + = \ (@k) (@a) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) - (sc2 :: Int#) - (sc3 :: Eq k) + (@b) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k a)) (_b :: HashMap k b) -> case _b of { Empty -> GHC.Internal.Types.True; Leaf bx ds -> case ds of { L kB ds1 -> case kB of k0 { __DEFAULT -> - case eqWord# bx sc of { + case eqWord# bx sc2 of { __DEFAULT -> GHC.Internal.Types.True; 1# -> joinrec { @@ -770,7 +656,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees __DEFAULT -> case indexSmallArray# @Lifted @(Leaf k a) ww ww1 of { (# ipv #) -> case ipv of { L kx v -> - case == @k sc3 k2 kx of { + case == @k sc k2 kx of { False -> jump $wlookupInArrayCont_ k2 ww (+# ww1 1#) ww2; True -> GHC.Internal.Types.False } @@ -780,19 +666,19 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - k0 sc1 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc1) + k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3) } } }; Collision bx bx1 -> T26615a.$wdisjointCollisions - @k @a @b sc3 sc (T26615a.Array @(Leaf k a) sc1) bx bx1; + @k @a @b sc sc2 (T26615a.Array @(Leaf k a) sc3) bx bx1; BitmapIndexed bx bx1 -> let { m :: Word# [LclId] m = uncheckedShiftL# - 1## (word2Int# (and# (uncheckedShiftRL# sc sc2) 31##)) } in + 1## (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) } in case and# m bx of { __DEFAULT -> case indexSmallArray# @@ -803,7 +689,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 (+# sc2 5#) sc3 ipv + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv }; 0## -> GHC.Internal.Types.True }; @@ -812,17 +698,17 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees @Lifted @(HashMap k b) bx - (word2Int# (and# (uncheckedShiftRL# sc sc2) 31##)) + (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 (+# sc2 5#) sc3 ipv + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv } } end Rec } Rec { --- RHS size: {terms: 705, types: 732, coercions: 18, joins: 13/23} +-- RHS size: {terms: 705, types: 748, coercions: 18, joins: 13/23} T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] :: forall k a b. Eq k => Int# -> HashMap k a -> HashMap k b -> Bool [GblId[StrictWorker([~, ~, !])], @@ -841,7 +727,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] join { fail [Occ=Once3!T[1]] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of wild [Occ=Once1] { __DEFAULT -> case GHC.Internal.Control.Exception.Base.patError @@ -860,7 +746,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupCont_ _ [Occ=Dead] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) (ds4 [Occ=Once1!] :: Word) (ds5 [Occ=Once1] :: k) (ds6 [Occ=Once1!] :: Int) @@ -896,7 +782,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary [Occ=Once1!] :: Array (Leaf k a)) (i [Occ=Once1!] :: Int) @@ -1000,7 +886,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupCont_ _ [Occ=Dead] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) (ds3 [Occ=Once1!] :: Word) (ds4 [Occ=Once1] :: k) (ds5 [Occ=Once1!] :: Int) @@ -1034,7 +920,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary [Occ=Once1!] :: Array (Leaf k b)) (i [Occ=Once1!] :: Int) @@ -1179,23 +1065,23 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -1324,51 +1210,49 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] }; } in jump go (GHC.Internal.Types.W# (and# 4294967295## bx1)); Full bx1 -> + joinrec { + go [Occ=LoopBreakerT[1]] :: Int -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + go (i :: Int) + = case GHC.Internal.Classes.ltInt i (GHC.Internal.Types.I# 0#) of { + False -> + case i of { I# i# -> + case indexSmallArray# @Lifted @(HashMap k a) bx i# of + { (# ipv [Occ=Once1] #) -> + case indexSmallArray# @Lifted @(HashMap k b) bx1 i# of + { (# ipv1 [Occ=Once1] #) -> + case T26615a.$wdisjointSubtrees @k @a @b $dEq (+# ww 5#) ipv ipv1 + of { + False -> GHC.Internal.Types.False; + True -> jump go (GHC.Internal.Types.I# (-# i# 1#)) + } + } + } + }; + True -> GHC.Internal.Types.True + }; } in case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { - __DEFAULT -> - joinrec { - go [Occ=LoopBreakerT[1]] :: Int -> Bool - [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] - go (i :: Int) - = case GHC.Internal.Classes.ltInt i (GHC.Internal.Types.I# 0#) of { - False -> - case i of { I# i# -> - case indexSmallArray# @Lifted @(HashMap k a) bx i# of - { (# ipv [Occ=Once1] #) -> - case indexSmallArray# @Lifted @(HashMap k b) bx1 i# of - { (# ipv1 [Occ=Once1] #) -> - case T26615a.$wdisjointSubtrees - @k @a @b $dEq (+# ww 5#) ipv ipv1 - of { - False -> GHC.Internal.Types.False; - True -> jump go (GHC.Internal.Types.I# (-# i# 1#)) - } - } - } - }; - True -> GHC.Internal.Types.True - }; } in - jump go (GHC.Internal.Types.I# 31#); + __DEFAULT -> jump go (GHC.Internal.Types.I# 31#); 1# -> GHC.Internal.Types.False } } @@ -1385,7 +1269,7 @@ T26615a.$wdisjointSubtrees join { fail [Dmd=MC(1,L)] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of { __DEFAULT -> case lvl1 of {}; Empty -> GHC.Internal.Types.True; @@ -1508,7 +1392,7 @@ T26615a.$wdisjointSubtrees }; Collision bx bx1 -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @a @b @k bx bx1 ww $dEq ds + @k @b @a $dEq ww bx bx1 ds } } in case ds of { Empty -> GHC.Internal.Types.True; @@ -1661,7 +1545,7 @@ T26615a.$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k bx bx1 (+# ww 5#) $dEq ipv + @k @a @b $dEq (+# ww 5#) bx bx1 ipv }; 0## -> GHC.Internal.Types.True }; @@ -1674,7 +1558,7 @@ T26615a.$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k bx bx1 (+# ww 5#) $dEq ipv + @k @a @b $dEq (+# ww 5#) bx bx1 ipv } }; BitmapIndexed bx bx1 -> @@ -1686,21 +1570,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) - :: SmallArray# (HashMap k a) ~R# GHC.Internal.Types.ZonkAny 0)) + :: SmallArray# (HashMap k a) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) - :: SmallArray# (HashMap k b) ~R# GHC.Internal.Types.ZonkAny 1)) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> let { @@ -1829,21 +1715,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) - :: SmallArray# (HashMap k a) ~R# GHC.Internal.Types.ZonkAny 0)) + :: SmallArray# (HashMap k a) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) - :: SmallArray# (HashMap k b) ~R# GHC.Internal.Types.ZonkAny 1)) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> let { @@ -1910,88 +1798,72 @@ disjointSubtrees ------ Local rules for imported ids -------- "SC:$wdisjointSubtrees1" [1] - forall (@a) + forall (@k) (@b) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) + (@a) + (sc :: Eq k) + (sc1 :: Int#) (sc2 :: Word#) (sc3 :: SmallArray# (Leaf k b)) - (sc4 :: Int#) - (sc5 :: Eq k). + (sc4 :: Word#) + (sc5 :: SmallArray# (Leaf k a)). T26615a.$wdisjointSubtrees @k @b @a - sc5 - sc4 + sc + sc1 (T26615a.Collision @k @b sc2 sc3) - (T26615a.Collision @k @a sc sc1) + (T26615a.Collision @k @a sc4 sc5) = T26615a.$wdisjointCollisions - @k @b @a sc5 sc2 (T26615a.Array @(Leaf k b) sc3) sc sc1 + @k @b @a sc sc2 (T26615a.Array @(Leaf k b) sc3) sc4 sc5 "SC:$wdisjointSubtrees0" [1] - forall (@b) + forall (@k) (@a) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) - (sc2 :: Int#) - (sc3 :: Eq k). + (@b) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k a)). T26615a.$wdisjointSubtrees @k @a @b - sc3 - sc2 - (T26615a.Collision @k @a sc sc1) + sc + sc1 + (T26615a.Collision @k @a sc2 sc3) = T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 sc2 sc3 + @k @a @b sc sc1 sc2 sc3 [2 of 2] Compiling T26615 ( T26615.hs, T26615.o ) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 614, types: 666, coercions: 18, joins: 8/14} + = {terms: 614, types: 682, coercions: 18, joins: 8/14} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule2 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615.$trModule2 = "T26615"# +$trModule1 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "T26615"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule1 = GHC.Internal.Types.TrNameS T26615.$trModule2 +$trModule2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule4 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615.$trModule4 = "main"# +$trModule3 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule3 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule3 = GHC.Internal.Types.TrNameS T26615.$trModule4 +$trModule4 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule :: GHC.Internal.Types.Module -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule - = GHC.Internal.Types.Module T26615.$trModule3 T26615.$trModule1 +T26615.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module +[GblId, Unf=OtherCon []] +T26615.$trModule = GHC.Internal.Types.Module $trModule4 $trModule2 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} lvl :: GHC.Internal.Prim.Addr# @@ -2128,7 +2000,7 @@ $wpoly_lookupCont_ end Rec } Rec { --- RHS size: {terms: 448, types: 507, coercions: 18, joins: 8/13} +-- RHS size: {terms: 448, types: 523, coercions: 18, joins: 8/13} T26615.$s$wdisjointSubtrees [InlPrag=[~], Occ=LoopBreaker] :: forall a b. GHC.Internal.Prim.Int# @@ -2143,7 +2015,7 @@ T26615.$s$wdisjointSubtrees join { fail [Dmd=MC(1,L)] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of wild { __DEFAULT -> case lvl1 of {}; T26615a.Empty -> GHC.Internal.Types.True; @@ -2190,30 +2062,28 @@ T26615.$s$wdisjointSubtrees $s$wfoldr_ [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Bool - -> GHC.Internal.Prim.Int# - -> GHC.Internal.Prim.Int# - -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a) - -> Bool + :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a) + -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> Bool -> Bool [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><L><L><L>, Unf=OtherCon []] - $s$wfoldr_ (sc :: Bool) + $s$wfoldr_ (sc + :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)) (sc1 :: GHC.Internal.Prim.Int#) (sc2 :: GHC.Internal.Prim.Int#) - (sc3 :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)) - = case GHC.Internal.Prim.>=# sc1 sc2 of { + (sc3 :: Bool) + = case GHC.Internal.Prim.>=# sc2 sc1 of { __DEFAULT -> case GHC.Internal.Prim.indexSmallArray# - @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) sc3 sc1 + @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) sc sc2 of { (# ipv1 #) -> case ipv1 of { T26615a.L kA ds2 -> join { $j :: Bool [LclId[JoinId(0)(Nothing)]] - $j = jump $s$wfoldr_ sc (GHC.Internal.Prim.+# sc1 1#) sc2 sc3 } in + $j = jump $s$wfoldr_ sc sc1 (GHC.Internal.Prim.+# sc2 1#) sc3 } in joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, @@ -2258,14 +2128,14 @@ T26615.$s$wdisjointSubtrees jump $wlookupInArrayCont_ kA bx3 0# lvl2 } }; - 1# -> sc + 1# -> sc3 }; } in jump $s$wfoldr_ - GHC.Internal.Types.True - 0# + bx1 (GHC.Internal.Prim.sizeofSmallArray# @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) bx1) - bx1 + 0# + GHC.Internal.Types.True }; T26615a.BitmapIndexed bx2 bx3 -> let { @@ -2317,23 +2187,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -2495,23 +2365,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -2564,7 +2434,7 @@ f = \ (@a) ------ Local rules for imported ids -------- "SPEC/T26615 $wdisjointSubtrees @String @_ @_" [2] - forall (@a) (@b) ($dEq :: Eq String). + forall (@a) (@b) ($dEq [Occ=Dead] :: Eq String). T26615a.$wdisjointSubtrees @String @a @b $dEq = T26615.$s$wdisjointSubtrees @a @b ===================================== testsuite/tests/typecheck/should_fail/T13292.stderr ===================================== @@ -14,15 +14,15 @@ T13292a.hs:4:12: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] In an equation for ‘someFunc’: someFunc = return () T13292.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘GHC.Internal.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m00’ with ‘IO’ Expected: IO () - Actual: GHC.Internal.Types.ZonkAny 0 () + Actual: m00 • When checking the type of the IO action ‘main’ T13292.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘GHC.Internal.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m00’ with ‘IO’ Expected: IO () - Actual: GHC.Internal.Types.ZonkAny 0 () + Actual: m00 • In the expression: main When checking the type of the IO action ‘main’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0b676d965591ba1e35c9aea0e27016… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0b676d965591ba1e35c9aea0e27016… You're receiving this email because of your account on gitlab.haskell.org.
1 0
0 0
[Git][ghc/ghc][wip/reduce-type-in-stg] Remove whitespace and work on extending note
by Jaro Reinders (@jaro) 19 Jun '26

19 Jun '26
Jaro Reinders pushed to branch wip/reduce-type-in-stg at Glasgow Haskell Compiler / GHC Commits: e577bcf9 by Jaro Reinders at 2026-06-19T13:05:53+02:00 Remove whitespace and work on extending note - - - - - 1 changed file: - compiler/GHC/Stg/Syntax.hs Changes: ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -14,7 +14,7 @@ generation. -} module GHC.Stg.Syntax ( - StgKind(getStgKind), typeStgKind, stgKindPrimRep, stgKindPrimRep1, + StgKind(getStgKind), typeStgKind, stgKindPrimRep, stgKindPrimRep1, stgKindPrimRepU, isUnboxedTupleStgKind, isLiftedTypeStgKind, StgFArgType(..), @@ -81,12 +81,12 @@ import GHC.Types.CostCentre ( CostCentreStack ) import GHC.Core ( AltCon ) import GHC.Core.DataCon import GHC.Core.TyCon ( PrimRep(..), PrimOrVoidRep(..), TyCon ) -import GHC.Core.Type - ( Type, - tyConAppTyCon, - typeKind, - isUnboxedTupleKind, - kindRep_maybe, +import GHC.Core.Type + ( Type, + tyConAppTyCon, + typeKind, + isUnboxedTupleKind, + kindRep_maybe, isLiftedRuntimeRep ) import GHC.Core.Ppr( {- instances -} ) @@ -95,11 +95,11 @@ import GHC.Types.Id import GHC.Types.Tickish ( StgTickish ) import GHC.Types.Var.Set import GHC.Types.Literal ( Literal, literalType ) -import GHC.Types.RepType - ( typePrimRep, - typePrimRep1, - typePrimRepU, - typePrimRep_maybe, +import GHC.Types.RepType + ( typePrimRep, + typePrimRep1, + typePrimRepU, + typePrimRep_maybe, kindPrimRep, kindPrimRep1, kindPrimRep_maybe, @@ -169,7 +169,7 @@ There are two reasons for wanting a coarser type system: another language might not be compatible with GHC's type system. In such a case the kind system is often still compatible because it is so much coarser. Examples of such projects are: - + - agda2stg: https://github.com/noughtmare/agda2stg - external-stg-interpreter: https://github.com/grin-compiler/ghc-whole-program-compiler-project/tree/ma… @@ -189,7 +189,7 @@ There are two reasons for wanting a coarser type system: Left _ -> r <------------- NB Right _ -> error "urk" - See Note [Case 2: CSEing case binders] for the full details of this + See Note [Case 2: CSEing case binders] for the full details of this optimization. This is not type-safe in Core, but it is kind-safe in STG. So, using @@ -200,6 +200,23 @@ Note that the kinds do not always accurately reflect the final runtime representation. For example, on the JS backend the kind 'TYPE Int64Rep' might eventually be rewritten to 'TYPE (TupleRep [Int32Rep,Int32Rep])' because there is no 64 bit integer type in JS. + +Consequences: + +* STG Lint checks for kind-correctness, not type-correctness. + + - In an appplication, check that that kind of the argument matches the kind expected by the function + - In a let-binding check that the kind of the binder matches the kind of the RHS. + - etc + + (It would be good to check these claims are true of STG Lint!) + +* In practice, each Id still contains its Type; but only the Kind of that type is used in STG onwards. + Some places still use DataCon which also still contains a reference to its type. + +* We define a newtype StgKind to distinguish it from Type which Kind is otherwise equal to. + +* What else? -} {- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e577bcf96a81f8225b1936e162762e4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e577bcf96a81f8225b1936e162762e4… You're receiving this email because of your account on gitlab.haskell.org.
1 0
0 0
[Git][ghc/ghc][wip/reduce-type-in-stg] Clean up interface and expand note
by Jaro Reinders (@jaro) 19 Jun '26

19 Jun '26
Jaro Reinders pushed to branch wip/reduce-type-in-stg at Glasgow Haskell Compiler / GHC Commits: d400c2d8 by Jaro Reinders at 2026-06-19T12:47:45+02:00 Clean up interface and expand note - - - - - 10 changed files: - compiler/GHC/CoreToStg.hs - compiler/GHC/Stg/BcPrep.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Foreign.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/Utils.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Utils.hs Changes: ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -447,7 +447,7 @@ coreToStgExpr expr@(Lam {}) fun_ty = mkLamTypes val_bndrs body_ty -- This type is a bit ill-formed but it doesn't matter rhs = StgRhsClosure noExtFieldSilent currentCCS - ReEntrant val_bndrs body' (MkStgKind (typeKind body_ty)) + ReEntrant val_bndrs body' (typeStgKind body_ty) tmp_fun = mkSysLocal (fsLit "pap") uniq ManyTy fun_ty ; return (StgLet noExtFieldSilent (StgNonRec tmp_fun rhs) $ StgApp tmp_fun []) } @@ -607,7 +607,7 @@ mkStgApp f how_bound core_args stg_args res_ty f_arity = stgArity f how_bound n_val_args = length stg_args -- StgArgs are all value arguments exactly_saturated = f_arity == n_val_args - res_kind = MkStgKind (typeKind res_ty) + res_kind = typeStgKind res_ty -- Given Core arguments to an unboxed sum datacon, return the 'PrimRep's @@ -751,7 +751,7 @@ coreToMkStgRhs bndr expr = do let mk_rhs = MkStgRhs { rhs_args = bndrs , rhs_expr = body' - , rhs_kind = MkStgKind (typeKind (exprType body)) + , rhs_kind = typeStgKind (exprType body) , rhs_is_join = isJoinId bndr } pure mk_rhs ===================================== compiler/GHC/Stg/BcPrep.hs ===================================== @@ -50,7 +50,7 @@ bcPrepRHS con@StgRhsCon{} = pure con bcPrepExpr :: StgExpr -> BcPrepM StgExpr -- explicitly match all constructors so we get a warning if we miss any bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _) rhs) - | isLiftedTypeKind tick_kind = do + | isLiftedTypeStgKind tick_kind = do id <- newId tick_ty rhs' <- bcPrepExpr rhs let expr' = StgTick bp rhs' @@ -59,7 +59,7 @@ bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _) rhs) ReEntrant [] expr' - (MkStgKind tick_kind) + tick_kind ) letExp = StgLet noExtFieldSilent bnd (StgApp id []) pure letExp @@ -72,10 +72,10 @@ bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _) rhs) ReEntrant [voidArgId] expr' - (MkStgKind tick_kind) + tick_kind ) pure $ StgLet noExtFieldSilent bnd (StgApp id [StgVarArg realWorldPrimId]) - where tick_kind = typeKind tick_ty + where tick_kind = typeStgKind tick_ty bcPrepExpr (StgTick tick rhs) = StgTick tick <$> bcPrepExpr rhs bcPrepExpr (StgLet xlet bnds expr) = ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -14,7 +14,8 @@ generation. -} module GHC.Stg.Syntax ( - StgKind(..), + StgKind(getStgKind), typeStgKind, stgKindPrimRep, stgKindPrimRep1, + stgKindPrimRepU, isUnboxedTupleStgKind, isLiftedTypeStgKind, StgFArgType(..), collectStgFArgTypes, @@ -80,7 +81,13 @@ import GHC.Types.CostCentre ( CostCentreStack ) import GHC.Core ( AltCon ) import GHC.Core.DataCon import GHC.Core.TyCon ( PrimRep(..), PrimOrVoidRep(..), TyCon ) -import GHC.Core.Type ( Type, tyConAppTyCon ) +import GHC.Core.Type + ( Type, + tyConAppTyCon, + typeKind, + isUnboxedTupleKind, + kindRep_maybe, + isLiftedRuntimeRep ) import GHC.Core.Ppr( {- instances -} ) import GHC.Types.ForeignCall ( ForeignCall ) @@ -88,10 +95,19 @@ import GHC.Types.Id import GHC.Types.Tickish ( StgTickish ) import GHC.Types.Var.Set import GHC.Types.Literal ( Literal, literalType ) -import GHC.Types.RepType ( typePrimRep, typePrimRep1, typePrimRepU, typePrimRep_maybe, unwrapType ) +import GHC.Types.RepType + ( typePrimRep, + typePrimRep1, + typePrimRepU, + typePrimRep_maybe, + kindPrimRep, + kindPrimRep1, + kindPrimRep_maybe, + unwrapType ) import GHC.Utils.Outputable import GHC.Utils.Panic.Plain +import GHC.Utils.Panic ( pprPanic ) import GHC.Builtin.PrimOps ( PrimOp, PrimCall ) @@ -112,27 +128,54 @@ import GHC.Builtin.Types.Prim -- Kind is otherwise equal to. -- See Note [Kinds in STG] newtype StgKind = MkStgKind { getStgKind :: Kind } +-- getStgKind is only used to do some silly pretty printing in the JS backend. + +typeStgKind :: Type -> StgKind +typeStgKind = MkStgKind . typeKind + +stgKindPrimRep1 :: StgKind -> PrimRep +stgKindPrimRep1 = kindPrimRep1 . getStgKind + +stgKindPrimRepU :: StgKind -> PrimOrVoidRep +stgKindPrimRepU (MkStgKind kind) = case kindPrimRep_maybe kind of + Just [] -> VoidRep + Just [r] -> NVRep r + r -> pprPanic "stgKindPrimRepU" (ppr r) + +stgKindPrimRep :: StgKind -> [PrimRep] +stgKindPrimRep = kindPrimRep . getStgKind + +isUnboxedTupleStgKind :: StgKind -> Bool +isUnboxedTupleStgKind = isUnboxedTupleKind . getStgKind + +isLiftedTypeStgKind :: StgKind -> Bool +isLiftedTypeStgKind (MkStgKind kind) + = case kindRep_maybe kind of + Just rep -> isLiftedRuntimeRep rep + Nothing -> False {- Note [Kinds in STG] ~~~~~~~~~~~~~~~~~~~ - -Whereas Core is type-annotated, STG is kind-annotated. +Whereas Core is well-typed, STG is well-kinded. Just as many different values may have a single type, so many different types may have a single kind. So kinds are a "coarser approximation" to the values being manipulated; and that is what we want in STG. -There are two reasons for this: +There are two reasons for wanting a coarser type system: (1) It is easier for third party projects to compile to STG. The type system of another language might not be compatible with GHC's type system. In such a case the kind system is often still compatible because it is so much coarser. - Example projects are Jaro Reinders' agda2stg and Csaba Hruska's external-stg. + Examples of such projects are: + + - agda2stg: https://github.com/noughtmare/agda2stg + - external-stg-interpreter: https://github.com/grin-compiler/ghc-whole-program-compiler-project/tree/ma… (2) It allows for more aggressive optimizations. In STG we may do - type-incorrect things that are kind-correct. For example consider - the following function: + type-incorrect things that are still kind-correct. For example + consider the following function: f :: Either a b -> Either a c f = \x -> case x of r @@ -146,10 +189,12 @@ There are two reasons for this: Left _ -> r <------------- NB Right _ -> error "urk" + See Note [Case 2: CSEing case binders] for the full details of this + optimization. + This is not type-safe in Core, but it is kind-safe in STG. So, using the coarser notion of kinds in STG allows us to do more aggressive - optimizations. Note, however, that we do not implement any such - optimizations yet. + optimizations. Note that the kinds do not always accurately reflect the final runtime representation. For example, on the JS backend the kind 'TYPE Int64Rep' @@ -813,7 +858,6 @@ to move these around together, notably in StgOpApp and COpStmt. Note [tagToEnum# in STG] ~~~~~~~~~~~~~~~~~~~~~~~~ - STG is untyped, but 'tagToEnum#' needs type information, so we make it a special STG operation which stores the type constructor information alongside it. @@ -833,7 +877,6 @@ To preserve this information we desugar the 'tagToEnum#' primop into a special 'StgTagToEnumOp' which has an extra field to store the type constructor information. This desugaring happens when converting Core to STG, which is the last moment that we still have access to the type information. - -} data StgOp ===================================== compiler/GHC/Stg/Unarise.hs ===================================== @@ -889,7 +889,7 @@ castArgRename ops in_arg rhs = ((op,ty,uq):rest_ops) -> let out_id' = mkCastVar uq ty -- out_name `setIdUnique` uq `setIdType` ty sub_cast = castArgRename rest_ops (StgVarArg out_id') - in mkCast in_arg op out_id' (MkStgKind (typeKind ty)) $ sub_cast rhs + in mkCast in_arg op out_id' (typeStgKind ty) $ sub_cast rhs -- Construct a case binder used when casting sums, of a given type and unique. mkCastVar :: Unique -> Type -> Id @@ -899,7 +899,7 @@ mkCast :: StgArg -> PrimOp -> OutId -> StgKind -> StgExpr -> StgExpr mkCast arg_in cast_op out_id out_kind in_rhs = let scrut = StgOpApp (StgPrimOp cast_op) [arg_in] alt = GenStgAlt { alt_con = DEFAULT, alt_bndrs = [], alt_rhs = in_rhs} - alt_ty = PrimAlt (kindPrimRep1 (getStgKind out_kind)) + alt_ty = PrimAlt (stgKindPrimRep1 out_kind) in (StgCase scrut out_id alt_ty [alt]) -- | Build a unboxed sum term from arguments of an alternative. ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -645,12 +645,6 @@ schemeE d s p (StgCase scrut _ _ []) = schemeE d s p scrut schemeE d s p (StgCase scrut bndr _ alts) = doCase d s p scrut bndr alts -stgKindPrimRepU :: StgKind -> PrimOrVoidRep -stgKindPrimRepU (MkStgKind kind) = case kindPrimRep_maybe kind of - Just [] -> VoidRep - Just [r] -> NVRep r - r -> pprPanic "stgKindPrimRepU" (ppr r) - {- Ticked Expressions ------------------ ===================================== compiler/GHC/StgToCmm/Foreign.hs ===================================== @@ -72,7 +72,7 @@ cgForeignCall :: ForeignCall -- the op cgForeignCall (CCall (CCallSpec target cconv safety)) arg_tys stg_args res_kind = do { cmm_args <- getFCallArgs stg_args arg_tys -- ; traceM $ show cmm_args - ; (res_regs, res_hints) <- newUnboxedTupleRegs (getStgKind res_kind) + ; (res_regs, res_hints) <- newUnboxedTupleRegs res_kind ; let ((call_args, arg_hints), cmm_target) = case target of StaticTarget _ _ ForeignValue -> ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -36,7 +36,6 @@ import GHC.Cmm.Graph import GHC.Stg.Syntax import GHC.Cmm import GHC.Unit ( rtsUnit ) -import GHC.Core.Type ( typeKind ) import GHC.Core.TyCon ( isEnumerationTyCon ) import GHC.Cmm.CLabel import GHC.Cmm.Info ( closureInfoPtr ) @@ -105,7 +104,7 @@ cgOpApp (StgTagToEnumOp tyc) args = do cmmPrimOpApp :: StgToCmmConfig -> PrimOp -> [CmmExpr] -> FCode ReturnKind cmmPrimOpApp cfg primop cmm_args = let PrimopCmmEmit _inline f = emitPrimOp cfg primop cmm_args - in f (MkStgKind (typeKind (primOpResultType primop))) + in f (typeStgKind (primOpResultType primop)) externalPrimop :: PrimOp -> [CmmExpr] -> PrimopCmmEmit externalPrimop primop args = outOfLinePrimop (callExternalPrimop primop args) @@ -1919,7 +1918,7 @@ emitPrimOp cfg primop = pure [reg] ReturnsTuple - -> do (regs, _hints) <- newUnboxedTupleRegs (getStgKind res_kind) + -> do (regs, _hints) <- newUnboxedTupleRegs res_kind pure regs f res_kind regs emitReturn (map (CmmReg . CmmLocal) regs) ===================================== compiler/GHC/StgToCmm/Utils.hs ===================================== @@ -50,6 +50,7 @@ module GHC.StgToCmm.Utils ( import GHC.Prelude hiding ( head, init, last, tail ) import GHC.Platform +import GHC.Stg.Syntax import GHC.StgToCmm.Monad import GHC.StgToCmm.Closure import GHC.StgToCmm.Lit (mkSimpleLit, newStringCLit) @@ -65,7 +66,6 @@ import GHC.StgToCmm.CgUtils import GHC.Types.ForeignCall import GHC.Types.Id.Info -import GHC.Core.Type import GHC.Core.TyCon import GHC.Runtime.Heap.Layout import GHC.Unit @@ -76,7 +76,6 @@ import GHC.Types.Unique import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Types.RepType import GHC.Types.CostCentre import GHC.Types.IPE @@ -320,22 +319,20 @@ assignTemp e = do { platform <- getPlatform ; emitAssign (CmmLocal reg) e ; return reg } -newUnboxedTupleRegs :: HasDebugCallStack => Kind -> FCode ([LocalReg], [ForeignHint]) +newUnboxedTupleRegs :: HasDebugCallStack => StgKind -> FCode ([LocalReg], [ForeignHint]) -- Choose suitable local regs to use for the components -- of an unboxed tuple that we are about to return to -- the Sequel. If the Sequel is a join point, using the -- regs it wants will save later assignments. newUnboxedTupleRegs res_kind - = assert (isUnboxedTupleKind res_kind) $ - case kindPrimRep_maybe res_kind of - Just reps -> - do { platform <- getPlatform - ; sequel <- getSequel - ; regs <- case sequel of - AssignTo regs _ -> regs <$ massert (regs `equalLength` reps) - _ -> mapM (newTemp . primRepCmmType platform) reps - ; return (regs, map primRepForeignHint reps) } - Nothing -> pprPanic "newUnboxedTupleRegs applied to non-unboxed-tuple kind" (ppr res_kind) + = assert (isUnboxedTupleStgKind res_kind) $ + let reps = stgKindPrimRep res_kind + in do { platform <- getPlatform + ; sequel <- getSequel + ; regs <- case sequel of + AssignTo regs _ -> regs <$ massert (regs `equalLength` reps) + _ -> mapM (newTemp . primRepCmmType platform) reps + ; return (regs, map primRepForeignHint reps) } ------------------------------------------------------------------------- -- emitMultiAssign ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -366,7 +366,7 @@ resultSize kind = result where result = result_reps `zip` result_slots result_slots = fmap (slotCount . primRepSize) result_reps - result_reps = kindPrimRep (getStgKind kind) + result_reps = stgKindPrimRep kind -- | Ensure that the set of identifiers has valid 'RuntimeRep's. This function -- returns a no-op when 'csRuntimeAssert' in 'StgToJSConfig' is False. ===================================== compiler/GHC/StgToJS/Utils.hs ===================================== @@ -205,9 +205,7 @@ typeJSRep :: HasDebugCallStack => Type -> [JSRep] typeJSRep t = map primRepToJSRep (typePrimRep t) stgKindJSRep :: HasDebugCallStack => StgKind -> [JSRep] -stgKindJSRep (MkStgKind k) = case kindPrimRep_maybe k of - Just rs -> map primRepToJSRep rs - Nothing -> pprPanic "kindJSRep" (ppr k) +stgKindJSRep = map primRepToJSRep . stgKindPrimRep -- only use if you know it's not an unboxed tuple unaryTypeJSRep :: HasDebugCallStack => UnaryType -> JSRep View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d400c2d86603e9bece2d97e24286e23… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d400c2d86603e9bece2d97e24286e23… You're receiving this email because of your account on gitlab.haskell.org.
1 0
0 0
[Git][ghc/ghc][wip/mangoiv/unused-type] compiler: rename ZonkAny to UnusedType and add pretty printing logic
by Magnus (@MangoIV) 19 Jun '26

19 Jun '26
Magnus pushed to branch wip/mangoiv/unused-type at Glasgow Haskell Compiler / GHC Commits: 79037512 by mangoiv at 2026-06-19T12:45:00+02:00 compiler: rename ZonkAny to UnusedType and add pretty printing logic ZonkAny is a hard to understand name for users who do not know how the compiler works internally. Additionally, it is confusing that ZonkAny, while being a concrete type *represents* a meta variable, espeically in the compiler output. This patch changes the name of ZonkAny to UnusedType which is closer to its intended semantics and adds special pretty printing logic to display this type in the same fashion the compiler displays meta variables in other places, whenever they leak from the implementation to the user. Fixes #27390 - - - - - 17 changed files: - + changelog.d/unused-type - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - libraries/ghc-internal/src/GHC/Internal/Types.hs - testsuite/tests/perf/compiler/T11068.stdout - testsuite/tests/pmcheck/should_compile/T12957.stderr - testsuite/tests/profiling/should_run/staticcallstack002.stdout - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T13156.stdout - testsuite/tests/simplCore/should_compile/T26615.stderr - testsuite/tests/typecheck/should_fail/T13292.stderr Changes: ===================================== changelog.d/unused-type ===================================== @@ -0,0 +1,14 @@ +section: compiler +synopsis: Rename ZonkAny to UnusedType and add pretty printing logic for it. +issues: #27390 +mrs: !16212 + +description: { + After unification GHC fills in unused type variables with a fixed kind like in + ``(length :: [alpha] -> Int) ([] :: List alpha) :: Int`` with a fixed type. + This type was, confusingly to the user, called ``ZonkAny``. + We rename this type to ``UnusedType``, store naming information, and try hard to + pretty print it to something that is more resemblant of an unused in non-debugging + compiler output. We also export ``UnusedType`` from ``GHC.Internal.Types`` to make + it easier to discover without reading the GHC source code. +} ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -1904,8 +1904,8 @@ unsatisfiableClassNameKey = mkPreludeTyConUnique 170 anyTyConKey :: Unique anyTyConKey = mkPreludeTyConUnique 171 -zonkAnyTyConKey :: Unique -zonkAnyTyConKey = mkPreludeTyConUnique 172 +unusedTypeTyConKey :: Unique +unusedTypeTyConKey = mkPreludeTyConUnique 172 -- Custom user type-errors errorMessageTypeErrorFamKey :: Unique ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -93,7 +93,7 @@ module GHC.Builtin.Types ( cTupleSelId, cTupleSelIdName, -- * Any - anyTyCon, anyTy, anyTypeOfKind, zonkAnyTyCon, + anyTyCon, anyTy, anyTypeOfKind, unusedTypeTyCon, -- * Recovery TyCon makeRecoveryTyCon, @@ -300,7 +300,7 @@ wiredInTyCons :: [TyCon] wiredInTyCons = map (dataConTyCon . snd) boxingDataCons ++ [ anyTyCon - , zonkAnyTyCon + , unusedTypeTyCon , boolTyCon , charTyCon , stringTyCon @@ -412,13 +412,13 @@ doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") {- Note [Any types] ~~~~~~~~~~~~~~~~ -The type constructors `Any` and `ZonkAny` are closed type families declared thus: +The type constructors `Any` and `UnusedType` are closed type families declared thus: - type family Any :: forall k. k where { } - type family ZonkAny :: forall k. Nat -> k where { } + type family Any :: forall k. k where { } + type family UnusedType :: forall k. Nat -> Symbol -> k where { } They are used when we want a type of a particular kind, but we don't really care -what that type is. The leading example is this: `ZonkAny` is used to instantiate +what that type is. The leading example is this: `UnusedType` is used to instantiate un-constrained type variables after type checking. For example, consider the term (length [] :: Int), where @@ -431,26 +431,26 @@ The typechecker will end up with length @alpha ([] @alpha) where `alpha` is an un-constrained unification variable. The "zonking" process zaps -that unconstrained `alpha` to an arbitrary type (ZonkAny @Type 3), where the `3` is -arbitrary (see wrinkle (Any5) below). This is done in `GHC.Tc.Zonk.Type.commitFlexi`. -So we end up with +that unconstrained `alpha` to an arbitrary type (UnusedType @Type 3 "a"), where the `3` is +arbitrary (see wrinkle (Any5) below) and "a" is the name string of the meta variable. +This is done in `GHC.Tc.Zonk.Type.commitFlexi`. So we end up with - length @(ZonkAny @Type 3) ([] @(ZonkAny @Type 3)) + length @(UnusedType @Type 3 "a") ([] @(UnusedType @Type 3 "a")) -`Any` and `ZonkAny` differ only in the presence of the `Nat` argument; see -wrinkle (Any4). +`Any` and `UnusedType` differ only in the presence of the `Nat` and the `Symbol` arguments; +see wrinkle (Any4). Wrinkles: -(Any1) `Any` and `ZonkAny` are kind polymorphic since in some program we may - need to use `ZonkAny` to fill in a type variable of some kind other than * +(Any1) `Any` and `UnusedType` are kind polymorphic since in some program we may + need to use `UnusedType` to fill in a type variable of some kind other than * (see #959 for examples). (Any2) They are /closed/ type families, with no instances. For example, suppose that with alpha :: '(k1, k2) we add a given coercion g :: alpha ~ (Fst alpha, Snd alpha) - and we zonked alpha = ZonkAny @(k1,k2) n. Then, if `ZonkAny` was a /data/ type, - we'd get inconsistency because we'd have a Given equality with `ZonkAny` on one + and we zonked alpha = UnusedType @(k1,k2) n. Then, if `UnusedType` was a /data/ type, + we'd get inconsistency because we'd have a Given equality with `UnusedType` on one side and '(,) on the other. See also #9097 and #9636. See #25244 for a suggestion that we instead use an /open/ type family for which @@ -459,8 +459,11 @@ Wrinkles: (Any3) They do not claim to be /data/ types, and that's important for the code generator, because the code gen may /enter/ a data value but never enters a function value. + This is the motivation for the primary use case of `Any` in userspace which is + implementing type safe interfaces with improved performance characteristics, + e.g. storing `Any` leaves as the values for a finite dependent Map. -(Any4) `ZonkAny` takes a `Nat` argument so that we can readily make up /distinct/ +(Any4) `UnusedType` takes a `Nat` argument so that we can readily make up /distinct/ types (#24817). Consider data SBool a where { STrue :: SBool True; SFalse :: SBool False } @@ -475,25 +478,47 @@ Wrinkles: Now, what are `alpha` and `beta`? If we zonk both of them to the same type `Any @Type`, the pattern-match checker will (wrongly) report that the first branch is inaccessible. So we zonk them to two /different/ types: - alpha := ZonkAny @Type 4 and beta := ZonkAny @Type k 5 + alpha := UnusedType @Type 4 "a" and beta := UnusedType @Type k 5 "b" (The actual numbers are arbitrary; they just need to differ.) The unique-name generation comes from field `tcg_zany_n` of `TcGblEnv`; and - `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newZonkAnyType` to + `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newUnusedTypeType` to make up a fresh type. If this example seems unconvincing (e.g. in this case foo must be bottom) see #24817 for larger but more compelling examples. -(Any5) `Any` and `ZonkAny` are wired-in so we can easily refer to it where we +(Any9) + `UnusedType` takes a `Symbol` argument, which we use to neatly display zonked unfilled + metavariables without leaking internal type families. + + See T13292 for an example of this in action. + + `UnusedType` is handled specially in the pretty-printer to avoid confusing compiler output. + For example, `UnusedType 3 "foo" :: Type` is displayed as `foo3` + + That special handling is implemented in GHC.Iface.Type.pprTyTcApp and more specifically + ppr_iface_unused_ty_tycon. + + Historical note: in the past, `UnusedType` was called `ZonkAny` (or `Any` before that). + We renamed it to `UnusedType` and added this special treatment in the pretty-printer to avoid + confusing mentions of zonking. + +(Any5) `Any` and `UnusedType` are wired-in so we can easily refer to it where we don't have a name environment (e.g. see Rules.matchRule for one example) -(Any6) `Any` is defined in library module ghc-prim:GHC.Types, and exported so that - it is available to users. For this reason it's treated like any other - wired-in type: - - has a fixed unique, anyTyConKey, +(Any6) `Any` is defined in library module ghc-internal:GHC.Internal.Types, and exported + and exported. `Any` should be available to users mainly because it is a useful type + in userspace and is thus re-exported from `GHC.Exts`. + + `UnusedType` coudl be exported mainly for documentation in case a user stumbles over it + in debug output of GHC. However, since we do want to actually have the user use that type + and discoverability of internal modules is (and should be) low, and the fact that we + cannot depend on `Natural` in ghc-internal:GHC.Internal.Types, we do not export it. + + `Any` is treated like any other wired-in types: + - it has a fixed unique, anyTyConKey - lives in the global name cache - Currently `ZonkAny` is not available to users; but it could easily be. (Any7) Properties of `Any`: * When `Any` is instantiated at a lifted type it is inhabited by at least one value, @@ -512,7 +537,7 @@ Wrinkles: See examples in ghc-prim:GHC.Types -(Any8) Warning about unused bindings of type `Any` and `ZonkAny` are suppressed, +(Any8) Warning about unused bindings of type `Any` and `UnusedType` are suppressed, following the same rationale of supressing warning about the unit type. For example, consider (#25895): @@ -520,7 +545,7 @@ Wrinkles: do { forever (return ()); blah } where forever :: forall a b. IO a -> IO b - Nothing constrains `b`, so it will be instantiates with `Any` or `ZonkAny`. + Nothing constrains `b`, so it will be instantiates with `Any` or `UnusedType`. But we certainly don't want to complain about a discarded do-binding. The Any tycon used to be quite magic, but we have since been able to @@ -550,22 +575,23 @@ anyTy = mkTyConTy anyTyCon anyTypeOfKind :: Kind -> Type anyTypeOfKind kind = mkTyConApp anyTyCon [kind] -zonkAnyTyConName :: Name -zonkAnyTyConName = - mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "ZonkAny") zonkAnyTyConKey zonkAnyTyCon +unusedTypeTyConName :: Name +unusedTypeTyConName = + mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "UnusedType") unusedTypeTyConKey unusedTypeTyCon -zonkAnyTyCon :: TyCon --- ZonkAnyTyCon :: forall k. Nat -> k +unusedTypeTyCon :: TyCon +-- unusedTypeTyCon :: forall k. Nat -> Symbol -> k -- See Note [Any types] -zonkAnyTyCon = mkFamilyTyCon zonkAnyTyConName kind bndrs 0 res_kind +unusedTypeTyCon = mkFamilyTyCon unusedTypeTyConName kind bndrs 0 res_kind Nothing (ClosedSynFamilyTyCon Nothing) Nothing NotInjective where - [kv,nat_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy] + [kv,nat_kv,sym_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy, typeSymbolKind] bndrs = [ mkNamedTyConBinder Specified kv - , mkAnonTyConBinder nat_kv ] + , mkAnonTyConBinder nat_kv + , mkAnonTyConBinder sym_kv ] res_kind = mkTyVarTy kv kind = mkTyConKind bndrs res_kind ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -1281,11 +1281,11 @@ warnDiscardedDoBindings rhs@(L rhs_loc _) m_ty elt_ty do { fam_inst_envs <- dsGetFamInstEnvs ; let norm_elt_ty = topNormaliseType fam_inst_envs elt_ty supressible_ty = - isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isZonkAnyTy norm_elt_ty + isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isUnusedTypeTy norm_elt_ty -- Warn about discarding things in 'monadic' binding, -- however few types are excluded: -- * Unit type `()` - -- * `ZonkAny` or `Any` type see (Any8) of Note [Any types] + -- * `UnusedType` or `Any` type see (Any8) of Note [Any types] ; if warn_unused && not supressible_ty then diagnosticDs (DsUnusedDoBind rhs elt_ty) else ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -7,7 +7,7 @@ This module defines interface types and binders -} -{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE MultiWayIf, OverloadedRecordDot #-} module GHC.Iface.Type ( IfExtName, IfLclName(..), mkIfLclName, ifLclNameFS, @@ -1740,6 +1740,7 @@ pprTyTcApp ctxt_prec tc tys = sdocOption sdocPrintExplicitKinds $ \print_kinds -> sdocOption sdocPrintTypeAbbreviations $ \print_type_abbreviations -> getPprDebug $ \debug -> + getPprStyle $ \style -> if | ifaceTyConName tc `hasKey` ipClassKey , IA_Arg (IfaceLitTy (IfaceStrTyLit n)) @@ -1791,6 +1792,13 @@ pprTyTcApp ctxt_prec tc tys = | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys) -> doc + -- See Note [Any types], specifically (Any4) and (Any9) + | ifaceTyConName tc `hasKey` unusedTypeTyConKey + , (arg_k : IfaceLitTy (IfaceNumTyLit arg_n) : IfaceLitTy (IfaceStrTyLit arg_nm) : _) <- appArgsIfaceTypes tys + -- if arg_k is a kind with more than 0 arguments, then _ might not be [] here + , userStyle style + -> ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm + | otherwise -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc $ appArgsIfaceTypesForAllTyFlags $ stripInvisArgs (PrintExplicitKinds print_kinds) tys @@ -1802,6 +1810,19 @@ ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case False -> pprPrefixOcc liftedTypeKindTyConName True -> maybeParen ctxt_prec starPrec starLit +-- | user-style printer that pretty-prints an 'UnusedType @k 3 "foo" to foo3. +-- If -fprint-explicit-kinds or -fprint-explicit-runtime-reps are set, instead +-- prints them to (foo3 :: k). +-- See Note [Any types], specifically (Any4) and (Any9) for why this is useful. +ppr_iface_unused_ty_tycon :: PprPrec -> IfaceType -> Integer -> LexicalFastString -> SDoc +ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm + = sdocOption sdocPrintExplicitKinds $ \print_kinds -> + sdocOption sdocPrintExplicitRuntimeReps $ \print_reps -> + if print_kinds || print_reps + then maybeParen ctxt_prec sigPrec $ prettyMeta <+> text "::" <+> pprIfaceType arg_k + else prettyMeta + where prettyMeta = ppr arg_nm <> ppr arg_n + -- | Pretty-print a type-level equality. -- Returns (Just doc) if the argument is a /saturated/ application -- of eqTyCon (~) @@ -2190,7 +2211,8 @@ instance Binary IfaceTyConSort where 0 -> return IfaceNormalTyCon 1 -> IfaceTupleTyCon <$> get bh <*> get bh 2 -> IfaceSumTyCon <$> get bh - _ -> return IfaceEqualityTyCon + 3 -> return IfaceEqualityTyCon + _ -> panic "get IfaceTyConSort" instance Binary IfaceTyConInfo where put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -582,7 +582,7 @@ data TcGblEnv -- ^ Allows us to choose unique DFun names. tcg_zany_n :: TcRef Integer, - -- ^ A source of unique identities for ZonkAny instances + -- ^ A source of unique identities for UnusedType instances -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) tcg_merged :: [(Module, Fingerprint)], ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -154,7 +154,7 @@ module GHC.Tc.Utils.Monad( getCCIndexM, getCCIndexTcM, -- * Zonking - liftZonkM, newZonkAnyType, + liftZonkM, newUnusedType, -- * Complete matches localAndImportedCompleteMatches, getCompleteMatchesTcM, @@ -168,7 +168,7 @@ import GHC.Prelude import GHC.Builtin.Names -import GHC.Builtin.Types( zonkAnyTyCon ) +import GHC.Builtin.Types( unusedTypeTyCon ) import GHC.Tc.Errors.Types import GHC.Tc.Errors.Hole.Plugin ( HoleFitPlugin, HoleFitPluginR (..) ) @@ -197,7 +197,7 @@ import GHC.Core.Coercion ( isReflCo ) import GHC.Core.Multiplicity import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import GHC.Core.Type( mkNumLitTy ) +import GHC.Core.Type( mkNumLitTy, mkStrLitTy ) import GHC.Core.TyCo.Rep( CoercionHole(..) ) import GHC.Core.TyCo.FVs( coVarsOfCo ) import GHC.Core.TyCon ( TyCon ) @@ -2258,17 +2258,17 @@ chooseUniqueOccTc fn = ; writeTcRef dfun_n_var (extendOccSet set occ) ; return occ } -newZonkAnyType :: Kind -> TcM Type --- Return a type (ZonkAny @k n), where n is fresh --- Recall ZonkAny :: forall k. Natural -> k +newUnusedType :: Name -> Kind -> TcM Type +-- Return a type (UnusedType @k n sym), where n is fresh +-- Recall UnusedType :: forall k. Natural -> Symbol -> k -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) -newZonkAnyType kind +newUnusedType name kind = do { env <- getGblEnv ; let zany_n_var = tcg_zany_n env ; i <- readTcRef zany_n_var ; let !i2 = i+1 ; writeTcRef zany_n_var i2 - ; return (mkTyConApp zonkAnyTyCon [kind, mkNumLitTy i]) } + ; return (mkTyConApp unusedTypeTyCon [kind, mkNumLitTy i, mkStrLitTy $ getOccFS name ]) } getConstraintVar :: TcM (TcRef WantedConstraints) getConstraintVar = do { env <- getLclEnv; return (tcl_lie env) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -85,7 +85,7 @@ module GHC.Tc.Utils.TcType ( isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy, isFloatingPrimTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, - isBoolTy, isUnitTy, isAnyTy, isZonkAnyTy, isCharTy, + isBoolTy, isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy, isTauTy, isTauTyCon, tcIsTyVarTy, isPredTy, isSimplePredTy, isTyVarClassPred, checkValidClsArgs, hasTyVarHead, @@ -2057,7 +2057,7 @@ isFloatTy, isDoubleTy, isFloatPrimTy, isDoublePrimTy, isIntegerTy, isNaturalTy, isIntTy, isWordTy, isBoolTy, - isUnitTy, isAnyTy, isZonkAnyTy, isCharTy :: Type -> Bool + isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy :: Type -> Bool isFloatTy = is_tc floatTyConKey isDoubleTy = is_tc doubleTyConKey isFloatPrimTy = is_tc floatPrimTyConKey @@ -2069,7 +2069,7 @@ isWordTy = is_tc wordTyConKey isBoolTy = is_tc boolTyConKey isUnitTy = is_tc unitTyConKey isAnyTy = is_tc anyTyConKey -isZonkAnyTy = is_tc zonkAnyTyConKey +isUnusedTypeTy = is_tc unusedTypeTyConKey isCharTy = is_tc charTyConKey -- | Check whether the type is of the form @Any :: k@, ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedRecordDot #-} {- (c) The University of Glasgow 2006 (c) The AQUA Project, Glasgow University, 1996-1998 @@ -43,7 +44,7 @@ import GHC.Tc.Types.TcRef import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo ) import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) import GHC.Tc.Utils.TcType -import GHC.Tc.Utils.Monad ( newZonkAnyType, setSrcSpanA, liftZonkM, traceTc, addErr ) +import GHC.Tc.Utils.Monad ( newUnusedType, setSrcSpanA, liftZonkM, traceTc, addErr ) import GHC.Tc.Types.Evidence import GHC.Tc.Errors.Types import GHC.Tc.Zonk.Env @@ -470,11 +471,11 @@ commitFlexi DefaultFlexi tv zonked_kind ; return manyDataConTy } | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv = do { addErr $ TcRnZonkerMessage (ZonkerCannotDefaultConcrete origin) - ; newZonkAnyType zonked_kind } + ; newUnusedType tv.varName zonked_kind } | otherwise - = do { traceTc "Defaulting flexi tyvar to ZonkAny:" (pprTyVar tv) + = do { traceTc "Defaulting flexi tyvar to UnusedType:" (pprTyVar tv) -- See Note [Any types] in GHC.Builtin.Types, esp wrinkle (Any4) - ; newZonkAnyType zonked_kind } + ; newUnusedType tv.varName zonked_kind } zonkCoVarOcc :: CoVar -> ZonkTcM Coercion zonkCoVarOcc cv ===================================== libraries/ghc-internal/src/GHC/Internal/Types.hs ===================================== @@ -35,6 +35,7 @@ module GHC.Internal.Types ( SPEC(..), Symbol, Any, + UnusedType, -- * Type equality type (~), type (~~), Coercible, @@ -284,43 +285,33 @@ data Symbol * * ********************************************************************* -} --- | The type constructor @Any :: forall k. k@ is a type to which you can unsafely coerce any type, and back. +-- | The type constructor @Any :: forall k. k@ allows creating an arbitrary type +-- of the given kind. -- --- For @unsafeCoerce@ this means for all lifted types @t@ that --- @unsafeCoerce (unsafeCoerce x :: Any) :: t@ is equivalent to @x@ and safe. +-- It can be used to create a placeholder type when you only have a kind in hand. -- --- The same is true for *all* types when using --- @ --- unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) --- (a :: TYPE r1) (b :: TYPE r2). --- a -> b --- @ --- but /only/ if you instantiate @r1@ and @r2@ to the /same/ runtime representation. --- For example using @(unsafeCoerce# :: forall (a :: TYPE IntRep) (b :: TYPE IntRep). a -> b) x@ --- is fine, but @(unsafeCoerce# :: forall (a :: TYPE IntRep) (b :: TYPE FloatRep). a -> b)@ --- will likely cause seg-faults or worse. --- For this resason, users should always prefer unsafeCoerce over unsafeCoerce# when possible. +-- You can use 'unsafeCoerce#' to unsafely coerce a value from @ty :: k@ to @Any \@k@ +-- and back. As per the documentation of 'unsafeCoerce#', this is only sound if both +-- sides have the __exact same__runtime representation. Some examples: -- --- Here are some more examples: -- @ --- bad_a1 :: Any @(TYPE 'IntRep) --- bad_a1 = unsafeCoerce# True --- --- bad_a2 :: Any @(TYPE ('BoxedRep 'UnliftedRep)) --- bad_a2 = unsafeCoerce# True +-- unsafeCoerce# True :: (Any :: Type) -- OK +-- unsafeCoerce# (1# :: Int#) :: (Any :: TYPE IntRep) -- OK +-- unsafeCoerce# True :: (Any :: Type IntRep) -- INVALID +-- unsafeCoerce True :: (Any :: UnliftedType) -- INVALID +-- unsafeCoerce (ba :: ByteArray#) :: (Any :: Type) -- INVALID -- @ --- Here @bad_a1@ is bad because we started with @True :: (Bool :: Type)@, represented by a boxed heap pointer, --- and coerced it to @a1 :: Any @(TYPE 'IntRep)@, whose representation is a non-pointer integer. --- That's why we had to use `unsafeCoerce#`; it is really unsafe because it can change representations. --- Similarly @bad_a2@ is bad because although both @True@ and @bad_a2@ are represented by a heap pointer, --- @True@ is lifted but @bad_a2@ is not; bugs here may be rather subtle. -- --- If you must use unsafeCoerce# to cast to `Any`, type annotations are recommended --- to make sure that @Any@ has the correct kind. As casting between different runtimereps is --- unsound. For example to cast a @ByteArray#@ to @Any@ you might use: --- @ --- unsafeCoerce# b :: (Any :: TYPE ('BoxedRep 'Unlifted)) --- @ +-- To avoid accidentally unsafe-coercing between different representations, +-- it is recommended to: +-- - use explicit type annotations or type applications at every use-site +-- of 'unsafeCoerce#' +-- - use representation-monomorphic variants such as 'unsafeCoerce' or +-- 'unsafeCoerceUnlifted'. +-- +-- In particular, this also implies it is safe to round-trip unsafe-coercion via 'Any', +-- as long as the kinds line up e.g. @unsafeCoerce (unsafeCoerce (val :: a) :: 'Any') :: a@ +-- is safe in that way. type family Any :: k where { } -- See Note [Any types] in GHC.Builtin.Types. Also, for a bit of history on Any see -- #10886. Note that this must be a *closed* type family: we need to ensure ===================================== testsuite/tests/perf/compiler/T11068.stdout ===================================== @@ -23,137 +23,137 @@ `cast` (GHC.Internal.Generics.N:M1 `cast` (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 ===================================== testsuite/tests/pmcheck/should_compile/T12957.stderr ===================================== @@ -1,7 +1,6 @@ T12957.hs:4:5: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive - In a case alternative: - Patterns of type ‘[GHC.Internal.Types.ZonkAny 0]’ not matched: [] + In a case alternative: Patterns of type ‘[a0]’ not matched: [] T12957.hs:4:16: warning: [GHC-53633] [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant ===================================== testsuite/tests/profiling/should_run/staticcallstack002.stdout ===================================== @@ -1,4 +1,4 @@ -Just (InfoProv {ipName = "sat_s1Rh_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 0", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) -Just (InfoProv {ipName = "sat_s1RB_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 1", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) -Just (InfoProv {ipName = "sat_s1RV_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 2", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) -Just (InfoProv {ipName = "sat_s1Sf_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 3", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) +Just (InfoProv {ipName = "main_sat_t2fs_info", ipDesc = THUNK, ipTyDesc = "UnusedType 0 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) +Just (InfoProv {ipName = "main_sat_t2fJ_info", ipDesc = THUNK, ipTyDesc = "UnusedType 1 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) +Just (InfoProv {ipName = "main_sat_t2g0_info", ipDesc = THUNK, ipTyDesc = "UnusedType 2 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) +Just (InfoProv {ipName = "main_sat_t2gh_info", ipDesc = THUNK, ipTyDesc = "UnusedType 3 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -188,7 +188,7 @@ T13155: T13156: $(RM) -f T13156.hi T13156.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T13156.hs -O -ddump-prep -dsuppress-uniques | grep "case.*Any" + '$(TEST_HC)' $(TEST_HC_OPTS) -c T13156.hs -O -ddump-prep -dsuppress-uniques | grep "case.*UnusedType" # There should be a single 'case r @ GHC.Types.Any' .PHONY: T4138 ===================================== testsuite/tests/simplCore/should_compile/T13156.stdout ===================================== @@ -1,2 +1,2 @@ - case r @(GHC.Internal.Types.ZonkAny 0) of { __DEFAULT -> - case r @(GHC.Internal.Types.ZonkAny 1) of { __DEFAULT -> r @a } + case r @(GHC.Internal.Types.UnusedType 0 "a") of { __DEFAULT -> + case r @(GHC.Internal.Types.UnusedType 1 "a") of { __DEFAULT -> ===================================== testsuite/tests/simplCore/should_compile/T26615.stderr ===================================== @@ -2,7 +2,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 1,209, types: 1,139, coercions: 18, joins: 17/29} + = {terms: 1,209, types: 1,155, coercions: 18, joins: 17/29} -- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} unArray :: forall a. Array a -> SmallArray# a @@ -15,45 +15,29 @@ unArray :: forall a. Array a -> SmallArray# a unArray = \ (@a) (ds :: Array a) -> case ds of { Array ds1 -> ds1 } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule4 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$trModule4 = "main"# +$trModule1 :: Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule3 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule3 = GHC.Internal.Types.TrNameS T26615a.$trModule4 +$trModule2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$trModule2 = "T26615a"# +$trModule3 :: Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "T26615a"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule1 = GHC.Internal.Types.TrNameS T26615a.$trModule2 +$trModule4 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule :: GHC.Internal.Types.Module -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule - = GHC.Internal.Types.Module T26615a.$trModule3 T26615a.$trModule1 +T26615a.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module +[GblId, Unf=OtherCon []] +T26615a.$trModule = GHC.Internal.Types.Module $trModule2 $trModule4 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Internal.Types.KindRep @@ -104,33 +88,24 @@ $krep6 GHC.Internal.Types.$tcSmallArray# $krep5 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$tcLeaf2 = "Leaf"# +$tcLeaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tcLeaf1 = "Leaf"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcLeaf1 = GHC.Internal.Types.TrNameS T26615a.$tcLeaf2 +$tcLeaf2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcLeaf2 = GHC.Internal.Types.TrNameS $tcLeaf1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcLeaf [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcLeaf = GHC.Internal.Types.TyCon 13798714324392902582#Word64 3237499036029031497#Word64 T26615a.$trModule - T26615a.$tcLeaf1 + $tcLeaf2 0# GHC.Internal.Types.krep$*->*->* @@ -160,372 +135,284 @@ $krep10 :: GHC.Internal.Types.KindRep $krep10 = GHC.Internal.Types.KindRepFun $krep2 $krep9 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep11 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'L1 = GHC.Internal.Types.KindRepFun $krep3 $krep10 +$krep11 = GHC.Internal.Types.KindRepFun $krep3 $krep10 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$tc'L3 = "'L"# +$tc'L1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'L1 = "'L"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'L2 = GHC.Internal.Types.TrNameS T26615a.$tc'L3 +$tc'L2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'L2 = GHC.Internal.Types.TrNameS $tc'L1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'L [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'L = GHC.Internal.Types.TyCon 8570419491837374712#Word64 2090006989092642392#Word64 T26615a.$trModule - T26615a.$tc'L2 + $tc'L2 2# - T26615a.$tc'L1 + $krep11 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tcArray2 = "Array"# +$tcArray1 :: Addr# +[GblId, Unf=OtherCon []] +$tcArray1 = "Array"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcArray1 = GHC.Internal.Types.TrNameS T26615a.$tcArray2 +$tcArray2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcArray2 = GHC.Internal.Types.TrNameS $tcArray1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcArray [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcArray = GHC.Internal.Types.TyCon 10495761415291712389#Word64 7580086293698619153#Word64 T26615a.$trModule - T26615a.$tcArray1 + $tcArray2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11 :: GHC.Internal.Types.KindRep +$krep12 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep11 +$krep12 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep4 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep13 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Array1 = GHC.Internal.Types.KindRepFun $krep6 $krep11 +$krep13 = GHC.Internal.Types.KindRepFun $krep6 $krep12 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Array3 = "'Array"# +$tc'Array1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Array1 = "'Array"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Array2 = GHC.Internal.Types.TrNameS T26615a.$tc'Array3 +$tc'Array2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Array2 = GHC.Internal.Types.TrNameS $tc'Array1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Array [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Array = GHC.Internal.Types.TyCon 12424115309881832159#Word64 15542868641947707803#Word64 T26615a.$trModule - T26615a.$tc'Array2 + $tc'Array2 1# - T26615a.$tc'Array1 + $krep13 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep12 :: [GHC.Internal.Types.KindRep] +$krep14 :: [GHC.Internal.Types.KindRep] [GblId, Unf=OtherCon []] -$krep12 +$krep14 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep9 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep13 :: GHC.Internal.Types.KindRep +$krep15 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep13 - = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep12 +$krep15 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep14 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tcHashMap2 = "HashMap"# +$tcHashMap1 :: Addr# +[GblId, Unf=OtherCon []] +$tcHashMap1 = "HashMap"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcHashMap1 - = GHC.Internal.Types.TrNameS T26615a.$tcHashMap2 +$tcHashMap2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcHashMap2 = GHC.Internal.Types.TrNameS $tcHashMap1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcHashMap [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcHashMap = GHC.Internal.Types.TyCon 2021755758654901686#Word64 8209241086311595496#Word64 T26615a.$trModule - T26615a.$tcHashMap1 + $tcHashMap2 0# GHC.Internal.Types.krep$*->*->* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep16 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Empty1 +$krep16 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcHashMap $krep8 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Empty3 = "'Empty"# +$tc'Empty1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Empty1 = "'Empty"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Empty2 = GHC.Internal.Types.TrNameS T26615a.$tc'Empty3 +$tc'Empty2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Empty2 = GHC.Internal.Types.TrNameS $tc'Empty1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Empty [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Empty = GHC.Internal.Types.TyCon 2520556399233147460#Word64 17224648764450205443#Word64 T26615a.$trModule - T26615a.$tc'Empty2 + $tc'Empty2 2# - T26615a.$tc'Empty1 + $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep14 :: GHC.Internal.Types.KindRep +$krep17 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep14 = GHC.Internal.Types.KindRepFun $krep9 T26615a.$tc'Empty1 +$krep17 = GHC.Internal.Types.KindRepFun $krep9 $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep18 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Leaf1 = GHC.Internal.Types.KindRepFun $krep1 $krep14 +$krep18 = GHC.Internal.Types.KindRepFun $krep1 $krep17 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Leaf3 = "'Leaf"# +$tc'Leaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Leaf1 = "'Leaf"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Leaf2 = GHC.Internal.Types.TrNameS T26615a.$tc'Leaf3 +$tc'Leaf2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Leaf2 = GHC.Internal.Types.TrNameS $tc'Leaf1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Leaf [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Leaf = GHC.Internal.Types.TyCon 5773656560257991946#Word64 17028074687139582545#Word64 T26615a.$trModule - T26615a.$tc'Leaf2 + $tc'Leaf2 2# - T26615a.$tc'Leaf1 + $krep18 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep15 :: GHC.Internal.Types.KindRep +$krep19 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep15 = GHC.Internal.Types.KindRepFun $krep13 T26615a.$tc'Empty1 +$krep19 = GHC.Internal.Types.KindRepFun $krep15 $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep20 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Collision1 - = GHC.Internal.Types.KindRepFun $krep1 $krep15 +$krep20 = GHC.Internal.Types.KindRepFun $krep1 $krep19 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 40 0}] -T26615a.$tc'Collision3 = "'Collision"# +$tc'Collision1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Collision1 = "'Collision"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Collision2 - = GHC.Internal.Types.TrNameS T26615a.$tc'Collision3 +$tc'Collision2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Collision2 = GHC.Internal.Types.TrNameS $tc'Collision1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Collision [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Collision = GHC.Internal.Types.TyCon 18175105753528304021#Word64 13986842878006680511#Word64 T26615a.$trModule - T26615a.$tc'Collision2 + $tc'Collision2 2# - T26615a.$tc'Collision1 + $krep20 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep16 :: [GHC.Internal.Types.KindRep] +$krep21 :: [GHC.Internal.Types.KindRep] [GblId, Unf=OtherCon []] -$krep16 +$krep21 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep - T26615a.$tc'Empty1 + $krep16 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep17 :: GHC.Internal.Types.KindRep +$krep22 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep17 - = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep16 +$krep22 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep21 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep23 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Full1 - = GHC.Internal.Types.KindRepFun $krep17 T26615a.$tc'Empty1 +$krep23 = GHC.Internal.Types.KindRepFun $krep22 $krep16 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Full3 = "'Full"# +$tc'Full1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Full1 = "'Full"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Full2 = GHC.Internal.Types.TrNameS T26615a.$tc'Full3 +$tc'Full2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Full2 = GHC.Internal.Types.TrNameS $tc'Full1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Full [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Full = GHC.Internal.Types.TyCon 12008762105994325570#Word64 13514145886440831186#Word64 T26615a.$trModule - T26615a.$tc'Full2 + $tc'Full2 2# - T26615a.$tc'Full1 + $krep23 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed1 [InlPrag=[~]] - :: GHC.Internal.Types.KindRep +$krep24 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'BitmapIndexed1 - = GHC.Internal.Types.KindRepFun $krep1 T26615a.$tc'Full1 +$krep24 = GHC.Internal.Types.KindRepFun $krep1 $krep23 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 50 0}] -T26615a.$tc'BitmapIndexed3 = "'BitmapIndexed"# +$tc'BitmapIndexed1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'BitmapIndexed1 = "'BitmapIndexed"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'BitmapIndexed2 - = GHC.Internal.Types.TrNameS T26615a.$tc'BitmapIndexed3 +$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'BitmapIndexed2 = GHC.Internal.Types.TrNameS $tc'BitmapIndexed1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'BitmapIndexed [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'BitmapIndexed = GHC.Internal.Types.TyCon 15226751910432948177#Word64 957331387129868915#Word64 T26615a.$trModule - T26615a.$tc'BitmapIndexed2 + $tc'BitmapIndexed2 2# - T26615a.$tc'BitmapIndexed1 + $krep24 -- RHS size: {terms: 98, types: 109, coercions: 0, joins: 3/4} T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] @@ -538,7 +425,7 @@ T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] Str=<LP(SC(S,C(1,L)),A)><L><1L><L><L>, Unf=Unf{Src=StableUser, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [30 0 20 0 0] 406 10 + Guidance=IF_ARGS [90 0 20 0 0] 406 10 Tmpl= \ (@k) (@a) (@b) @@ -586,7 +473,7 @@ T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary1 [Occ=Once1!] :: Array (Leaf k b)) (i1 [Occ=Once1!] :: Int) @@ -654,24 +541,23 @@ T26615a.$wdisjointCollisions $s$wfoldr_ [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Bool -> Int# -> Int# -> SmallArray# (Leaf k a) -> Bool + :: SmallArray# (Leaf k a) -> Int# -> Int# -> Bool -> Bool [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><L><L><L>, Unf=OtherCon []] - $s$wfoldr_ (sc :: Bool) + $s$wfoldr_ (sc :: SmallArray# (Leaf k a)) (sc1 :: Int#) (sc2 :: Int#) - (sc3 :: SmallArray# (Leaf k a)) - = case >=# sc1 sc2 of { + (sc3 :: Bool) + = case >=# sc2 sc1 of { __DEFAULT -> - case indexSmallArray# @Lifted @(Leaf k a) sc3 sc1 of - { (# ipv1 #) -> + case indexSmallArray# @Lifted @(Leaf k a) sc sc2 of { (# ipv1 #) -> case ipv1 of { L kA ds1 -> join { $j :: Bool [LclId[JoinId(0)(Nothing)]] - $j = jump $s$wfoldr_ sc (+# sc1 1#) sc2 sc3 } in + $j = jump $s$wfoldr_ sc sc1 (+# sc2 1#) sc3 } in joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, @@ -703,13 +589,13 @@ T26615a.$wdisjointCollisions jump $wlookupInArrayCont_ kA ww2 0# lvl2 } }; - 1# -> sc + 1# -> sc3 }; } in jump $s$wfoldr_ - GHC.Internal.Types.True - 0# - (sizeofSmallArray# @Lifted @(Leaf k a) ipv) ipv + (sizeofSmallArray# @Lifted @(Leaf k a) ipv) + 0# + GHC.Internal.Types.True } } @@ -728,28 +614,28 @@ Rec { -- RHS size: {terms: 133, types: 126, coercions: 0, joins: 1/2} T26615a.disjointSubtrees_$s$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] - :: forall b a k. - Word# - -> SmallArray# (Leaf k a) -> Int# -> Eq k => HashMap k b -> Bool + :: forall k a b. + Eq k => + Int# -> Word# -> SmallArray# (Leaf k a) -> HashMap k b -> Bool [GblId[StrictWorker([~, ~, ~, ~, !])], Arity=5, - Str=<L><L><L><LP(SC(S,C(1,L)),A)><1L>, + Str=<LP(SC(S,C(1,L)),A)><L><L><L><1L>, Unf=OtherCon []] T26615a.disjointSubtrees_$s$wdisjointSubtrees - = \ (@b) + = \ (@k) (@a) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) - (sc2 :: Int#) - (sc3 :: Eq k) + (@b) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k a)) (_b :: HashMap k b) -> case _b of { Empty -> GHC.Internal.Types.True; Leaf bx ds -> case ds of { L kB ds1 -> case kB of k0 { __DEFAULT -> - case eqWord# bx sc of { + case eqWord# bx sc2 of { __DEFAULT -> GHC.Internal.Types.True; 1# -> joinrec { @@ -770,7 +656,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees __DEFAULT -> case indexSmallArray# @Lifted @(Leaf k a) ww ww1 of { (# ipv #) -> case ipv of { L kx v -> - case == @k sc3 k2 kx of { + case == @k sc k2 kx of { False -> jump $wlookupInArrayCont_ k2 ww (+# ww1 1#) ww2; True -> GHC.Internal.Types.False } @@ -780,19 +666,19 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - k0 sc1 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc1) + k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3) } } }; Collision bx bx1 -> T26615a.$wdisjointCollisions - @k @a @b sc3 sc (T26615a.Array @(Leaf k a) sc1) bx bx1; + @k @a @b sc sc2 (T26615a.Array @(Leaf k a) sc3) bx bx1; BitmapIndexed bx bx1 -> let { m :: Word# [LclId] m = uncheckedShiftL# - 1## (word2Int# (and# (uncheckedShiftRL# sc sc2) 31##)) } in + 1## (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) } in case and# m bx of { __DEFAULT -> case indexSmallArray# @@ -803,7 +689,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 (+# sc2 5#) sc3 ipv + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv }; 0## -> GHC.Internal.Types.True }; @@ -812,17 +698,17 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees @Lifted @(HashMap k b) bx - (word2Int# (and# (uncheckedShiftRL# sc sc2) 31##)) + (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 (+# sc2 5#) sc3 ipv + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv } } end Rec } Rec { --- RHS size: {terms: 705, types: 732, coercions: 18, joins: 13/23} +-- RHS size: {terms: 705, types: 748, coercions: 18, joins: 13/23} T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] :: forall k a b. Eq k => Int# -> HashMap k a -> HashMap k b -> Bool [GblId[StrictWorker([~, ~, !])], @@ -841,7 +727,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] join { fail [Occ=Once3!T[1]] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of wild [Occ=Once1] { __DEFAULT -> case GHC.Internal.Control.Exception.Base.patError @@ -860,7 +746,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupCont_ _ [Occ=Dead] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) (ds4 [Occ=Once1!] :: Word) (ds5 [Occ=Once1] :: k) (ds6 [Occ=Once1!] :: Int) @@ -896,7 +782,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary [Occ=Once1!] :: Array (Leaf k a)) (i [Occ=Once1!] :: Int) @@ -1000,7 +886,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupCont_ _ [Occ=Dead] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) (ds3 [Occ=Once1!] :: Word) (ds4 [Occ=Once1] :: k) (ds5 [Occ=Once1!] :: Int) @@ -1034,7 +920,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary [Occ=Once1!] :: Array (Leaf k b)) (i [Occ=Once1!] :: Int) @@ -1179,23 +1065,23 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -1324,51 +1210,49 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] }; } in jump go (GHC.Internal.Types.W# (and# 4294967295## bx1)); Full bx1 -> + joinrec { + go [Occ=LoopBreakerT[1]] :: Int -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + go (i :: Int) + = case GHC.Internal.Classes.ltInt i (GHC.Internal.Types.I# 0#) of { + False -> + case i of { I# i# -> + case indexSmallArray# @Lifted @(HashMap k a) bx i# of + { (# ipv [Occ=Once1] #) -> + case indexSmallArray# @Lifted @(HashMap k b) bx1 i# of + { (# ipv1 [Occ=Once1] #) -> + case T26615a.$wdisjointSubtrees @k @a @b $dEq (+# ww 5#) ipv ipv1 + of { + False -> GHC.Internal.Types.False; + True -> jump go (GHC.Internal.Types.I# (-# i# 1#)) + } + } + } + }; + True -> GHC.Internal.Types.True + }; } in case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { - __DEFAULT -> - joinrec { - go [Occ=LoopBreakerT[1]] :: Int -> Bool - [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] - go (i :: Int) - = case GHC.Internal.Classes.ltInt i (GHC.Internal.Types.I# 0#) of { - False -> - case i of { I# i# -> - case indexSmallArray# @Lifted @(HashMap k a) bx i# of - { (# ipv [Occ=Once1] #) -> - case indexSmallArray# @Lifted @(HashMap k b) bx1 i# of - { (# ipv1 [Occ=Once1] #) -> - case T26615a.$wdisjointSubtrees - @k @a @b $dEq (+# ww 5#) ipv ipv1 - of { - False -> GHC.Internal.Types.False; - True -> jump go (GHC.Internal.Types.I# (-# i# 1#)) - } - } - } - }; - True -> GHC.Internal.Types.True - }; } in - jump go (GHC.Internal.Types.I# 31#); + __DEFAULT -> jump go (GHC.Internal.Types.I# 31#); 1# -> GHC.Internal.Types.False } } @@ -1385,7 +1269,7 @@ T26615a.$wdisjointSubtrees join { fail [Dmd=MC(1,L)] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of { __DEFAULT -> case lvl1 of {}; Empty -> GHC.Internal.Types.True; @@ -1508,7 +1392,7 @@ T26615a.$wdisjointSubtrees }; Collision bx bx1 -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @a @b @k bx bx1 ww $dEq ds + @k @b @a $dEq ww bx bx1 ds } } in case ds of { Empty -> GHC.Internal.Types.True; @@ -1661,7 +1545,7 @@ T26615a.$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k bx bx1 (+# ww 5#) $dEq ipv + @k @a @b $dEq (+# ww 5#) bx bx1 ipv }; 0## -> GHC.Internal.Types.True }; @@ -1674,7 +1558,7 @@ T26615a.$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k bx bx1 (+# ww 5#) $dEq ipv + @k @a @b $dEq (+# ww 5#) bx bx1 ipv } }; BitmapIndexed bx bx1 -> @@ -1686,21 +1570,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) - :: SmallArray# (HashMap k a) ~R# GHC.Internal.Types.ZonkAny 0)) + :: SmallArray# (HashMap k a) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) - :: SmallArray# (HashMap k b) ~R# GHC.Internal.Types.ZonkAny 1)) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> let { @@ -1829,21 +1715,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) - :: SmallArray# (HashMap k a) ~R# GHC.Internal.Types.ZonkAny 0)) + :: SmallArray# (HashMap k a) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) - :: SmallArray# (HashMap k b) ~R# GHC.Internal.Types.ZonkAny 1)) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> let { @@ -1910,88 +1798,72 @@ disjointSubtrees ------ Local rules for imported ids -------- "SC:$wdisjointSubtrees1" [1] - forall (@a) + forall (@k) (@b) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) + (@a) + (sc :: Eq k) + (sc1 :: Int#) (sc2 :: Word#) (sc3 :: SmallArray# (Leaf k b)) - (sc4 :: Int#) - (sc5 :: Eq k). + (sc4 :: Word#) + (sc5 :: SmallArray# (Leaf k a)). T26615a.$wdisjointSubtrees @k @b @a - sc5 - sc4 + sc + sc1 (T26615a.Collision @k @b sc2 sc3) - (T26615a.Collision @k @a sc sc1) + (T26615a.Collision @k @a sc4 sc5) = T26615a.$wdisjointCollisions - @k @b @a sc5 sc2 (T26615a.Array @(Leaf k b) sc3) sc sc1 + @k @b @a sc sc2 (T26615a.Array @(Leaf k b) sc3) sc4 sc5 "SC:$wdisjointSubtrees0" [1] - forall (@b) + forall (@k) (@a) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) - (sc2 :: Int#) - (sc3 :: Eq k). + (@b) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k a)). T26615a.$wdisjointSubtrees @k @a @b - sc3 - sc2 - (T26615a.Collision @k @a sc sc1) + sc + sc1 + (T26615a.Collision @k @a sc2 sc3) = T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 sc2 sc3 + @k @a @b sc sc1 sc2 sc3 [2 of 2] Compiling T26615 ( T26615.hs, T26615.o ) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 614, types: 666, coercions: 18, joins: 8/14} + = {terms: 614, types: 682, coercions: 18, joins: 8/14} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule2 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615.$trModule2 = "T26615"# +$trModule1 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "T26615"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule1 = GHC.Internal.Types.TrNameS T26615.$trModule2 +$trModule2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule4 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615.$trModule4 = "main"# +$trModule3 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule3 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule3 = GHC.Internal.Types.TrNameS T26615.$trModule4 +$trModule4 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule :: GHC.Internal.Types.Module -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule - = GHC.Internal.Types.Module T26615.$trModule3 T26615.$trModule1 +T26615.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module +[GblId, Unf=OtherCon []] +T26615.$trModule = GHC.Internal.Types.Module $trModule4 $trModule2 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} lvl :: GHC.Internal.Prim.Addr# @@ -2128,7 +2000,7 @@ $wpoly_lookupCont_ end Rec } Rec { --- RHS size: {terms: 448, types: 507, coercions: 18, joins: 8/13} +-- RHS size: {terms: 448, types: 523, coercions: 18, joins: 8/13} T26615.$s$wdisjointSubtrees [InlPrag=[~], Occ=LoopBreaker] :: forall a b. GHC.Internal.Prim.Int# @@ -2143,7 +2015,7 @@ T26615.$s$wdisjointSubtrees join { fail [Dmd=MC(1,L)] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of wild { __DEFAULT -> case lvl1 of {}; T26615a.Empty -> GHC.Internal.Types.True; @@ -2190,30 +2062,28 @@ T26615.$s$wdisjointSubtrees $s$wfoldr_ [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Bool - -> GHC.Internal.Prim.Int# - -> GHC.Internal.Prim.Int# - -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a) - -> Bool + :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a) + -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> Bool -> Bool [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><L><L><L>, Unf=OtherCon []] - $s$wfoldr_ (sc :: Bool) + $s$wfoldr_ (sc + :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)) (sc1 :: GHC.Internal.Prim.Int#) (sc2 :: GHC.Internal.Prim.Int#) - (sc3 :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)) - = case GHC.Internal.Prim.>=# sc1 sc2 of { + (sc3 :: Bool) + = case GHC.Internal.Prim.>=# sc2 sc1 of { __DEFAULT -> case GHC.Internal.Prim.indexSmallArray# - @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) sc3 sc1 + @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) sc sc2 of { (# ipv1 #) -> case ipv1 of { T26615a.L kA ds2 -> join { $j :: Bool [LclId[JoinId(0)(Nothing)]] - $j = jump $s$wfoldr_ sc (GHC.Internal.Prim.+# sc1 1#) sc2 sc3 } in + $j = jump $s$wfoldr_ sc sc1 (GHC.Internal.Prim.+# sc2 1#) sc3 } in joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, @@ -2258,14 +2128,14 @@ T26615.$s$wdisjointSubtrees jump $wlookupInArrayCont_ kA bx3 0# lvl2 } }; - 1# -> sc + 1# -> sc3 }; } in jump $s$wfoldr_ - GHC.Internal.Types.True - 0# + bx1 (GHC.Internal.Prim.sizeofSmallArray# @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) bx1) - bx1 + 0# + GHC.Internal.Types.True }; T26615a.BitmapIndexed bx2 bx3 -> let { @@ -2317,23 +2187,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -2495,23 +2365,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -2564,7 +2434,7 @@ f = \ (@a) ------ Local rules for imported ids -------- "SPEC/T26615 $wdisjointSubtrees @String @_ @_" [2] - forall (@a) (@b) ($dEq :: Eq String). + forall (@a) (@b) ($dEq [Occ=Dead] :: Eq String). T26615a.$wdisjointSubtrees @String @a @b $dEq = T26615.$s$wdisjointSubtrees @a @b ===================================== testsuite/tests/typecheck/should_fail/T13292.stderr ===================================== @@ -14,15 +14,15 @@ T13292a.hs:4:12: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] In an equation for ‘someFunc’: someFunc = return () T13292.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘GHC.Internal.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m00’ with ‘IO’ Expected: IO () - Actual: GHC.Internal.Types.ZonkAny 0 () + Actual: m00 • When checking the type of the IO action ‘main’ T13292.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘GHC.Internal.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m00’ with ‘IO’ Expected: IO () - Actual: GHC.Internal.Types.ZonkAny 0 () + Actual: m00 • In the expression: main When checking the type of the IO action ‘main’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/79037512267b30e225dcc713d5d3728… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/79037512267b30e225dcc713d5d3728… You're receiving this email because of your account on gitlab.haskell.org.
1 0
0 0
[Git][ghc/ghc][wip/davide/windows-dlls] WIP place SRT info tables into .rdata on windows
by David Eichmann (@DavidEichmann) 19 Jun '26

19 Jun '26
David Eichmann pushed to branch wip/davide/windows-dlls at Glasgow Haskell Compiler / GHC Commits: b8261917 by David Eichmann at 2026-06-19T10:52:13+01:00 WIP place SRT info tables into .rdata on windows - - - - - 2 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -106,6 +106,7 @@ module GHC.Cmm.CLabel ( labelDynamic, isLocalCLabel, mayRedirectTo, + isSRTInfoLabel, isInfoTableLabel, isCmmInfoTableLabel, isConInfoTableLabel, @@ -730,6 +731,27 @@ mkOutOfBoundsAccessLabel = mkForeignLabel (fsLit "rtsOutOfBoundsAccess") mkMemcpyRangeOverlapLabel = mkForeignLabel (fsLit "rtsMemcpyRangeOverlap") ForeignLabelInExternalPackage ForeignLabelIsFunction mkMUT_VAR_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_VAR_CLEAN") CmmInfo +isSRTInfoLabel :: CLabel -> Bool +isSRTInfoLabel clbl = case clbl of + CmmLabel _ _ lbl CmmInfo -> + lbl == fsLit "stg_SRT_1" + || lbl == fsLit "stg_SRT_2" + || lbl == fsLit "stg_SRT_3" + || lbl == fsLit "stg_SRT_4" + || lbl == fsLit "stg_SRT_5" + || lbl == fsLit "stg_SRT_6" + || lbl == fsLit "stg_SRT_7" + || lbl == fsLit "stg_SRT_8" + || lbl == fsLit "stg_SRT_9" + || lbl == fsLit "stg_SRT_10" + || lbl == fsLit "stg_SRT_11" + || lbl == fsLit "stg_SRT_12" + || lbl == fsLit "stg_SRT_13" + || lbl == fsLit "stg_SRT_14" + || lbl == fsLit "stg_SRT_15" + || lbl == fsLit "stg_SRT_16" + _ -> False + mkSRTInfoLabel :: Int -> CLabel mkSRTInfoLabel n = CmmLabel rtsUnitId (NeedExternDecl False) lbl CmmInfo where ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -33,7 +33,7 @@ import GHC.CmmToAsm.Ppr import GHC.Cmm hiding (topInfoTable) import GHC.Cmm.Dataflow.Label import GHC.Cmm.BlockId -import GHC.Cmm.CLabel +import GHC.Cmm.CLabel as CLabel import GHC.Cmm.InitFini import GHC.Cmm.DebugBlock (pprUnwindTable) @@ -96,10 +96,16 @@ pprNatCmmDecl config proc@(CmmProc top_info entry_lbl _ (ListGraph blocks)) = ) | otherwise = (empty,empty) + section = if platformOS platform == OSMinGW32 + && externallyVisibleCLabel proc_lbl + && isSRTInfoLabel proc_lbl + then ReadOnlyData + else Text + in vcat [ -- section directive. Requires proc_lbl when split-section is enabled to -- use as a subsection name. - pprSectionAlign config (Section Text proc_lbl) + pprSectionAlign config (Section section proc_lbl) -- section alignment. Note that when there is an info table, we align the -- info table and not the entry code! View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b82619177664a4ac33fc4174c0ea7f4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b82619177664a4ac33fc4174c0ea7f4… You're receiving this email because of your account on gitlab.haskell.org.
1 0
0 0
[Git][ghc/ghc][wip/mangoiv/unused-type] compiler: rename ZonkAny to UnusedType and add pretty printing logic
by Magnus (@MangoIV) 19 Jun '26

19 Jun '26
Magnus pushed to branch wip/mangoiv/unused-type at Glasgow Haskell Compiler / GHC Commits: eebd176c by mangoiv at 2026-06-19T11:31:43+02:00 compiler: rename ZonkAny to UnusedType and add pretty printing logic ZonkAny is a hard to understand name for users who do not know how the compiler works internally. Additionally, it is confusing that ZonkAny, while being a concrete type *represents* a meta variable, espeically in the compiler output. This patch changes the name of ZonkAny to UnusedType which is closer to its intended semantics and adds special pretty printing logic to display this type in the same fashion the compiler displays meta variables in other places, whenever they leak from the implementation to the user. Fixes #27390 - - - - - 17 changed files: - + changelog.d/unused-type - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - libraries/ghc-internal/src/GHC/Internal/Types.hs - testsuite/tests/perf/compiler/T11068.stdout - testsuite/tests/pmcheck/should_compile/T12957.stderr - testsuite/tests/profiling/should_run/staticcallstack002.stdout - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T13156.stdout - testsuite/tests/simplCore/should_compile/T26615.stderr - testsuite/tests/typecheck/should_fail/T13292.stderr Changes: ===================================== changelog.d/unused-type ===================================== @@ -0,0 +1,14 @@ +section: compiler +synopsis: Rename ZonkAny to UnusedType and add pretty printing logic for it. +issues: #27390 +mrs: !16212 + +description: { + After unification GHC fills in unused type variables with a fixed kind like in + ``(length :: [alpha] -> Int) ([] :: List alpha) :: Int`` with a fixed type. + This type was, confusingly to the user, called ``ZonkAny``. + We rename this type to ``UnusedType``, store naming information, and try hard to + pretty print it to something that is more resemblant of an unused in non-debugging + compiler output. We also export ``UnusedType`` from ``GHC.Internal.Types`` to make + it easier to discover without reading the GHC source code. +} ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -1904,8 +1904,8 @@ unsatisfiableClassNameKey = mkPreludeTyConUnique 170 anyTyConKey :: Unique anyTyConKey = mkPreludeTyConUnique 171 -zonkAnyTyConKey :: Unique -zonkAnyTyConKey = mkPreludeTyConUnique 172 +unusedTypeTyConKey :: Unique +unusedTypeTyConKey = mkPreludeTyConUnique 172 -- Custom user type-errors errorMessageTypeErrorFamKey :: Unique ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -93,7 +93,7 @@ module GHC.Builtin.Types ( cTupleSelId, cTupleSelIdName, -- * Any - anyTyCon, anyTy, anyTypeOfKind, zonkAnyTyCon, + anyTyCon, anyTy, anyTypeOfKind, unusedTypeTyCon, -- * Recovery TyCon makeRecoveryTyCon, @@ -300,7 +300,7 @@ wiredInTyCons :: [TyCon] wiredInTyCons = map (dataConTyCon . snd) boxingDataCons ++ [ anyTyCon - , zonkAnyTyCon + , unusedTypeTyCon , boolTyCon , charTyCon , stringTyCon @@ -412,13 +412,13 @@ doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") {- Note [Any types] ~~~~~~~~~~~~~~~~ -The type constructors `Any` and `ZonkAny` are closed type families declared thus: +The type constructors `Any` and `UnusedType` are closed type families declared thus: - type family Any :: forall k. k where { } - type family ZonkAny :: forall k. Nat -> k where { } + type family Any :: forall k. k where { } + type family UnusedType :: forall k. Nat -> Symbol -> k where { } They are used when we want a type of a particular kind, but we don't really care -what that type is. The leading example is this: `ZonkAny` is used to instantiate +what that type is. The leading example is this: `UnusedType` is used to instantiate un-constrained type variables after type checking. For example, consider the term (length [] :: Int), where @@ -431,26 +431,26 @@ The typechecker will end up with length @alpha ([] @alpha) where `alpha` is an un-constrained unification variable. The "zonking" process zaps -that unconstrained `alpha` to an arbitrary type (ZonkAny @Type 3), where the `3` is -arbitrary (see wrinkle (Any5) below). This is done in `GHC.Tc.Zonk.Type.commitFlexi`. -So we end up with +that unconstrained `alpha` to an arbitrary type (UnusedType @Type 3 "a"), where the `3` is +arbitrary (see wrinkle (Any5) below). and "a" is the original name, if we have one. +This is done in `GHC.Tc.Zonk.Type.commitFlexi`. So we end up with - length @(ZonkAny @Type 3) ([] @(ZonkAny @Type 3)) + length @(UnusedType @Type 3 "a") ([] @(UnusedType @Type 3 "a")) -`Any` and `ZonkAny` differ only in the presence of the `Nat` argument; see -wrinkle (Any4). +`Any` and `UnusedType` differ only in the presence of the `Nat` and the `Symbol` arguments; +see wrinkle (Any4). Wrinkles: -(Any1) `Any` and `ZonkAny` are kind polymorphic since in some program we may - need to use `ZonkAny` to fill in a type variable of some kind other than * +(Any1) `Any` and `UnusedType` are kind polymorphic since in some program we may + need to use `UnusedType` to fill in a type variable of some kind other than * (see #959 for examples). (Any2) They are /closed/ type families, with no instances. For example, suppose that with alpha :: '(k1, k2) we add a given coercion g :: alpha ~ (Fst alpha, Snd alpha) - and we zonked alpha = ZonkAny @(k1,k2) n. Then, if `ZonkAny` was a /data/ type, - we'd get inconsistency because we'd have a Given equality with `ZonkAny` on one + and we zonked alpha = UnusedType @(k1,k2) n. Then, if `UnusedType` was a /data/ type, + we'd get inconsistency because we'd have a Given equality with `UnusedType` on one side and '(,) on the other. See also #9097 and #9636. See #25244 for a suggestion that we instead use an /open/ type family for which @@ -459,8 +459,11 @@ Wrinkles: (Any3) They do not claim to be /data/ types, and that's important for the code generator, because the code gen may /enter/ a data value but never enters a function value. + This is the motivation for the primary use case of `Any` in userspace which is + implementing type safe interfaces with improved performance characteristics, + e.g. storing `Any` leaves as the values for a finite dependent Map. -(Any4) `ZonkAny` takes a `Nat` argument so that we can readily make up /distinct/ +(Any4) `UnusedType` takes a `Nat` argument so that we can readily make up /distinct/ types (#24817). Consider data SBool a where { STrue :: SBool True; SFalse :: SBool False } @@ -475,25 +478,43 @@ Wrinkles: Now, what are `alpha` and `beta`? If we zonk both of them to the same type `Any @Type`, the pattern-match checker will (wrongly) report that the first branch is inaccessible. So we zonk them to two /different/ types: - alpha := ZonkAny @Type 4 and beta := ZonkAny @Type k 5 + alpha := UnusedType @Type 4 "a" and beta := UnusedType @Type k 5 "b" (The actual numbers are arbitrary; they just need to differ.) The unique-name generation comes from field `tcg_zany_n` of `TcGblEnv`; and - `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newZonkAnyType` to + `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newUnusedTypeType` to make up a fresh type. If this example seems unconvincing (e.g. in this case foo must be bottom) see #24817 for larger but more compelling examples. -(Any5) `Any` and `ZonkAny` are wired-in so we can easily refer to it where we +(Any9) + `UnusedType` takes a `Symbol` argument, which we use to neatly display zonked unfilled + metavariables without leaking internal type families. + + See T13292 for an example of this in action. + + `UnusedType` is handled specially in the pretty-printer to avoid confusing compiler output. + For example, `UnusedType 3 "foo" :: Type` is displayed as `foo3` + + That special handling is implemented in GHC.Iface.Type.pprTyTcApp and more specifically + ppr_iface_unused_ty_tycon. + + Historical note: in the past, `UnusedType` was called `ZonkAny` (or `Any` before that). + We renamed it to `UnusedType` and added this special treatment in the pretty-printer to avoid + confusing mentions of zonking. + +(Any5) `Any` and `UnusedType` are wired-in so we can easily refer to it where we don't have a name environment (e.g. see Rules.matchRule for one example) -(Any6) `Any` is defined in library module ghc-prim:GHC.Types, and exported so that - it is available to users. For this reason it's treated like any other - wired-in type: - - has a fixed unique, anyTyConKey, - - lives in the global name cache - Currently `ZonkAny` is not available to users; but it could easily be. +(Any6) `Any` and `UnusedType` are defined in library module ghc-prim:GHC.Types, + and exported. `Any` should be available to users mainly because it is a useful type + in userspace. `UnusedType` is exported mainly for documentation in case they stumble + over it in debug output: a user should not have to grep the compiler to know what + a given type in their program is there for. For this reason they're treated like any other + wired-in types: + - they have a fixed unique, anyTyConKey/unusedTypeTyConKey, + - live in the global name cache (Any7) Properties of `Any`: * When `Any` is instantiated at a lifted type it is inhabited by at least one value, @@ -512,7 +533,7 @@ Wrinkles: See examples in ghc-prim:GHC.Types -(Any8) Warning about unused bindings of type `Any` and `ZonkAny` are suppressed, +(Any8) Warning about unused bindings of type `Any` and `UnusedType` are suppressed, following the same rationale of supressing warning about the unit type. For example, consider (#25895): @@ -520,7 +541,7 @@ Wrinkles: do { forever (return ()); blah } where forever :: forall a b. IO a -> IO b - Nothing constrains `b`, so it will be instantiates with `Any` or `ZonkAny`. + Nothing constrains `b`, so it will be instantiates with `Any` or `UnusedType`. But we certainly don't want to complain about a discarded do-binding. The Any tycon used to be quite magic, but we have since been able to @@ -550,22 +571,23 @@ anyTy = mkTyConTy anyTyCon anyTypeOfKind :: Kind -> Type anyTypeOfKind kind = mkTyConApp anyTyCon [kind] -zonkAnyTyConName :: Name -zonkAnyTyConName = - mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "ZonkAny") zonkAnyTyConKey zonkAnyTyCon +unusedTypeTyConName :: Name +unusedTypeTyConName = + mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "UnusedType") unusedTypeTyConKey unusedTypeTyCon -zonkAnyTyCon :: TyCon --- ZonkAnyTyCon :: forall k. Nat -> k +unusedTypeTyCon :: TyCon +-- unusedTypeTyCon :: forall k. Nat -> Symbol -> k -- See Note [Any types] -zonkAnyTyCon = mkFamilyTyCon zonkAnyTyConName kind bndrs 0 res_kind +unusedTypeTyCon = mkFamilyTyCon unusedTypeTyConName kind bndrs 0 res_kind Nothing (ClosedSynFamilyTyCon Nothing) Nothing NotInjective where - [kv,nat_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy] + [kv,nat_kv,sym_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy, typeSymbolKind] bndrs = [ mkNamedTyConBinder Specified kv - , mkAnonTyConBinder nat_kv ] + , mkAnonTyConBinder nat_kv + , mkAnonTyConBinder sym_kv ] res_kind = mkTyVarTy kv kind = mkTyConKind bndrs res_kind ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -1281,11 +1281,11 @@ warnDiscardedDoBindings rhs@(L rhs_loc _) m_ty elt_ty do { fam_inst_envs <- dsGetFamInstEnvs ; let norm_elt_ty = topNormaliseType fam_inst_envs elt_ty supressible_ty = - isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isZonkAnyTy norm_elt_ty + isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isUnusedTypeTy norm_elt_ty -- Warn about discarding things in 'monadic' binding, -- however few types are excluded: -- * Unit type `()` - -- * `ZonkAny` or `Any` type see (Any8) of Note [Any types] + -- * `UnusedType` or `Any` type see (Any8) of Note [Any types] ; if warn_unused && not supressible_ty then diagnosticDs (DsUnusedDoBind rhs elt_ty) else ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -7,7 +7,7 @@ This module defines interface types and binders -} -{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE MultiWayIf, OverloadedRecordDot #-} module GHC.Iface.Type ( IfExtName, IfLclName(..), mkIfLclName, ifLclNameFS, @@ -1740,6 +1740,7 @@ pprTyTcApp ctxt_prec tc tys = sdocOption sdocPrintExplicitKinds $ \print_kinds -> sdocOption sdocPrintTypeAbbreviations $ \print_type_abbreviations -> getPprDebug $ \debug -> + getPprStyle $ \style -> if | ifaceTyConName tc `hasKey` ipClassKey , IA_Arg (IfaceLitTy (IfaceStrTyLit n)) @@ -1791,6 +1792,13 @@ pprTyTcApp ctxt_prec tc tys = | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys) -> doc + -- See Note [Any types], specifically (Any4) and (Any9) + | ifaceTyConName tc `hasKey` unusedTypeTyConKey + , (arg_k : IfaceLitTy (IfaceNumTyLit arg_n) : IfaceLitTy (IfaceStrTyLit arg_nm) : _) <- appArgsIfaceTypes tys + -- if arg_k is a kind with more than 0 arguments, then _ might not be [] here + , userStyle style + -> ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm + | otherwise -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc $ appArgsIfaceTypesForAllTyFlags $ stripInvisArgs (PrintExplicitKinds print_kinds) tys @@ -1802,6 +1810,19 @@ ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case False -> pprPrefixOcc liftedTypeKindTyConName True -> maybeParen ctxt_prec starPrec starLit +-- | user-style printer that pretty-prints an 'UnusedType @k 3 "foo" to foo3. +-- If -fprint-explicit-kinds or -fprint-explicit-runtime-reps are set, instead +-- prints them to (foo3 :: k). +-- See Note [Any types], specifically (Any4) and (Any9) for why this is useful. +ppr_iface_unused_ty_tycon :: PprPrec -> IfaceType -> Integer -> LexicalFastString -> SDoc +ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm + = sdocOption sdocPrintExplicitKinds $ \print_kinds -> + sdocOption sdocPrintExplicitRuntimeReps $ \print_reps -> + if print_kinds || print_reps + then maybeParen ctxt_prec sigPrec $ prettyMeta <+> text "::" <+> pprIfaceType arg_k + else prettyMeta + where prettyMeta = ppr arg_nm <> ppr arg_n + -- | Pretty-print a type-level equality. -- Returns (Just doc) if the argument is a /saturated/ application -- of eqTyCon (~) @@ -2190,7 +2211,8 @@ instance Binary IfaceTyConSort where 0 -> return IfaceNormalTyCon 1 -> IfaceTupleTyCon <$> get bh <*> get bh 2 -> IfaceSumTyCon <$> get bh - _ -> return IfaceEqualityTyCon + 3 -> return IfaceEqualityTyCon + _ -> panic "get IfaceTyConSort" instance Binary IfaceTyConInfo where put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -582,7 +582,7 @@ data TcGblEnv -- ^ Allows us to choose unique DFun names. tcg_zany_n :: TcRef Integer, - -- ^ A source of unique identities for ZonkAny instances + -- ^ A source of unique identities for UnusedType instances -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) tcg_merged :: [(Module, Fingerprint)], ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -154,7 +154,7 @@ module GHC.Tc.Utils.Monad( getCCIndexM, getCCIndexTcM, -- * Zonking - liftZonkM, newZonkAnyType, + liftZonkM, newUnusedType, -- * Complete matches localAndImportedCompleteMatches, getCompleteMatchesTcM, @@ -168,7 +168,7 @@ import GHC.Prelude import GHC.Builtin.Names -import GHC.Builtin.Types( zonkAnyTyCon ) +import GHC.Builtin.Types( unusedTypeTyCon ) import GHC.Tc.Errors.Types import GHC.Tc.Errors.Hole.Plugin ( HoleFitPlugin, HoleFitPluginR (..) ) @@ -197,7 +197,7 @@ import GHC.Core.Coercion ( isReflCo ) import GHC.Core.Multiplicity import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import GHC.Core.Type( mkNumLitTy ) +import GHC.Core.Type( mkNumLitTy, mkStrLitTy ) import GHC.Core.TyCo.Rep( CoercionHole(..) ) import GHC.Core.TyCo.FVs( coVarsOfCo ) import GHC.Core.TyCon ( TyCon ) @@ -2258,17 +2258,17 @@ chooseUniqueOccTc fn = ; writeTcRef dfun_n_var (extendOccSet set occ) ; return occ } -newZonkAnyType :: Kind -> TcM Type --- Return a type (ZonkAny @k n), where n is fresh --- Recall ZonkAny :: forall k. Natural -> k +newUnusedType :: Name -> Kind -> TcM Type +-- Return a type (UnusedType @k n sym), where n is fresh +-- Recall UnusedType :: forall k. Natural -> Symbol -> k -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) -newZonkAnyType kind +newUnusedType name kind = do { env <- getGblEnv ; let zany_n_var = tcg_zany_n env ; i <- readTcRef zany_n_var ; let !i2 = i+1 ; writeTcRef zany_n_var i2 - ; return (mkTyConApp zonkAnyTyCon [kind, mkNumLitTy i]) } + ; return (mkTyConApp unusedTypeTyCon [kind, mkNumLitTy i, mkStrLitTy $ getOccFS name ]) } getConstraintVar :: TcM (TcRef WantedConstraints) getConstraintVar = do { env <- getLclEnv; return (tcl_lie env) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -85,7 +85,7 @@ module GHC.Tc.Utils.TcType ( isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy, isFloatingPrimTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, - isBoolTy, isUnitTy, isAnyTy, isZonkAnyTy, isCharTy, + isBoolTy, isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy, isTauTy, isTauTyCon, tcIsTyVarTy, isPredTy, isSimplePredTy, isTyVarClassPred, checkValidClsArgs, hasTyVarHead, @@ -2057,7 +2057,7 @@ isFloatTy, isDoubleTy, isFloatPrimTy, isDoublePrimTy, isIntegerTy, isNaturalTy, isIntTy, isWordTy, isBoolTy, - isUnitTy, isAnyTy, isZonkAnyTy, isCharTy :: Type -> Bool + isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy :: Type -> Bool isFloatTy = is_tc floatTyConKey isDoubleTy = is_tc doubleTyConKey isFloatPrimTy = is_tc floatPrimTyConKey @@ -2069,7 +2069,7 @@ isWordTy = is_tc wordTyConKey isBoolTy = is_tc boolTyConKey isUnitTy = is_tc unitTyConKey isAnyTy = is_tc anyTyConKey -isZonkAnyTy = is_tc zonkAnyTyConKey +isUnusedTypeTy = is_tc unusedTypeTyConKey isCharTy = is_tc charTyConKey -- | Check whether the type is of the form @Any :: k@, ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedRecordDot #-} {- (c) The University of Glasgow 2006 (c) The AQUA Project, Glasgow University, 1996-1998 @@ -43,7 +44,7 @@ import GHC.Tc.Types.TcRef import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo ) import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) import GHC.Tc.Utils.TcType -import GHC.Tc.Utils.Monad ( newZonkAnyType, setSrcSpanA, liftZonkM, traceTc, addErr ) +import GHC.Tc.Utils.Monad ( newUnusedType, setSrcSpanA, liftZonkM, traceTc, addErr ) import GHC.Tc.Types.Evidence import GHC.Tc.Errors.Types import GHC.Tc.Zonk.Env @@ -470,11 +471,11 @@ commitFlexi DefaultFlexi tv zonked_kind ; return manyDataConTy } | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv = do { addErr $ TcRnZonkerMessage (ZonkerCannotDefaultConcrete origin) - ; newZonkAnyType zonked_kind } + ; newUnusedType tv.varName zonked_kind } | otherwise - = do { traceTc "Defaulting flexi tyvar to ZonkAny:" (pprTyVar tv) + = do { traceTc "Defaulting flexi tyvar to UnusedType:" (pprTyVar tv) -- See Note [Any types] in GHC.Builtin.Types, esp wrinkle (Any4) - ; newZonkAnyType zonked_kind } + ; newUnusedType tv.varName zonked_kind } zonkCoVarOcc :: CoVar -> ZonkTcM Coercion zonkCoVarOcc cv ===================================== libraries/ghc-internal/src/GHC/Internal/Types.hs ===================================== @@ -35,6 +35,7 @@ module GHC.Internal.Types ( SPEC(..), Symbol, Any, + UnusedType, -- * Type equality type (~), type (~~), Coercible, @@ -327,6 +328,17 @@ type family Any :: k where { } -- that this can't reduce to a `data` type for the results discussed in -- Note [Any types]. +-- | The type constructor 'UnusedType' is a type used by the compiler to fill in unused +-- type variables after unification (more specifically the "zonking" step. It carries a +-- number and a name to make pretty-printing possible. Under normal circumstances you +-- should never see this type show up in compiler output if you don't explicitly ask for +-- it by enabling debug output. +-- 'UnusedType' is pretty-printed by the compiler to something that is more strongly resembling +-- an unused type variable than a fixed type i.e. @'UnusedType' @k 3 "foo"@ is displayed as +-- @foo3@ or @(foo3 :: k)@. +type family UnusedType :: Nat -> Symbol -> k where { } +-- See Note [Any types] in GHC.Builtin.Types, specifically (Any4) and (Any9). + {- ********************************************************************* * * Lists ===================================== testsuite/tests/perf/compiler/T11068.stdout ===================================== @@ -23,137 +23,137 @@ `cast` (GHC.Internal.Generics.N:M1 `cast` (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 ===================================== testsuite/tests/pmcheck/should_compile/T12957.stderr ===================================== @@ -1,7 +1,6 @@ T12957.hs:4:5: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive - In a case alternative: - Patterns of type ‘[GHC.Internal.Types.ZonkAny 0]’ not matched: [] + In a case alternative: Patterns of type ‘[a0]’ not matched: [] T12957.hs:4:16: warning: [GHC-53633] [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant ===================================== testsuite/tests/profiling/should_run/staticcallstack002.stdout ===================================== @@ -1,4 +1,4 @@ -Just (InfoProv {ipName = "sat_s1Rh_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 0", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) -Just (InfoProv {ipName = "sat_s1RB_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 1", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) -Just (InfoProv {ipName = "sat_s1RV_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 2", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) -Just (InfoProv {ipName = "sat_s1Sf_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 3", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) +Just (InfoProv {ipName = "main_sat_t2fs_info", ipDesc = THUNK, ipTyDesc = "UnusedType 0 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) +Just (InfoProv {ipName = "main_sat_t2fJ_info", ipDesc = THUNK, ipTyDesc = "UnusedType 1 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) +Just (InfoProv {ipName = "main_sat_t2g0_info", ipDesc = THUNK, ipTyDesc = "UnusedType 2 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) +Just (InfoProv {ipName = "main_sat_t2gh_info", ipDesc = THUNK, ipTyDesc = "UnusedType 3 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -188,7 +188,7 @@ T13155: T13156: $(RM) -f T13156.hi T13156.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T13156.hs -O -ddump-prep -dsuppress-uniques | grep "case.*Any" + '$(TEST_HC)' $(TEST_HC_OPTS) -c T13156.hs -O -ddump-prep -dsuppress-uniques | grep "case.*UnusedType" # There should be a single 'case r @ GHC.Types.Any' .PHONY: T4138 ===================================== testsuite/tests/simplCore/should_compile/T13156.stdout ===================================== @@ -1,2 +1,2 @@ - case r @(GHC.Internal.Types.ZonkAny 0) of { __DEFAULT -> - case r @(GHC.Internal.Types.ZonkAny 1) of { __DEFAULT -> r @a } + case r @(GHC.Internal.Types.UnusedType 0 "a") of { __DEFAULT -> + case r @(GHC.Internal.Types.UnusedType 1 "a") of { __DEFAULT -> ===================================== testsuite/tests/simplCore/should_compile/T26615.stderr ===================================== @@ -2,7 +2,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 1,209, types: 1,139, coercions: 18, joins: 17/29} + = {terms: 1,209, types: 1,155, coercions: 18, joins: 17/29} -- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} unArray :: forall a. Array a -> SmallArray# a @@ -15,45 +15,29 @@ unArray :: forall a. Array a -> SmallArray# a unArray = \ (@a) (ds :: Array a) -> case ds of { Array ds1 -> ds1 } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule4 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$trModule4 = "main"# +$trModule1 :: Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule3 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule3 = GHC.Internal.Types.TrNameS T26615a.$trModule4 +$trModule2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$trModule2 = "T26615a"# +$trModule3 :: Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "T26615a"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule1 = GHC.Internal.Types.TrNameS T26615a.$trModule2 +$trModule4 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule :: GHC.Internal.Types.Module -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule - = GHC.Internal.Types.Module T26615a.$trModule3 T26615a.$trModule1 +T26615a.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module +[GblId, Unf=OtherCon []] +T26615a.$trModule = GHC.Internal.Types.Module $trModule2 $trModule4 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Internal.Types.KindRep @@ -104,33 +88,24 @@ $krep6 GHC.Internal.Types.$tcSmallArray# $krep5 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$tcLeaf2 = "Leaf"# +$tcLeaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tcLeaf1 = "Leaf"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcLeaf1 = GHC.Internal.Types.TrNameS T26615a.$tcLeaf2 +$tcLeaf2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcLeaf2 = GHC.Internal.Types.TrNameS $tcLeaf1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcLeaf [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcLeaf = GHC.Internal.Types.TyCon 13798714324392902582#Word64 3237499036029031497#Word64 T26615a.$trModule - T26615a.$tcLeaf1 + $tcLeaf2 0# GHC.Internal.Types.krep$*->*->* @@ -160,372 +135,284 @@ $krep10 :: GHC.Internal.Types.KindRep $krep10 = GHC.Internal.Types.KindRepFun $krep2 $krep9 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep11 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'L1 = GHC.Internal.Types.KindRepFun $krep3 $krep10 +$krep11 = GHC.Internal.Types.KindRepFun $krep3 $krep10 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$tc'L3 = "'L"# +$tc'L1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'L1 = "'L"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'L2 = GHC.Internal.Types.TrNameS T26615a.$tc'L3 +$tc'L2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'L2 = GHC.Internal.Types.TrNameS $tc'L1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'L [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'L = GHC.Internal.Types.TyCon 8570419491837374712#Word64 2090006989092642392#Word64 T26615a.$trModule - T26615a.$tc'L2 + $tc'L2 2# - T26615a.$tc'L1 + $krep11 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tcArray2 = "Array"# +$tcArray1 :: Addr# +[GblId, Unf=OtherCon []] +$tcArray1 = "Array"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcArray1 = GHC.Internal.Types.TrNameS T26615a.$tcArray2 +$tcArray2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcArray2 = GHC.Internal.Types.TrNameS $tcArray1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcArray [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcArray = GHC.Internal.Types.TyCon 10495761415291712389#Word64 7580086293698619153#Word64 T26615a.$trModule - T26615a.$tcArray1 + $tcArray2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11 :: GHC.Internal.Types.KindRep +$krep12 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep11 +$krep12 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep4 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep13 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Array1 = GHC.Internal.Types.KindRepFun $krep6 $krep11 +$krep13 = GHC.Internal.Types.KindRepFun $krep6 $krep12 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Array3 = "'Array"# +$tc'Array1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Array1 = "'Array"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Array2 = GHC.Internal.Types.TrNameS T26615a.$tc'Array3 +$tc'Array2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Array2 = GHC.Internal.Types.TrNameS $tc'Array1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Array [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Array = GHC.Internal.Types.TyCon 12424115309881832159#Word64 15542868641947707803#Word64 T26615a.$trModule - T26615a.$tc'Array2 + $tc'Array2 1# - T26615a.$tc'Array1 + $krep13 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep12 :: [GHC.Internal.Types.KindRep] +$krep14 :: [GHC.Internal.Types.KindRep] [GblId, Unf=OtherCon []] -$krep12 +$krep14 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep9 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep13 :: GHC.Internal.Types.KindRep +$krep15 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep13 - = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep12 +$krep15 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep14 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tcHashMap2 = "HashMap"# +$tcHashMap1 :: Addr# +[GblId, Unf=OtherCon []] +$tcHashMap1 = "HashMap"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcHashMap1 - = GHC.Internal.Types.TrNameS T26615a.$tcHashMap2 +$tcHashMap2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcHashMap2 = GHC.Internal.Types.TrNameS $tcHashMap1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcHashMap [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcHashMap = GHC.Internal.Types.TyCon 2021755758654901686#Word64 8209241086311595496#Word64 T26615a.$trModule - T26615a.$tcHashMap1 + $tcHashMap2 0# GHC.Internal.Types.krep$*->*->* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep16 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Empty1 +$krep16 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcHashMap $krep8 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Empty3 = "'Empty"# +$tc'Empty1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Empty1 = "'Empty"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Empty2 = GHC.Internal.Types.TrNameS T26615a.$tc'Empty3 +$tc'Empty2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Empty2 = GHC.Internal.Types.TrNameS $tc'Empty1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Empty [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Empty = GHC.Internal.Types.TyCon 2520556399233147460#Word64 17224648764450205443#Word64 T26615a.$trModule - T26615a.$tc'Empty2 + $tc'Empty2 2# - T26615a.$tc'Empty1 + $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep14 :: GHC.Internal.Types.KindRep +$krep17 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep14 = GHC.Internal.Types.KindRepFun $krep9 T26615a.$tc'Empty1 +$krep17 = GHC.Internal.Types.KindRepFun $krep9 $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep18 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Leaf1 = GHC.Internal.Types.KindRepFun $krep1 $krep14 +$krep18 = GHC.Internal.Types.KindRepFun $krep1 $krep17 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Leaf3 = "'Leaf"# +$tc'Leaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Leaf1 = "'Leaf"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Leaf2 = GHC.Internal.Types.TrNameS T26615a.$tc'Leaf3 +$tc'Leaf2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Leaf2 = GHC.Internal.Types.TrNameS $tc'Leaf1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Leaf [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Leaf = GHC.Internal.Types.TyCon 5773656560257991946#Word64 17028074687139582545#Word64 T26615a.$trModule - T26615a.$tc'Leaf2 + $tc'Leaf2 2# - T26615a.$tc'Leaf1 + $krep18 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep15 :: GHC.Internal.Types.KindRep +$krep19 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep15 = GHC.Internal.Types.KindRepFun $krep13 T26615a.$tc'Empty1 +$krep19 = GHC.Internal.Types.KindRepFun $krep15 $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep20 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Collision1 - = GHC.Internal.Types.KindRepFun $krep1 $krep15 +$krep20 = GHC.Internal.Types.KindRepFun $krep1 $krep19 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 40 0}] -T26615a.$tc'Collision3 = "'Collision"# +$tc'Collision1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Collision1 = "'Collision"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Collision2 - = GHC.Internal.Types.TrNameS T26615a.$tc'Collision3 +$tc'Collision2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Collision2 = GHC.Internal.Types.TrNameS $tc'Collision1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Collision [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Collision = GHC.Internal.Types.TyCon 18175105753528304021#Word64 13986842878006680511#Word64 T26615a.$trModule - T26615a.$tc'Collision2 + $tc'Collision2 2# - T26615a.$tc'Collision1 + $krep20 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep16 :: [GHC.Internal.Types.KindRep] +$krep21 :: [GHC.Internal.Types.KindRep] [GblId, Unf=OtherCon []] -$krep16 +$krep21 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep - T26615a.$tc'Empty1 + $krep16 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep17 :: GHC.Internal.Types.KindRep +$krep22 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep17 - = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep16 +$krep22 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep21 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep23 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Full1 - = GHC.Internal.Types.KindRepFun $krep17 T26615a.$tc'Empty1 +$krep23 = GHC.Internal.Types.KindRepFun $krep22 $krep16 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Full3 = "'Full"# +$tc'Full1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Full1 = "'Full"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Full2 = GHC.Internal.Types.TrNameS T26615a.$tc'Full3 +$tc'Full2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Full2 = GHC.Internal.Types.TrNameS $tc'Full1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Full [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Full = GHC.Internal.Types.TyCon 12008762105994325570#Word64 13514145886440831186#Word64 T26615a.$trModule - T26615a.$tc'Full2 + $tc'Full2 2# - T26615a.$tc'Full1 + $krep23 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed1 [InlPrag=[~]] - :: GHC.Internal.Types.KindRep +$krep24 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'BitmapIndexed1 - = GHC.Internal.Types.KindRepFun $krep1 T26615a.$tc'Full1 +$krep24 = GHC.Internal.Types.KindRepFun $krep1 $krep23 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 50 0}] -T26615a.$tc'BitmapIndexed3 = "'BitmapIndexed"# +$tc'BitmapIndexed1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'BitmapIndexed1 = "'BitmapIndexed"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'BitmapIndexed2 - = GHC.Internal.Types.TrNameS T26615a.$tc'BitmapIndexed3 +$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'BitmapIndexed2 = GHC.Internal.Types.TrNameS $tc'BitmapIndexed1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'BitmapIndexed [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'BitmapIndexed = GHC.Internal.Types.TyCon 15226751910432948177#Word64 957331387129868915#Word64 T26615a.$trModule - T26615a.$tc'BitmapIndexed2 + $tc'BitmapIndexed2 2# - T26615a.$tc'BitmapIndexed1 + $krep24 -- RHS size: {terms: 98, types: 109, coercions: 0, joins: 3/4} T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] @@ -538,7 +425,7 @@ T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] Str=<LP(SC(S,C(1,L)),A)><L><1L><L><L>, Unf=Unf{Src=StableUser, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [30 0 20 0 0] 406 10 + Guidance=IF_ARGS [90 0 20 0 0] 406 10 Tmpl= \ (@k) (@a) (@b) @@ -586,7 +473,7 @@ T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary1 [Occ=Once1!] :: Array (Leaf k b)) (i1 [Occ=Once1!] :: Int) @@ -654,24 +541,23 @@ T26615a.$wdisjointCollisions $s$wfoldr_ [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Bool -> Int# -> Int# -> SmallArray# (Leaf k a) -> Bool + :: SmallArray# (Leaf k a) -> Int# -> Int# -> Bool -> Bool [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><L><L><L>, Unf=OtherCon []] - $s$wfoldr_ (sc :: Bool) + $s$wfoldr_ (sc :: SmallArray# (Leaf k a)) (sc1 :: Int#) (sc2 :: Int#) - (sc3 :: SmallArray# (Leaf k a)) - = case >=# sc1 sc2 of { + (sc3 :: Bool) + = case >=# sc2 sc1 of { __DEFAULT -> - case indexSmallArray# @Lifted @(Leaf k a) sc3 sc1 of - { (# ipv1 #) -> + case indexSmallArray# @Lifted @(Leaf k a) sc sc2 of { (# ipv1 #) -> case ipv1 of { L kA ds1 -> join { $j :: Bool [LclId[JoinId(0)(Nothing)]] - $j = jump $s$wfoldr_ sc (+# sc1 1#) sc2 sc3 } in + $j = jump $s$wfoldr_ sc sc1 (+# sc2 1#) sc3 } in joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, @@ -703,13 +589,13 @@ T26615a.$wdisjointCollisions jump $wlookupInArrayCont_ kA ww2 0# lvl2 } }; - 1# -> sc + 1# -> sc3 }; } in jump $s$wfoldr_ - GHC.Internal.Types.True - 0# - (sizeofSmallArray# @Lifted @(Leaf k a) ipv) ipv + (sizeofSmallArray# @Lifted @(Leaf k a) ipv) + 0# + GHC.Internal.Types.True } } @@ -728,28 +614,28 @@ Rec { -- RHS size: {terms: 133, types: 126, coercions: 0, joins: 1/2} T26615a.disjointSubtrees_$s$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] - :: forall b a k. - Word# - -> SmallArray# (Leaf k a) -> Int# -> Eq k => HashMap k b -> Bool + :: forall k a b. + Eq k => + Int# -> Word# -> SmallArray# (Leaf k a) -> HashMap k b -> Bool [GblId[StrictWorker([~, ~, ~, ~, !])], Arity=5, - Str=<L><L><L><LP(SC(S,C(1,L)),A)><1L>, + Str=<LP(SC(S,C(1,L)),A)><L><L><L><1L>, Unf=OtherCon []] T26615a.disjointSubtrees_$s$wdisjointSubtrees - = \ (@b) + = \ (@k) (@a) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) - (sc2 :: Int#) - (sc3 :: Eq k) + (@b) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k a)) (_b :: HashMap k b) -> case _b of { Empty -> GHC.Internal.Types.True; Leaf bx ds -> case ds of { L kB ds1 -> case kB of k0 { __DEFAULT -> - case eqWord# bx sc of { + case eqWord# bx sc2 of { __DEFAULT -> GHC.Internal.Types.True; 1# -> joinrec { @@ -770,7 +656,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees __DEFAULT -> case indexSmallArray# @Lifted @(Leaf k a) ww ww1 of { (# ipv #) -> case ipv of { L kx v -> - case == @k sc3 k2 kx of { + case == @k sc k2 kx of { False -> jump $wlookupInArrayCont_ k2 ww (+# ww1 1#) ww2; True -> GHC.Internal.Types.False } @@ -780,19 +666,19 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - k0 sc1 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc1) + k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3) } } }; Collision bx bx1 -> T26615a.$wdisjointCollisions - @k @a @b sc3 sc (T26615a.Array @(Leaf k a) sc1) bx bx1; + @k @a @b sc sc2 (T26615a.Array @(Leaf k a) sc3) bx bx1; BitmapIndexed bx bx1 -> let { m :: Word# [LclId] m = uncheckedShiftL# - 1## (word2Int# (and# (uncheckedShiftRL# sc sc2) 31##)) } in + 1## (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) } in case and# m bx of { __DEFAULT -> case indexSmallArray# @@ -803,7 +689,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 (+# sc2 5#) sc3 ipv + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv }; 0## -> GHC.Internal.Types.True }; @@ -812,17 +698,17 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees @Lifted @(HashMap k b) bx - (word2Int# (and# (uncheckedShiftRL# sc sc2) 31##)) + (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 (+# sc2 5#) sc3 ipv + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv } } end Rec } Rec { --- RHS size: {terms: 705, types: 732, coercions: 18, joins: 13/23} +-- RHS size: {terms: 705, types: 748, coercions: 18, joins: 13/23} T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] :: forall k a b. Eq k => Int# -> HashMap k a -> HashMap k b -> Bool [GblId[StrictWorker([~, ~, !])], @@ -841,7 +727,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] join { fail [Occ=Once3!T[1]] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of wild [Occ=Once1] { __DEFAULT -> case GHC.Internal.Control.Exception.Base.patError @@ -860,7 +746,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupCont_ _ [Occ=Dead] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) (ds4 [Occ=Once1!] :: Word) (ds5 [Occ=Once1] :: k) (ds6 [Occ=Once1!] :: Int) @@ -896,7 +782,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary [Occ=Once1!] :: Array (Leaf k a)) (i [Occ=Once1!] :: Int) @@ -1000,7 +886,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupCont_ _ [Occ=Dead] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) (ds3 [Occ=Once1!] :: Word) (ds4 [Occ=Once1] :: k) (ds5 [Occ=Once1!] :: Int) @@ -1034,7 +920,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary [Occ=Once1!] :: Array (Leaf k b)) (i [Occ=Once1!] :: Int) @@ -1179,23 +1065,23 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -1324,51 +1210,49 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] }; } in jump go (GHC.Internal.Types.W# (and# 4294967295## bx1)); Full bx1 -> + joinrec { + go [Occ=LoopBreakerT[1]] :: Int -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + go (i :: Int) + = case GHC.Internal.Classes.ltInt i (GHC.Internal.Types.I# 0#) of { + False -> + case i of { I# i# -> + case indexSmallArray# @Lifted @(HashMap k a) bx i# of + { (# ipv [Occ=Once1] #) -> + case indexSmallArray# @Lifted @(HashMap k b) bx1 i# of + { (# ipv1 [Occ=Once1] #) -> + case T26615a.$wdisjointSubtrees @k @a @b $dEq (+# ww 5#) ipv ipv1 + of { + False -> GHC.Internal.Types.False; + True -> jump go (GHC.Internal.Types.I# (-# i# 1#)) + } + } + } + }; + True -> GHC.Internal.Types.True + }; } in case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { - __DEFAULT -> - joinrec { - go [Occ=LoopBreakerT[1]] :: Int -> Bool - [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] - go (i :: Int) - = case GHC.Internal.Classes.ltInt i (GHC.Internal.Types.I# 0#) of { - False -> - case i of { I# i# -> - case indexSmallArray# @Lifted @(HashMap k a) bx i# of - { (# ipv [Occ=Once1] #) -> - case indexSmallArray# @Lifted @(HashMap k b) bx1 i# of - { (# ipv1 [Occ=Once1] #) -> - case T26615a.$wdisjointSubtrees - @k @a @b $dEq (+# ww 5#) ipv ipv1 - of { - False -> GHC.Internal.Types.False; - True -> jump go (GHC.Internal.Types.I# (-# i# 1#)) - } - } - } - }; - True -> GHC.Internal.Types.True - }; } in - jump go (GHC.Internal.Types.I# 31#); + __DEFAULT -> jump go (GHC.Internal.Types.I# 31#); 1# -> GHC.Internal.Types.False } } @@ -1385,7 +1269,7 @@ T26615a.$wdisjointSubtrees join { fail [Dmd=MC(1,L)] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of { __DEFAULT -> case lvl1 of {}; Empty -> GHC.Internal.Types.True; @@ -1508,7 +1392,7 @@ T26615a.$wdisjointSubtrees }; Collision bx bx1 -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @a @b @k bx bx1 ww $dEq ds + @k @b @a $dEq ww bx bx1 ds } } in case ds of { Empty -> GHC.Internal.Types.True; @@ -1661,7 +1545,7 @@ T26615a.$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k bx bx1 (+# ww 5#) $dEq ipv + @k @a @b $dEq (+# ww 5#) bx bx1 ipv }; 0## -> GHC.Internal.Types.True }; @@ -1674,7 +1558,7 @@ T26615a.$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k bx bx1 (+# ww 5#) $dEq ipv + @k @a @b $dEq (+# ww 5#) bx bx1 ipv } }; BitmapIndexed bx bx1 -> @@ -1686,21 +1570,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) - :: SmallArray# (HashMap k a) ~R# GHC.Internal.Types.ZonkAny 0)) + :: SmallArray# (HashMap k a) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) - :: SmallArray# (HashMap k b) ~R# GHC.Internal.Types.ZonkAny 1)) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> let { @@ -1829,21 +1715,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) - :: SmallArray# (HashMap k a) ~R# GHC.Internal.Types.ZonkAny 0)) + :: SmallArray# (HashMap k a) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) - :: SmallArray# (HashMap k b) ~R# GHC.Internal.Types.ZonkAny 1)) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> let { @@ -1910,88 +1798,72 @@ disjointSubtrees ------ Local rules for imported ids -------- "SC:$wdisjointSubtrees1" [1] - forall (@a) + forall (@k) (@b) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) + (@a) + (sc :: Eq k) + (sc1 :: Int#) (sc2 :: Word#) (sc3 :: SmallArray# (Leaf k b)) - (sc4 :: Int#) - (sc5 :: Eq k). + (sc4 :: Word#) + (sc5 :: SmallArray# (Leaf k a)). T26615a.$wdisjointSubtrees @k @b @a - sc5 - sc4 + sc + sc1 (T26615a.Collision @k @b sc2 sc3) - (T26615a.Collision @k @a sc sc1) + (T26615a.Collision @k @a sc4 sc5) = T26615a.$wdisjointCollisions - @k @b @a sc5 sc2 (T26615a.Array @(Leaf k b) sc3) sc sc1 + @k @b @a sc sc2 (T26615a.Array @(Leaf k b) sc3) sc4 sc5 "SC:$wdisjointSubtrees0" [1] - forall (@b) + forall (@k) (@a) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) - (sc2 :: Int#) - (sc3 :: Eq k). + (@b) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k a)). T26615a.$wdisjointSubtrees @k @a @b - sc3 - sc2 - (T26615a.Collision @k @a sc sc1) + sc + sc1 + (T26615a.Collision @k @a sc2 sc3) = T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 sc2 sc3 + @k @a @b sc sc1 sc2 sc3 [2 of 2] Compiling T26615 ( T26615.hs, T26615.o ) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 614, types: 666, coercions: 18, joins: 8/14} + = {terms: 614, types: 682, coercions: 18, joins: 8/14} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule2 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615.$trModule2 = "T26615"# +$trModule1 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "T26615"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule1 = GHC.Internal.Types.TrNameS T26615.$trModule2 +$trModule2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule4 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615.$trModule4 = "main"# +$trModule3 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule3 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule3 = GHC.Internal.Types.TrNameS T26615.$trModule4 +$trModule4 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule :: GHC.Internal.Types.Module -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule - = GHC.Internal.Types.Module T26615.$trModule3 T26615.$trModule1 +T26615.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module +[GblId, Unf=OtherCon []] +T26615.$trModule = GHC.Internal.Types.Module $trModule4 $trModule2 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} lvl :: GHC.Internal.Prim.Addr# @@ -2128,7 +2000,7 @@ $wpoly_lookupCont_ end Rec } Rec { --- RHS size: {terms: 448, types: 507, coercions: 18, joins: 8/13} +-- RHS size: {terms: 448, types: 523, coercions: 18, joins: 8/13} T26615.$s$wdisjointSubtrees [InlPrag=[~], Occ=LoopBreaker] :: forall a b. GHC.Internal.Prim.Int# @@ -2143,7 +2015,7 @@ T26615.$s$wdisjointSubtrees join { fail [Dmd=MC(1,L)] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of wild { __DEFAULT -> case lvl1 of {}; T26615a.Empty -> GHC.Internal.Types.True; @@ -2190,30 +2062,28 @@ T26615.$s$wdisjointSubtrees $s$wfoldr_ [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Bool - -> GHC.Internal.Prim.Int# - -> GHC.Internal.Prim.Int# - -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a) - -> Bool + :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a) + -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> Bool -> Bool [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><L><L><L>, Unf=OtherCon []] - $s$wfoldr_ (sc :: Bool) + $s$wfoldr_ (sc + :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)) (sc1 :: GHC.Internal.Prim.Int#) (sc2 :: GHC.Internal.Prim.Int#) - (sc3 :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)) - = case GHC.Internal.Prim.>=# sc1 sc2 of { + (sc3 :: Bool) + = case GHC.Internal.Prim.>=# sc2 sc1 of { __DEFAULT -> case GHC.Internal.Prim.indexSmallArray# - @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) sc3 sc1 + @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) sc sc2 of { (# ipv1 #) -> case ipv1 of { T26615a.L kA ds2 -> join { $j :: Bool [LclId[JoinId(0)(Nothing)]] - $j = jump $s$wfoldr_ sc (GHC.Internal.Prim.+# sc1 1#) sc2 sc3 } in + $j = jump $s$wfoldr_ sc sc1 (GHC.Internal.Prim.+# sc2 1#) sc3 } in joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, @@ -2258,14 +2128,14 @@ T26615.$s$wdisjointSubtrees jump $wlookupInArrayCont_ kA bx3 0# lvl2 } }; - 1# -> sc + 1# -> sc3 }; } in jump $s$wfoldr_ - GHC.Internal.Types.True - 0# + bx1 (GHC.Internal.Prim.sizeofSmallArray# @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) bx1) - bx1 + 0# + GHC.Internal.Types.True }; T26615a.BitmapIndexed bx2 bx3 -> let { @@ -2317,23 +2187,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -2495,23 +2365,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -2564,7 +2434,7 @@ f = \ (@a) ------ Local rules for imported ids -------- "SPEC/T26615 $wdisjointSubtrees @String @_ @_" [2] - forall (@a) (@b) ($dEq :: Eq String). + forall (@a) (@b) ($dEq [Occ=Dead] :: Eq String). T26615a.$wdisjointSubtrees @String @a @b $dEq = T26615.$s$wdisjointSubtrees @a @b ===================================== testsuite/tests/typecheck/should_fail/T13292.stderr ===================================== @@ -14,15 +14,15 @@ T13292a.hs:4:12: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] In an equation for ‘someFunc’: someFunc = return () T13292.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘GHC.Internal.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m00’ with ‘IO’ Expected: IO () - Actual: GHC.Internal.Types.ZonkAny 0 () + Actual: m00 • When checking the type of the IO action ‘main’ T13292.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘GHC.Internal.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m00’ with ‘IO’ Expected: IO () - Actual: GHC.Internal.Types.ZonkAny 0 () + Actual: m00 • In the expression: main When checking the type of the IO action ‘main’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eebd176cebe89fae4a49cac47fba9d2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eebd176cebe89fae4a49cac47fba9d2… You're receiving this email because of your account on gitlab.haskell.org.
1 0
0 0
  • ← Newer
  • 1
  • ...
  • 31
  • 32
  • 33
  • 34
  • 35
  • 36
  • 37
  • ...
  • 81
  • Older →

HyperKitty Powered by HyperKitty version 1.3.12.