From: simonpj@microsoft.com <unknown>
Date: Thu, 31 Mar 2011 10:23:15 +0000 (+0000)
Subject: Fix Trac #5048: location on AbsBinds
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=2d72a852f400ddfc756d6557b80c8f9e8e83de56

Fix Trac #5048: location on AbsBinds

This patch just puts a better SrcSpan on the AbsBinds
produced by the type checker
---

diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index 06f8ec8..5dcdabe 100644
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -278,20 +278,18 @@ mkSrcSpan loc1 loc2
 combineSrcSpans	:: SrcSpan -> SrcSpan -> SrcSpan
 combineSrcSpans	(UnhelpfulSpan _) r = r -- this seems more useful
 combineSrcSpans	l (UnhelpfulSpan _) = l
-combineSrcSpans	start end 
- = case line1 `compare` line2 of
-     EQ -> case col1 `compare` col2 of
-		EQ -> SrcSpanPoint file line1 col1
-		LT -> SrcSpanOneLine file line1 col1 col2
-		GT -> SrcSpanOneLine file line1 col2 col1
-     LT -> SrcSpanMultiLine file line1 col1 line2 col2
-     GT -> SrcSpanMultiLine file line2 col2 line1 col1
+combineSrcSpans	span1 span2
+ = if line_start == line_end 
+   then if col_start == col_end
+        then SrcSpanPoint     file line_start col_start
+        else SrcSpanOneLine   file line_start col_start col_end
+   else      SrcSpanMultiLine file line_start col_start line_end col_end
   where
-	line1 = srcSpanStartLine start
-	col1  = srcSpanStartCol start
-	line2 = srcSpanEndLine end
-	col2  = srcSpanEndCol end
-	file  = srcSpanFile start
+    (line_start, col_start) = min (srcSpanStartLine span1, srcSpanStartCol span1)
+    		 	          (srcSpanStartLine span2, srcSpanStartCol span2)
+    (line_end, col_end)     = max (srcSpanEndLine span1, srcSpanEndCol span1)
+    		  	          (srcSpanEndLine span2, srcSpanEndCol span2)
+    file = srcSpanFile span1
 \end{code}
 
 %************************************************************************
diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index 92c960b..8a6a3b7 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -350,9 +350,10 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc bind_list
     ; return (binds, poly_ids) }
   where
     binder_names = collectHsBindListBinders bind_list
-    loc = getLoc (head bind_list)
-         -- TODO: location a bit awkward, but the mbinds have been
-         --       dependency analysed and may no longer be adjacent
+    loc = foldr1 combineSrcSpans (map getLoc bind_list)
+         -- The mbinds have been dependency analysed and 
+         -- may no longer be adjacent; so find the narrowest
+	 -- span that includes them all
 
 ------------------
 tcPolyNoGen 
@@ -390,7 +391,7 @@ tcPolyCheck :: TcSigInfo -> PragFun
 --   it binds a single variable,
 --   it has a signature,
 tcPolyCheck sig@(TcSigInfo { sig_id = id, sig_tvs = tvs, sig_scoped = scoped
-                           , sig_theta = theta, sig_tau = tau, sig_loc = loc })
+                           , sig_theta = theta, sig_tau = tau })
     prag_fn rec_tc bind_list
   = do { ev_vars <- newEvVars theta
        ; let skol_info = SigSkol (FunSigCtxt (idName id)) (mkPhiTy theta tau)
@@ -401,6 +402,7 @@ tcPolyCheck sig@(TcSigInfo { sig_id = id, sig_tvs = tvs, sig_scoped = scoped
 
        ; export <- mkExport prag_fn tvs theta mono_info
 
+       ; loc <- getSrcSpanM
        ; let (_, poly_id, _, _) = export
              abs_bind = L loc $ AbsBinds 
                         { abs_tvs = tvs