diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2022-11-10 17:31:54 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simon.peytonjones@gmail.com> | 2022-11-12 23:14:13 +0000 |
| commit | 294f907370fadd3313f8c5e6aa87a93c8b86f139 (patch) | |
| tree | 4071c1470efea858998a63225f95ef5c76e645bc /compiler | |
| parent | e160cf4776f21a39adebfa8f5d4dcbe9ec6b0ffe (diff) | |
| download | haskell-294f907370fadd3313f8c5e6aa87a93c8b86f139.tar.gz | |
Fix a trivial typo in dataConNonlinearTypewip/T22416
Fixes #22416
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Core/DataCon.hs | 16 | ||||
| -rw-r--r-- | compiler/GHC/Core/Type.hs | 2 |
2 files changed, 11 insertions, 7 deletions
diff --git a/compiler/GHC/Core/DataCon.hs b/compiler/GHC/Core/DataCon.hs index 2846fa7b33..043cb82574 100644 --- a/compiler/GHC/Core/DataCon.hs +++ b/compiler/GHC/Core/DataCon.hs @@ -1542,14 +1542,18 @@ dataConWrapperType (MkData { dcUserTyVarBinders = user_tvbs, res_ty dataConNonlinearType :: DataCon -> Type +-- Just like dataConWrapperType, but with the +-- linearity on the arguments all zapped to Many dataConNonlinearType (MkData { dcUserTyVarBinders = user_tvbs, dcOtherTheta = theta, dcOrigArgTys = arg_tys, - dcOrigResTy = res_ty }) - = let arg_tys' = map (\(Scaled w t) -> Scaled (case w of OneTy -> ManyTy; _ -> w) t) arg_tys - in mkInvisForAllTys user_tvbs $ - mkInvisFunTys theta $ - mkScaledFunTys arg_tys' $ - res_ty + dcOrigResTy = res_ty, + dcStupidTheta = stupid_theta }) + = mkInvisForAllTys user_tvbs $ + mkInvisFunTys (stupid_theta ++ theta) $ + mkScaledFunTys arg_tys' $ + res_ty + where + arg_tys' = map (\(Scaled w t) -> Scaled (case w of OneTy -> ManyTy; _ -> w) t) arg_tys dataConDisplayType :: Bool -> DataCon -> Type dataConDisplayType show_linear_types dc diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs index a36a398773..7e0444cbfe 100644 --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -1383,7 +1383,7 @@ splitFunTys ty = split [] ty ty split args orig_ty ty | Just ty' <- coreView ty = split args orig_ty ty' split args orig_ty _ = (reverse args, orig_ty) -funResultTy :: Type -> Type +funResultTy :: HasDebugCallStack => Type -> Type -- ^ Extract the function result type and panic if that is not possible funResultTy ty | FunTy { ft_res = res } <- coreFullView ty = res |