From f65f61e18bb010109fd5581c44d37382b93a35b5 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Mon, 30 Nov 2009 17:52:04 +0000
Subject: [PATCH] Fix Trac #3100: reifyType

A type without any leading foralls may still have constraints
   eg:  ?x::Int => Int -> Int

But reifyType was failing in this case.

Merge to 6.12.
---
 compiler/typecheck/TcSplice.lhs |   19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 70eaca8..76e0312 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -1070,17 +1070,22 @@ reifyClass cls
 
 ------------------------------
 reifyType :: TypeRep.Type -> TcM TH.Type
+reifyType ty@(ForAllTy _ _)        = reify_for_all ty
+reifyType ty@(PredTy {} `FunTy` _) = reify_for_all ty	        -- Types like ((?x::Int) => Char -> Char)
 reifyType (TyVarTy tv)	    = return (TH.VarT (reifyName tv))
-reifyType (TyConApp tc tys) = reify_tc_app (reifyName tc) tys
+reifyType (TyConApp tc tys) = reify_tc_app (reifyName tc) tys   -- Do not expand type synonyms here
 reifyType (AppTy t1 t2)     = do { [r1,r2] <- reifyTypes [t1,t2] ; return (r1 `TH.AppT` r2) }
 reifyType (FunTy t1 t2)     = do { [r1,r2] <- reifyTypes [t1,t2] ; return (TH.ArrowT `TH.AppT` r1 `TH.AppT` r2) }
-reifyType ty@(ForAllTy _ _) = do { cxt' <- reifyCxt cxt; 
-				 ; tau' <- reifyType tau 
-				 ; return (TH.ForallT (reifyTyVars tvs) cxt' tau') }
-			    where
-				(tvs, cxt, tau) = tcSplitSigmaTy ty
-reifyType (PredTy {}) = panic "reifyType PredTy"
+reifyType ty@(PredTy {})    = pprPanic "reifyType PredTy" (ppr ty)
 
+reify_for_all :: TypeRep.Type -> TcM TH.Type
+reify_for_all ty
+  = do { cxt' <- reifyCxt cxt; 
+       ; tau' <- reifyType tau 
+       ; return (TH.ForallT (reifyTyVars tvs) cxt' tau') }
+  where
+    (tvs, cxt, tau) = tcSplitSigmaTy ty   
+				
 reifyTypes :: [Type] -> TcM [TH.Type]
 reifyTypes = mapM reifyType
 
-- 
1.7.10.4