From b52d5ab796622dbfba963a8b591e6abb76a0f5fb Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 27 Mar 2003 08:25:31 +0000
Subject: [PATCH] [project @ 2003-03-27 08:25:31 by simonpj]
 -------------------------------------       Fix a wibble in
 default-type setting for TH 
 -------------------------------------

When a bunch of declarations contains no 'default' declaration,
we were setting 'defaultDefaultTys' as appropriate default types.
This isn't right for Template Haskell, which may have more than
one bunch of top-level decls.  (The bunches are separated by
top-level declaration splices.)

Instead, if there is no 'default' declaration we should do nothing.
---
 ghc/compiler/typecheck/TcDefaults.lhs |   16 +++++++++++++---
 1 file changed, 13 insertions(+), 3 deletions(-)

diff --git a/ghc/compiler/typecheck/TcDefaults.lhs b/ghc/compiler/typecheck/TcDefaults.lhs
index 82290db..f107451 100644
--- a/ghc/compiler/typecheck/TcDefaults.lhs
+++ b/ghc/compiler/typecheck/TcDefaults.lhs
@@ -22,14 +22,24 @@ import HscTypes		( TyThing(..) )
 
 \begin{code}
 tcDefaults :: [DefaultDecl Name]
-	   -> TcM [Type] 	    -- defaulting types to heave
+	   -> TcM [Type]	    -- Defaulting types to heave
 				    -- into Tc monad for later use
 				    -- in Disambig.
 
-tcDefaults [] = returnM defaultDefaultTys
+tcDefaults [] 
+  = getDefaultTys		-- No default declaration, so get the
+				-- default types from the envt; 
+				-- i.e. use the curent ones
+				-- (the caller will put them back there)
+	-- It's important not to return defaultDefaultTys here (which
+	-- we used to do) because in a TH program, tcDefaults [] is called
+	-- repeatedly, once for each group of declarations between top-level
+	-- splices.  We don't want to carefully set the default types in
+	-- one group, only for the next group to ignore them and install
+	-- defaultDefaultTys
 
 tcDefaults [DefaultDecl [] locn]
-  = returnM []		-- no defaults
+  = returnM []			-- Default declaration specifying no types
 
 tcDefaults [DefaultDecl mono_tys locn]
   = tcLookupGlobal_maybe numClassName	`thenM` \ maybe_num ->
-- 
1.7.10.4