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

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
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}
%************************************************************************
......
......@@ -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
......
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