X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fspecialise%2FSpecEnv.lhs;fp=ghc%2Fcompiler%2Fspecialise%2FSpecEnv.lhs;h=04ae01acbff58ba90b38cdc7a9e81d4a52964a3f;hb=c4f3290f3d4c2a5c2e81a97717f7fd06ee180f6d;hp=9569bd1b09047ba3ee05da79100003ca3276f707;hpb=d488074ee8175b144a9ebf030800d9649d8ade0f;p=ghc-hetmet.git

diff --git a/ghc/compiler/specialise/SpecEnv.lhs b/ghc/compiler/specialise/SpecEnv.lhs
index 9569bd1..04ae01a 100644
--- a/ghc/compiler/specialise/SpecEnv.lhs
+++ b/ghc/compiler/specialise/SpecEnv.lhs
@@ -16,6 +16,7 @@ module SpecEnv (
 import Type		( Type, GenType, mkTyVarTy, matchTys, tyVarsOfTypes, applyToTyVars )
 import TyVar		( TyVar, GenTyVar, TyVarEnv, tyVarFlexi, setTyVarFlexi, lookupTyVarEnv, tyVarSetToList )
 import Unify		( Subst, unifyTyListsX )
+import Outputable
 import Maybes
 import Util		( assertPanic )
 \end{code}
@@ -84,17 +85,25 @@ The thing we are looking up can have an
 arbitrary "flexi" part.
 
 \begin{code}
-lookupSpecEnv :: SpecEnv value	-- The envt
+lookupSpecEnv :: SDoc		-- For error report
+	      -> SpecEnv value	-- The envt
 	      -> [GenType flexi]		-- Key
 	      -> Maybe (TyVarEnv (GenType flexi), value)
 		     
-lookupSpecEnv EmptySE key = Nothing
-lookupSpecEnv (SpecEnv alist) key
+lookupSpecEnv doc EmptySE key = Nothing
+lookupSpecEnv doc (SpecEnv alist) key
   = find alist
   where
     find [] = Nothing
     find ((tpl, val) : rest)
-      = case matchTys tpl key of
+      = 
+#ifdef DEBUG
+	if length tpl > length key then
+		pprTrace "lookupSpecEnv" (doc <+> ppr tpl <+> ppr key) $
+		Nothing
+	else
+#endif
+	case matchTys tpl key of
 	  Nothing                 -> find rest
 	  Just (subst, leftovers) -> ASSERT( null leftovers )
 				     Just (subst, val)