X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcUnify.lhs;h=bd65c46bdca802dff46f113101b9ca9b6bd7c0d5;hb=40f5a0759bd07308009c3ae8956dfa061c684ebd;hp=eba9985ad0e03509be04a3db41b3479d813a7ae6;hpb=5e6e6b8bb75bac436b4dd9f0fd3b518cdd707652;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index eba9985..bd65c46 100644
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -48,9 +48,9 @@ import TcType		( TcKind, TcType, TcTyVar, BoxyTyVar, TcTauType,
 			  tcSplitForAllTys, tcSplitAppTy_maybe, tcSplitFunTys, mkTyVarTys,
 			  tcSplitSigmaTy, tyVarsOfType, mkPhiTy, mkTyVarTy, mkPredTy, 
 			  typeKind, mkForAllTys, mkAppTy, isBoxyTyVar,
-			  exactTyVarsOfType, 
+			  tcView, exactTyVarsOfType, 
 			  tidyOpenType, tidyOpenTyVar, tidyOpenTyVars,
-			  pprType, tidyKind, tidySkolemTyVar, isSkolemTyVar, tcView, 
+			  pprType, tidyKind, tidySkolemTyVar, isSkolemTyVar, isSigTyVar,
 			  TvSubst, mkTvSubst, zipTyEnv, zipOpenTvSubst, emptyTvSubst, 
 			  substTy, substTheta, 
 			  lookupTyVar, extendTvSubst )
@@ -180,6 +180,7 @@ subFunTys error_herald n_pats res_ty thing_inside
 			     ; return (idCoercion, res) } }
 	where
 	  mk_res_ty (res_ty' : arg_tys') = mkFunTys arg_tys' res_ty'
+	  mk_res_ty [] = panic "TcUnify.mk_res_ty1"
 	  kinds = openTypeKind : take n (repeat argTypeKind)
 		-- Note argTypeKind: the args can have an unboxed type,
 		-- but not an unboxed tuple.
@@ -268,6 +269,7 @@ boxySplitAppTy orig_ty
 				 ; return (fun_ty, arg_ty) } }
       where
         mk_res_ty [fun_ty', arg_ty'] = mkAppTy fun_ty' arg_ty'
+	mk_res_ty other = panic "TcUnify.mk_res_ty2"
 	tv_kind = tyVarKind tv
 	kinds = [mkArrowKind liftedTypeKind (defaultKind tv_kind),
 					 	-- m :: * -> k
@@ -337,7 +339,7 @@ withBox kind thing_inside
 \begin{code}
 preSubType :: [TcTyVar]		-- Quantified type variables
 	   -> TcTyVarSet	-- Subset of quantified type variables
-				-- that can be instantiated with boxy types
+				--   see Note [Pre-sub boxy]
 	    -> TcType		-- The rho-type part; quantified tyvars scopes over this
 	    -> BoxySigmaType	-- Matching type from the context
 	    -> TcM [TcType]	-- Types to instantiate the tyvars
@@ -346,13 +348,17 @@ preSubType :: [TcTyVar]		-- Quantified type variables
 --	info from the pre-subsumption, if there is any
 --	a boxy type variable otherwise
 --
--- The 'btvs' are a subset of 'qtvs'.  They are the ones we can
--- instantiate to a boxy type variable, because they'll definitely be
--- filled in later.  This isn't always the case; sometimes we have type 
--- variables mentioned in the context of the type, but not the body; 
---		f :: forall a b. C a b => a -> a
--- Then we may land up with an unconstrained 'b', so we want to 
--- instantiate it to a monotype (non-boxy) type variable
+-- Note [Pre-sub boxy]
+--   The 'btvs' are a subset of 'qtvs'.  They are the ones we can
+--   instantiate to a boxy type variable, because they'll definitely be
+--   filled in later.  This isn't always the case; sometimes we have type 
+--   variables mentioned in the context of the type, but not the body; 
+-- 		  f :: forall a b. C a b => a -> a
+--   Then we may land up with an unconstrained 'b', so we want to 
+--   instantiate it to a monotype (non-boxy) type variable
+--
+-- The 'qtvs' that are *neither* fixed by the pre-subsumption, *nor* are in 'btvs',
+-- are instantiated to TauTv meta variables.
 	
 preSubType qtvs btvs qty expected_ty
   = do { tys <- mapM inst_tv qtvs
@@ -460,6 +466,8 @@ boxy_match_s tmpl_tvs [] boxy_tvs [] subst
 boxy_match_s tmpl_tvs (t_ty:t_tys) boxy_tvs (b_ty:b_tys) subst
   = boxy_match tmpl_tvs t_ty boxy_tvs b_ty $
     boxy_match_s tmpl_tvs t_tys boxy_tvs b_tys subst
+boxy_match_s tmpl_tvs _ boxy_tvs _ subst
+  = panic "boxy_match_s"	-- Lengths do not match
     
 
 ------------
@@ -689,6 +697,7 @@ tc_sub outer act_sty act_ty@(FunTy act_arg act_res) exp_sty (TyVarTy exp_tv)
  			      ; tc_sub_funs act_arg act_res arg_ty res_ty } }
  where
     mk_res_ty [arg_ty', res_ty'] = mkFunTy arg_ty' res_ty'
+    mk_res_ty other = panic "TcUnify.mk_res_ty3"
     fun_kinds = [argTypeKind, openTypeKind]
 
 -- Everything else: defer to boxy matching
@@ -1501,8 +1510,8 @@ ppr_ty env ty
 	     simple_result  = (env1, quotes (ppr tidy_ty), empty)
        ; case tidy_ty of
 	   TyVarTy tv 
-		| isSkolemTyVar tv -> return (env2, pp_rigid tv',
-					      pprSkolTvBinding tv')
+		| isSkolemTyVar tv || isSigTyVar tv
+		-> return (env2, pp_rigid tv', pprSkolTvBinding tv')
 		| otherwise -> return simple_result
 		where
 		  (env2, tv') = tidySkolemTyVar env1 tv