From 6288438bbe2e9988a6d633a47f1bc75ada15faf7 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Mon, 28 Jun 1999 16:32:00 +0000
Subject: [PATCH] [project @ 1999-06-28 16:32:00 by simonpj] Propagate changes
for tcSimplifyToDicts
---
ghc/compiler/typecheck/TcRules.lhs | 4 ++--
ghc/compiler/typecheck/TcSimplify.lhs | 26 ++++++++++++++++++++++----
2 files changed, 24 insertions(+), 6 deletions(-)
diff --git a/ghc/compiler/typecheck/TcRules.lhs b/ghc/compiler/typecheck/TcRules.lhs
index f52bba1a76e4..53fc6498a483 100644
--- a/ghc/compiler/typecheck/TcRules.lhs
+++ b/ghc/compiler/typecheck/TcRules.lhs
@@ -13,7 +13,7 @@ import HsCore ( UfRuleBody(..) )
import RnHsSyn ( RenamedHsDecl )
import TcHsSyn ( TypecheckedRuleDecl, mkHsLet )
import TcMonad
-import TcSimplify ( tcSimplifyRuleLhs, tcSimplifyAndCheck )
+import TcSimplify ( tcSimplifyToDicts, tcSimplifyAndCheck )
import TcType ( zonkTcTypes, newTyVarTy_OpenKind )
import TcIfaceSig ( tcCoreExpr, tcCoreLamBndrs, tcVar )
import TcMonoType ( tcHsType, tcHsTyVar, checkSigTyVars )
@@ -66,7 +66,7 @@ tcRule (RuleDecl name sig_tvs vars lhs rhs src_loc)
) `thenTc` \ (ids, lhs', rhs', lhs_lie, rhs_lie) ->
-- Check that LHS has no overloading at all
- tcSimplifyRuleLhs lhs_lie `thenTc` \ (lhs_dicts, lhs_binds) ->
+ tcSimplifyToDicts lhs_lie `thenTc` \ (lhs_dicts, lhs_binds) ->
checkSigTyVars sig_tyvars `thenTc_`
-- Gather the template variables and tyvars
diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index 50538625fca2..dde4d4cc9fb2 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -116,7 +116,7 @@ and hence the default mechanism would resolve the "a".
\begin{code}
module TcSimplify (
- tcSimplify, tcSimplifyAndCheck, tcSimplifyRuleLhs,
+ tcSimplify, tcSimplifyAndCheck, tcSimplifyToDicts,
tcSimplifyTop, tcSimplifyThetas, tcSimplifyCheckThetas,
bindInstsOfLocalFuns
) where
@@ -293,10 +293,27 @@ On the LHS of transformation rules we only simplify methods and constants,
getting dictionaries. We want to keep all of them unsimplified, to serve
as the available stuff for the RHS of the rule.
+The same thing is used for specialise pragmas. Consider
+
+ f :: Num a => a -> a
+ {-# SPECIALISE f :: Int -> Int #-}
+ f = ...
+
+The type checker generates a binding like:
+
+ f_spec = (f :: Int -> Int)
+
+and we want to end up with
+
+ f_spec = _inline_me_ (f Int dNumInt)
+
+But that means that we must simplify the Method for f to (f Int dNumInt)!
+So tcSimplifyToDicts squeezes out all Methods.
+
\begin{code}
-tcSimplifyRuleLhs :: LIE -> TcM s (LIE, TcDictBinds)
-tcSimplifyRuleLhs wanted_lie
- = reduceContext (text "tcSimplRuleLhs") try_me [] wanteds `thenTc` \ (binds, frees, irreds) ->
+tcSimplifyToDicts :: LIE -> TcM s (LIE, TcDictBinds)
+tcSimplifyToDicts wanted_lie
+ = reduceContext (text "tcSimplifyToDicts") try_me [] wanteds `thenTc` \ (binds, frees, irreds) ->
ASSERT( null frees )
returnTc (mkLIE irreds, binds)
where
@@ -308,6 +325,7 @@ tcSimplifyRuleLhs wanted_lie
\end{code}
+
%************************************************************************
%* *
\subsection{Data types for the reduction mechanism}
--
GitLab