From d4b95ea994e850f2c85e418b5625874fd25b0ebf Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Thu, 15 Mar 2007 14:28:12 +0000
Subject: [PATCH] Make the type-defaulting in GHCi use () as the first default
 type

See Trac #1200

This is a somewhat experimental fix.  I'm not sure we want it in 6.6.1

The idea is explained in Note [Default unitTy] in TcSimplify.  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.
---
 compiler/typecheck/TcDefaults.lhs |    2 +-
 compiler/typecheck/TcRnMonad.lhs  |    4 ++--
 compiler/typecheck/TcSimplify.lhs |   47 ++++++++++++++++++++++++++++---------
 3 files changed, 39 insertions(+), 14 deletions(-)

diff --git a/compiler/typecheck/TcDefaults.lhs b/compiler/typecheck/TcDefaults.lhs
index 6bd8b4a..f3f35d4 100644
--- a/compiler/typecheck/TcDefaults.lhs
+++ b/compiler/typecheck/TcDefaults.lhs
@@ -31,7 +31,7 @@ tcDefaults :: [LDefaultDecl Name]
 				    -- in Disambig.
 
 tcDefaults [] 
-  = getDefaultTys		-- No default declaration, so get the
+  = getDeclaredDefaultTys	-- No default declaration, so get the
 				-- default types from the envt; 
 				-- i.e. use the curent ones
 				-- (the caller will put them back there)
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index f2566c3..06e3d81 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -405,8 +405,8 @@ extendFixityEnv new_bit
   = updGblEnv (\env@(TcGblEnv { tcg_fix_env = old_fix_env }) -> 
 		env {tcg_fix_env = extendNameEnvList old_fix_env new_bit})	     
 
-getDefaultTys :: TcRn (Maybe [Type])
-getDefaultTys = do { env <- getGblEnv; return (tcg_default env) }
+getDeclaredDefaultTys :: TcRn (Maybe [Type])
+getDeclaredDefaultTys = do { env <- getGblEnv; return (tcg_default env) }
 \end{code}
 
 %************************************************************************
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index b4b0b73..7311ae0 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
-- 
1.7.10.4