X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FSrcLoc.lhs;h=35c78a8412469632e3ad47c51aaacf2edd827ce1;hp=a748b478225b3560b06eab0e1e6c3c8526c0b028;hb=2fe38b5fb0957f9428864afd69ad3ccd82fae3d0;hpb=fc9bbbab3fe56cf0ff5723abbdb0f496d257f34e

diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index a748b47..35c78a8 100644
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -58,7 +58,7 @@ module SrcLoc (
 	
 	-- ** Constructing Located
 	noLoc,
-    mkGeneralLocated,
+        mkGeneralLocated,
 	
 	-- ** Deconstructing Located
 	getLoc, unLoc, 
@@ -87,10 +87,7 @@ this is the obvious stuff:
 data SrcLoc
   = SrcLoc	FastString	-- A precise location (file name)
 		{-# UNPACK #-} !Int		-- line number, begins at 1
-		{-# UNPACK #-} !Int		-- column number, begins at 0
-		-- Don't ask me why lines start at 1 and columns start at
-		-- zero.  That's just the way it is, so there.  --SDM
-
+		{-# UNPACK #-} !Int		-- column number, begins at 1
   | UnhelpfulLoc FastString	-- Just a general indication
 \end{code}
 
@@ -137,7 +134,7 @@ srcLocCol _other         = panic "srcLocCol: unknown col"
 -- | Move the 'SrcLoc' down by one line if the character is a newline
 -- and across by one character in any other case
 advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
-advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f  (l + 1) 0
+advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f  (l + 1) 1
 advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)
 advanceSrcLoc loc	     _	  = loc	-- Better than nothing
 \end{code}
@@ -296,7 +293,7 @@ isGoodSrcSpan SrcSpanPoint{} = True
 isGoodSrcSpan _ = False
 
 isOneLineSpan :: SrcSpan -> Bool
--- ^ True if the span is known to straddle more than one line.
+-- ^ True if the span is known to straddle only one line.
 -- For "bad" 'SrcSpan', it returns False
 isOneLineSpan s
   | isGoodSrcSpan s = srcSpanStartLine s == srcSpanEndLine s
@@ -395,38 +392,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 +474,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}
 
 %************************************************************************