From 4a84e214da8a2d87d2fd819d59fb06115e98014c Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Thu, 20 Aug 2009 12:32:45 +0000
Subject: [PATCH] Make -dppr-debug print locations in HsSyn

Show SrcSpans for Located things might be overkill, but it's sometimes
useful.

I also added
  ppWhen, ppUnless :: Bool -> SDoc -> SDoc
to Outputable
---
 compiler/basicTypes/SrcLoc.lhs |   53 +++++++++++++++++++---------------------
 compiler/utils/Outputable.lhs  |    9 ++++++-
 2 files changed, 33 insertions(+), 29 deletions(-)

diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index 85b9b2e..02c3e8a 100644
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -395,38 +395,35 @@ instance Outputable SrcSpan where
     ppr span
       = getPprStyle $ \ sty ->
         if userStyle sty || debugStyle sty then
-           pprUserSpan span
+           pprUserSpan True span
         else
            hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
                  char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]
 
-pprUserSpan :: SrcSpan -> SDoc
-pprUserSpan (SrcSpanOneLine src_path line start_col end_col)
-  = hcat [ pprFastFilePath src_path, char ':', 
-	   int line,
-	   char ':', int start_col
-	 ]
-    <> if end_col - start_col <= 1 
-	  then empty 
-	    -- for single-character or point spans, we just output the starting
-	    -- column number
-	  else  char '-' <> int (end_col-1)
-
-pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol)
-  = hcat [ pprFastFilePath src_path, char ':', 
-		  parens (int sline <> char ',' <>  int scol),
-		  char '-',
-		  parens (int eline <> char ',' <>  
-			   if ecol == 0 then int ecol else int (ecol-1))
-		]
-
-pprUserSpan (SrcSpanPoint src_path line col)
-  = hcat [ pprFastFilePath src_path, char ':', 
-	   int line,
-	   char ':', int col
+pprUserSpan :: Bool -> SrcSpan -> SDoc
+pprUserSpan show_path (SrcSpanOneLine src_path line start_col end_col)
+  = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
+         , int line, char ':', int start_col
+         , ppUnless (end_col - start_col <= 1)
+                    (char '-' <> int (end_col-1)) 
+	    -- For single-character or point spans, we just 
+	    -- output the starting column number
+         ]
+	  
+
+pprUserSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
+  = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
+	 , parens (int sline <> char ',' <>  int scol)
+	 , char '-'
+	 , parens (int eline <> char ',' <>  
+	   	   if ecol == 0 then int ecol else int (ecol-1))
 	 ]
 
-pprUserSpan (UnhelpfulSpan s)  = ftext s
+pprUserSpan show_path (SrcSpanPoint src_path line col)
+  = hcat [ ppWhen show_path $ (pprFastFilePath src_path <> colon)
+         , int line, char ':', int col ]
+
+pprUserSpan _ (UnhelpfulSpan s)  = ftext s
 
 pprDefnLoc :: SrcSpan -> SDoc
 -- ^ Pretty prints information about the 'SrcSpan' in the style "defined at ..."
@@ -480,8 +477,8 @@ instance Functor Located where
   fmap f (L l e) = L l (f e)
 
 instance Outputable e => Outputable (Located e) where
-  ppr (L _ e) =  ppr e
-	-- do we want to dump the span in debugSty mode?    
+  ppr (L l e) = ifPprDebug (braces (pprUserSpan False l)) <> ppr e
+		-- Print spans without the file name etc
 \end{code}
 
 %************************************************************************
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 34ee673..622138c 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -29,7 +29,7 @@ module Outputable (
 	($$), ($+$), vcat,
 	sep, cat, 
 	fsep, fcat, 
-	hang, punctuate,
+	hang, punctuate, ppWhen, ppUnless,
 	speakNth, speakNTimes, speakN, speakNOf, plural,
 
         -- * Converting 'SDoc' into strings and outputing it
@@ -472,6 +472,13 @@ punctuate p (d:ds) = go d ds
 		   where
 		     go d [] = [d]
 		     go d (e:es) = (d <> p) : go e es
+
+ppWhen, ppUnless :: Bool -> SDoc -> SDoc
+ppWhen True  doc = doc
+ppWhen False _   = empty
+
+ppUnless True  _   = empty
+ppUnless False doc = doc
 \end{code}
 
 
-- 
1.7.10.4