De-synonym the types of the abtracted term variables in SpecConstr

This was making Text.PrettyPrint.HughesPJ give a lint-bug
when the libraries were compiled with -O2.

It's all caused by phantom type synonyms (which are, generally
speaking, a royal pain).  The fix is simple, but a bit brutal.

See Note [Free type variables of the qvar types].

1 files changed, 20 insertions, 2 deletions

diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index f126bdac47..99f1c79f44 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -1489,6 +1489,19 @@ The function calcSpecStrictness performs the calculation.
 This code deals with analysing call-site arguments to see whether
 they are constructor applications.
 
+Note [Free type variables of the qvar types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In a call (f @a x True), that we want to specialise, what varaibles should
+we quantify over.  Clearly over 'a' and 'x', but what about any type variables
+free in x's type?  In fact we don't need to worry about them because (f @a)
+can only be a well-typed application if its type is compatible with x, so any
+varaibles free in x's type must be free in (f @a), and hence either be gathered
+via 'a' itself, or be in scope at f's defn.  Hence we just take 
+  (exprsFreeVars pats).
+
+BUT phantom type synonums can mess this reasoning up, 
+  eg   x::T b   with  type T b = Int
+So we apply expandTypeSynonyms to the bound Ids.  Yuk.
 
 \begin{code}
 type CallPat = ([Var], [CoreExpr])	-- Quantified variables and arguments
@@ -1520,16 +1533,21 @@ callToPats env bndr_occs (con_env, args)
   = do	{ let in_scope = substInScope (sc_subst env)
 	; (interesting, pats) <- argsToPats env in_scope con_env args bndr_occs
 	; let pat_fvs = varSetElems (exprsFreeVars pats)
-	      qvars   = filterOut (`elemInScopeSet` in_scope) pat_fvs
+	      in_scope_vars = getInScopeVars in_scope
+	      qvars   = filterOut (`elemVarSet` in_scope_vars) pat_fvs
 		-- Quantify over variables that are not in sccpe
 		-- at the call site
+		-- See Note [Free type variables of the qvar types]
 		-- See Note [Shadowing] at the top
 		
 	      (tvs, ids) = partition isTyVar qvars
-	      qvars'     = tvs ++ ids
+	      qvars'     = tvs ++ map sanitise ids
 		-- Put the type variables first; the type of a term
 		-- variable may mention a type variable
 
+	      sanitise id = id `setIdType` expandTypeSynonyms (idType id)
+	        -- See Note [Free type variables of the qvar types]
+
 	; -- pprTrace "callToPats"  (ppr args $$ ppr prs $$ ppr bndr_occs) $
 	  if interesting
 	  then return (Just (qvars', pats))