Commit 2d72a852 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Fix Trac #5048: location on AbsBinds

This patch just puts a better SrcSpan on the AbsBinds
produced by the type checker
parent af7a7e87
...@@ -278,20 +278,18 @@ mkSrcSpan loc1 loc2 ...@@ -278,20 +278,18 @@ mkSrcSpan loc1 loc2
combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful
combineSrcSpans l (UnhelpfulSpan _) = l combineSrcSpans l (UnhelpfulSpan _) = l
combineSrcSpans start end combineSrcSpans span1 span2
= case line1 `compare` line2 of = if line_start == line_end
EQ -> case col1 `compare` col2 of then if col_start == col_end
EQ -> SrcSpanPoint file line1 col1 then SrcSpanPoint file line_start col_start
LT -> SrcSpanOneLine file line1 col1 col2 else SrcSpanOneLine file line_start col_start col_end
GT -> SrcSpanOneLine file line1 col2 col1 else SrcSpanMultiLine file line_start col_start line_end col_end
LT -> SrcSpanMultiLine file line1 col1 line2 col2
GT -> SrcSpanMultiLine file line2 col2 line1 col1
where where
line1 = srcSpanStartLine start (line_start, col_start) = min (srcSpanStartLine span1, srcSpanStartCol span1)
col1 = srcSpanStartCol start (srcSpanStartLine span2, srcSpanStartCol span2)
line2 = srcSpanEndLine end (line_end, col_end) = max (srcSpanEndLine span1, srcSpanEndCol span1)
col2 = srcSpanEndCol end (srcSpanEndLine span2, srcSpanEndCol span2)
file = srcSpanFile start file = srcSpanFile span1
\end{code} \end{code}
%************************************************************************ %************************************************************************
......
...@@ -350,9 +350,10 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc bind_list ...@@ -350,9 +350,10 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc bind_list
; return (binds, poly_ids) } ; return (binds, poly_ids) }
where where
binder_names = collectHsBindListBinders bind_list binder_names = collectHsBindListBinders bind_list
loc = getLoc (head bind_list) loc = foldr1 combineSrcSpans (map getLoc bind_list)
-- TODO: location a bit awkward, but the mbinds have been -- The mbinds have been dependency analysed and
-- dependency analysed and may no longer be adjacent -- may no longer be adjacent; so find the narrowest
-- span that includes them all
------------------ ------------------
tcPolyNoGen tcPolyNoGen
...@@ -390,7 +391,7 @@ tcPolyCheck :: TcSigInfo -> PragFun ...@@ -390,7 +391,7 @@ tcPolyCheck :: TcSigInfo -> PragFun
-- it binds a single variable, -- it binds a single variable,
-- it has a signature, -- it has a signature,
tcPolyCheck sig@(TcSigInfo { sig_id = id, sig_tvs = tvs, sig_scoped = scoped 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 prag_fn rec_tc bind_list
= do { ev_vars <- newEvVars theta = do { ev_vars <- newEvVars theta
; let skol_info = SigSkol (FunSigCtxt (idName id)) (mkPhiTy theta tau) ; 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 ...@@ -401,6 +402,7 @@ tcPolyCheck sig@(TcSigInfo { sig_id = id, sig_tvs = tvs, sig_scoped = scoped
; export <- mkExport prag_fn tvs theta mono_info ; export <- mkExport prag_fn tvs theta mono_info
; loc <- getSrcSpanM
; let (_, poly_id, _, _) = export ; let (_, poly_id, _, _) = export
abs_bind = L loc $ AbsBinds abs_bind = L loc $ AbsBinds
{ abs_tvs = tvs { abs_tvs = tvs
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment