[commit: ghc] wip/gadtpm: Printing some more stuff (35b782c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/gadtpm
Link       : http://ghc.haskell.org/trac/ghc/changeset/35b782cdf301087e9cd08d0e5e6a311f3263b3cd/ghc

>---------------------------------------------------------------

commit 35b782cdf301087e9cd08d0e5e6a311f3263b3cd
Author: George Karachalias <george.karachalias at gmail.com>
Date:   Thu Feb 12 13:19:01 2015 +0100

    Printing some more stuff


>---------------------------------------------------------------

35b782cdf301087e9cd08d0e5e6a311f3263b3cd
 compiler/deSugar/Check.hs | 5 +++++
 compiler/deSugar/Match.hs | 6 +++++-
 2 files changed, 10 insertions(+), 1 deletion(-)

diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index a275193..a603c72 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -556,6 +556,11 @@ inferTyPmPats pats = do
 wt :: [Type] -> OutVec -> PmM Bool
 wt sig (_, vec)
   | length sig == length vec = do
+
+      -- TEMPORARY3
+      dflags <- getDynFlags
+      liftIO $ putStrLn $ "Signature we are using: " ++ showSDoc dflags (ppr sig)
+
       (tys, cs) <- inferTyPmPats vec
       cs' <- zipWithM newEqPmM sig tys -- The vector should match the signature type
 
diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs
index 8815fe6..30113a5 100644
--- a/compiler/deSugar/Match.hs
+++ b/compiler/deSugar/Match.hs
@@ -65,11 +65,15 @@ matchCheck :: [Type]           -- Types of the arguments
            -> [EquationInfo]   -- Info about patterns, etc. (type synonym below)
            -> DsM MatchResult  -- Desugared result!
 
-matchCheck tys ctx vars ty qs
+matchCheck tys ctx@(DsMatchContext hs_ctx srcspan) vars ty qs
   = do { dflags <- getDynFlags
        -- ; pm_result <- checkpm tys qs
        -- ; dsPmWarn dflags ctx pm_result -- check for flags inside (maybe shorten this?)
 
+       -- TEMPORARY
+       ; liftIO $ putStrLn $ "We are calling dsPmEmitWarning in context: " ++ showSDoc dflags (ppr srcspan <+> pprMatchContext hs_ctx)
+       ; liftIO $ putStrLn $ "sig: " ++ showSDoc dflags (ppr tys)
+
        ; dsPmEmitWarns dflags ctx tys qs
 
        ; match vars ty qs }