X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSimplify.lhs;h=d433a8c86c3fa7ba646a17cb3efdbd74bb54a08b;hb=f8d2c44cedbfef40cc9b6497ad8f62bb090c02c8;hp=47c92af1f39f61bb6ae4812d2713d7a41e821c54;hpb=041c35e5d9f3aefab6908b4c776a3fd8242720ab;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 47c92af..d433a8c 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -2252,17 +2252,7 @@ disambiguate interactive dflags insts
 	;     return () }
   | otherwise
   = do 	{  	-- Figure out what default types to use
-	  mb_defaults <- getDefaultTys
-	; default_tys <- case mb_defaults of
-			   Just tys -> return tys
-			   Nothing  -> 	-- No use-supplied default;
-					-- use [Integer, Double]
-				do { integer_ty <- tcMetaTy integerTyConName
-				   ; checkWiredInTyCon doubleTyCon
-				   ; string_ty <- tcMetaTy stringTyConName
-				   ; if ovl_strings 	-- Add String if -foverloaded-strings
-					then return [integer_ty,doubleTy,string_ty] 
-					else return [integer_ty,doubleTy] }
+	; default_tys <- getDefaultTys extended_defaulting ovl_strings
 
 	; traceTc (text "disambigutate" <+> vcat [ppr unaries, ppr bad_tvs, ppr defaultable_groups])
 	; mapM_ (disambigGroup default_tys) defaultable_groups  }
@@ -2325,8 +2315,43 @@ disambigGroup default_tys dicts
 		-- After this we can't fail
 	   ; warnDefault dicts default_ty
 	   ; unifyType default_ty (mkTyVarTy tyvar) }
+
+
+getDefaultTys :: Bool -> Bool -> TcM [Type]
+getDefaultTys extended_deflts ovl_strings
+  = do	{ mb_defaults <- getDeclaredDefaultTys
+	; case mb_defaults of {
+	   Just tys -> return tys ;	-- User-supplied defaults
+	   Nothing  -> do
+
+	-- No use-supplied default
+	-- Use [Integer, Double], plus modifications
+	{ integer_ty <- tcMetaTy integerTyConName
+	; checkWiredInTyCon doubleTyCon
+	; string_ty <- tcMetaTy stringTyConName
+	; return (opt_deflt extended_deflts unitTy
+			-- Note [Default unitTy]
+			++
+		  [integer_ty,doubleTy]
+			++
+		  opt_deflt ovl_strings string_ty) } } }
+  where
+    opt_deflt True  ty = [ty]
+    opt_deflt False ty = []
 \end{code}
 
+Note [Default unitTy]
+~~~~~~~~~~~~~~~~~~~~~
+In interative mode (or with -fextended-default-rules) we add () as the first type we
+try when defaulting.  This has very little real impact, except in the following case.
+Consider: 
+	Text.Printf.printf "hello"
+This has type (forall a. IO a); it prints "hello", and returns 'undefined'.  We don't
+want the GHCi repl loop to try to print that 'undefined'.  The neatest thing is to
+default the 'a' to (), rather than to Integer (which is what would otherwise happen;
+and then GHCi doesn't attempt to print the ().  So in interactive mode, we add
+() to the list of defaulting types.  See Trac #1200.
+
 Note [Avoiding spurious errors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 When doing the unification for defaulting, we check for skolem
@@ -2374,43 +2399,19 @@ tcSimplifyDeriv orig tyvars theta
 	; wanteds <- newDictBndrsO orig (substTheta tenv theta)
 	; (irreds, _) <- topCheckLoop doc wanteds
 
-	-- Insist that the context of a derived instance declaration
-	-- consists of constraints of form (C a b), where a,b are
-	-- type variables
-	-- NB: the caller will further check the tv_dicts for
-	--     legal instance-declaration form
-	; let (tv_dicts, non_tv_dicts) = partition isTyVarDict irreds
-	; addNoInstanceErrs non_tv_dicts
-
 	; let rev_env = zipTopTvSubst tvs (mkTyVarTys tyvars)
-	      simpl_theta = substTheta rev_env (map dictPred tv_dicts)
+	      simpl_theta = substTheta rev_env (map dictPred irreds)
 		-- This reverse-mapping is a pain, but the result
 		-- should mention the original TyVars not TcTyVars
 
+	-- NB: the caller will further check the tv_dicts for
+	--     legal instance-declaration form
+
 	; return simpl_theta }
   where
     doc = ptext SLIT("deriving classes for a data type")
 \end{code}
 
-Note [Deriving context]
-~~~~~~~~~~~~~~~~~~~~~~~
-With -fglasgow-exts, we allow things like (C Int a) in the simplified
-context for a derived instance declaration, because at a use of this
-instance, we might know that a=Bool, and have an instance for (C Int
-Bool)
-
-We nevertheless insist that each predicate meets the termination
-conditions. If not, the deriving mechanism generates larger and larger
-constraints.  Example:
-  data Succ a = S a
-  data Seq a = Cons a (Seq (Succ a)) | Nil deriving Show
-
-Note the lack of a Show instance for Succ.  First we'll generate
-  instance (Show (Succ a), Show a) => Show (Seq a)
-and then
-  instance (Show (Succ (Succ a)), Show (Succ a), Show a) => Show (Seq a)
-and so on.  Instead we want to complain of no instance for (Show (Succ a)).
-  
 
 
 @tcSimplifyDefault@ just checks class-type constraints, essentially;