X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcExpr.lhs;h=32223a5896cd7f3cb7b7986df71ac52225ec01b5;hb=0f5e104c36b1dc3d8deeec5fef3d65e7b3a1b5ad;hp=1d83c8a90f1d9ca5fe3e3b28fcc48a1b124ef3ec;hpb=183839ef216ee152d1c150641fed1120bc50f95a;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 1d83c8a..32223a5 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -314,7 +314,9 @@ tcExpr in_expr@(ExplicitPArr _ exprs) res_ty	-- maybe empty
 -- 	   The scrutinee should have a rigid type if x,y do
 -- The general scheme is the same as in tcIdApp
 tcExpr (ExplicitTuple exprs boxity) res_ty
-  = do	{ tvs <- newBoxyTyVars [argTypeKind | e <- exprs]
+  = do	{ let kind = case boxity of { Boxed   -> liftedTypeKind
+				    ; Unboxed -> argTypeKind }
+	; tvs <- newBoxyTyVars [kind | e <- exprs]
 	; let tup_tc     = tupleTyCon boxity (length exprs)
 	      tup_res_ty = mkTyConApp tup_tc (mkTyVarTys tvs)
 	; checkWiredInTyCon tup_tc	-- Ensure instances are available
@@ -785,7 +787,8 @@ instFun orig fun subst tv_theta_prs
 	; doStupidChecks fun ty_theta_prs'
 
 		-- Now do normal instantiation
-	; result <- go True fun ty_theta_prs' 
+        ; method_sharing <- doptM Opt_MethodSharing
+	; result <- go method_sharing True fun ty_theta_prs' 
 	; traceTc (text "instFun result" <+> ppr result)
 	; return result
 	}
@@ -793,24 +796,24 @@ instFun orig fun subst tv_theta_prs
     subst_pr (tvs, theta) 
 	= (substTyVars subst tvs, substTheta subst theta)
 
-    go _ fun [] = do {traceTc (text "go _ fun [] returns" <+> ppr fun) ; return fun }
+    go _ _ fun [] = do {traceTc (text "go _ _ fun [] returns" <+> ppr fun) ; return fun }
 
-    go True (HsVar fun_id) ((tys,theta) : prs)
-	| want_method_inst theta
+    go method_sharing True (HsVar fun_id) ((tys,theta) : prs)
+	| want_method_inst method_sharing theta
 	= do { traceTc (text "go (HsVar fun_id) ((tys,theta) : prs) | want_method_inst theta")
 	     ; meth_id <- newMethodWithGivenTy orig fun_id tys
-	     ; go False (HsVar meth_id) prs }
+	     ; go method_sharing False (HsVar meth_id) prs }
 		-- Go round with 'False' to prevent further use
 		-- of newMethod: see Note [Multiple instantiation]
 
-    go _ fun ((tys, theta) : prs)
+    go method_sharing _ fun ((tys, theta) : prs)
 	= do { co_fn <- instCall orig tys theta
 	     ; traceTc (text "go yields co_fn" <+> ppr co_fn)
-	     ; go False (HsWrap co_fn fun) prs }
+	     ; go method_sharing False (HsWrap co_fn fun) prs }
 
 	-- See Note [No method sharing]
-    want_method_inst theta =  not (null theta)	-- Overloaded
-		   	   && not opt_NoMethodSharing
+    want_method_inst method_sharing theta =  not (null theta)	-- Overloaded
+		   	                  && method_sharing
 \end{code}
 
 Note [Multiple instantiation]