diff options
| author | David Simmons-Duffin <davidsd@gmail.com> | 2021-05-10 00:16:34 -0700 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-08-10 15:00:05 -0400 |
| commit | 741fdf0e4f371afbd8ef36f81bbb90a2049b005c (patch) | |
| tree | 09e67911aff43ef6bd2c388794fb10dc1fbd8ff8 /compiler | |
| parent | 8b9acc4d58f51dcbae73c8226ef876218809fd79 (diff) | |
| download | haskell-741fdf0e4f371afbd8ef36f81bbb90a2049b005c.tar.gz | |
Add a Typeable constraint to fromStaticPtr, addressing #19729
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Tc/Gen/Expr.hs | 7 |
1 files changed, 2 insertions, 5 deletions
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs index 083c7e68a2..b768df9e48 100644 --- a/compiler/GHC/Tc/Gen/Expr.hs +++ b/compiler/GHC/Tc/Gen/Expr.hs @@ -431,11 +431,8 @@ tcExpr (HsStatic fvs expr) res_ty ; mapM_ checkClosedInStaticForm $ nonDetEltsUniqSet fvs -- Require the type of the argument to be Typeable. - -- The evidence is not used, but asking the constraint ensures that - -- the current implementation is as restrictive as future versions - -- of the StaticPointers extension. ; typeableClass <- tcLookupClass typeableClassName - ; _ <- emitWantedEvVar StaticOrigin $ + ; typeable_ev <- emitWantedEvVar StaticOrigin $ mkTyConApp (classTyCon typeableClass) [liftedTypeKind, expr_ty] @@ -446,7 +443,7 @@ tcExpr (HsStatic fvs expr) res_ty -- Wrap the static form with the 'fromStaticPtr' call. ; fromStaticPtr <- newMethodFromName StaticOrigin fromStaticPtrName [p_ty] - ; let wrap = mkWpTyApps [expr_ty] + ; let wrap = mkWpEvVarApps [typeable_ev] <.> mkWpTyApps [expr_ty] ; loc <- getSrcSpanM ; return $ mkHsWrapCo co $ HsApp noComments (L (noAnnSrcSpan loc) $ mkHsWrap wrap fromStaticPtr) |