X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcBinds.lhs;h=92a82b5d796881ee2a5dda5cc975b55820ab6354;hb=bebb2614af8819da9298fb537d2a777743b3fabb;hp=342529ca9adf77f79d96b8867260fe9f9f71c0d6;hpb=3a68f09199fb656512347c57f4a7a4f1215a36bd;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index 342529c..92a82b5 100644
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -675,7 +675,7 @@ tcMonoBinds mbinds tc_ty_sigs is_rec
 		  lie_avail1 `plusLIE` lie_avail2)
 
     tc_mb_pats (FunMonoBind name inf matches locn)
-      = newTyVarTy boxedTypeKind	`thenNF_Tc` \ bndr_ty ->
+      = new_lhs_ty 			`thenNF_Tc` \ bndr_ty ->
 	tc_pat_bndr name bndr_ty	`thenTc` \ bndr_id ->
 	let
 	   complete_it xve = tcAddSrcLoc locn				$
@@ -686,13 +686,7 @@ tcMonoBinds mbinds tc_ty_sigs is_rec
 
     tc_mb_pats bind@(PatMonoBind pat grhss locn)
       = tcAddSrcLoc locn	 	$
-
-		-- Figure out the appropriate kind for the pattern,
-		-- and generate a suitable type variable 
-	(case is_rec of
-	     Recursive    -> newTyVarTy boxedTypeKind	-- Recursive, so no unboxed types
-	     NonRecursive -> newTyVarTy_OpenKind 	-- Non-recursive, so we permit unboxed types
-	)					`thenNF_Tc` \ pat_ty ->
+	new_lhs_ty			`thenNF_Tc` \ pat_ty -> 
 
 		-- 	Now typecheck the pattern
 		-- We don't support binding fresh type variables in the
@@ -713,6 +707,12 @@ tcMonoBinds mbinds tc_ty_sigs is_rec
 			     returnTc (PatMonoBind pat' grhss' locn, lie)
 	in
 	returnTc (complete_it, lie_req, tvs, ids, lie_avail)
+
+	-- Figure out the appropriate kind for the pattern,
+	-- and generate a suitable type variable 
+    new_lhs_ty = case is_rec of
+		     Recursive    -> newTyVarTy boxedTypeKind	-- Recursive, so no unboxed types
+		     NonRecursive -> newTyVarTy_OpenKind 	-- Non-recursive, so we permit unboxed types
 \end{code}
 
 %************************************************************************