Commit c5ff4739 authored by mnislaih's avatar mnislaih
Browse files

Generalize some code dealing with SrcSpan sorting

and the subspan relation, and move it to the SrcLoc module
parent fcd7ba21
......@@ -36,7 +36,8 @@ module SrcLoc (
srcSpanStartLine, srcSpanEndLine,
srcSpanStartCol, srcSpanEndCol,
Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc
Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc,
leftmost_smallest, leftmost_largest, rightmost, spans, isSubspanOf
) where
#include "HsVersions.h"
......@@ -400,3 +401,31 @@ instance Outputable e => Outputable (Located e) where
ppr (L span e) = ppr e
-- do we want to dump the span in debugSty mode?
\end{code}
%************************************************************************
%* *
\subsection{Manipulating SrcSpans}
%* *
%************************************************************************
\begin{code}
leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering
rightmost = flip compare
leftmost_smallest = compare
leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)
`thenCmp`
(srcSpanEnd b `compare` srcSpanEnd a)
spans :: SrcSpan -> (Int,Int) -> Bool
spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span
where loc = mkSrcLoc (srcSpanFile span) l c
isSubspanOf :: SrcSpan -> SrcSpan -> Bool
isSubspanOf src parent
| optSrcSpanFileName parent /= optSrcSpanFileName src = False
| otherwise = srcSpanStart parent <= srcSpanStart src &&
srcSpanEnd parent >= srcSpanEnd src
\end{code}
\ No newline at end of file
......@@ -1554,13 +1554,13 @@ stepOverCmd [] = do
Nothing -> stepCmd []
Just loc -> do
Just mod <- getCurrentBreakModule
parent <- enclosingSubSpan mod loc
allTicksRightmost <- sortBy rightmost `fmap`
parent <- enclosingTickSpan mod loc
allTicksRightmost <- (sortBy rightmost . map snd) `fmap`
ticksIn mod parent
let lastTick = null allTicksRightmost ||
snd(head allTicksRightmost) == loc
head allTicksRightmost == loc
if not lastTick
then doContinue (`lexicalSubSpanOf` parent) GHC.SingleStep
then doContinue (`isSubspanOf` parent) GHC.SingleStep
else doContinue (const True) GHC.SingleStep
where
......@@ -1570,7 +1570,7 @@ stepOverCmd [] = do
arrived to the last tick in an expression, in which case we must
step normally to the next tick.
What we do is:
1. Retrieve the enclosing expression block
1. Retrieve the enclosing expression block (with a tick)
2. Retrieve all the ticks there and sort them out by 'rightness'
3. See if the current tick turned out the first one in the list
-}
......@@ -1585,20 +1585,14 @@ ticksIn mod src = do
, srcSpanEnd src >= srcSpanEnd span
]
enclosingSubSpan :: Module -> SrcSpan -> GHCi SrcSpan
enclosingSubSpan mod src = do
enclosingTickSpan :: Module -> SrcSpan -> GHCi SrcSpan
enclosingTickSpan mod src = do
ticks <- getTickArray mod
let line = srcSpanStartLine src
ASSERT (inRange (bounds arr) line) do
let enclosing_spans = [ t | t@(_,span) <- ticks ! line
, srcSpanEnd span >= srcSpanEnd src]
return . snd . head . sortBy leftmost_largest $ enclosing_spans
lexicalSubSpanOf :: SrcSpan -> SrcSpan -> Bool
lexicalSubSpanOf src parent
| GHC.srcSpanFile parent /= GHC.srcSpanFile src = False
| otherwise = srcSpanStart parent <= srcSpanStart src &&
srcSpanEnd parent >= srcSpanEnd src
ASSERT (inRange (bounds ticks) line) do
let enclosing_spans = [ span | (_,span) <- ticks ! line
, srcSpanEnd span >= srcSpanEnd src]
return . head . sortBy leftmost_largest $ enclosing_spans
traceCmd :: String -> GHCi ()
traceCmd [] = doContinue (const True) GHC.RunAndLogSteps
......@@ -1765,9 +1759,9 @@ findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,SrcSpan)
findBreakByLine line arr
| not (inRange (bounds arr) line) = Nothing
| otherwise =
listToMaybe (sortBy leftmost_largest complete) `mplus`
listToMaybe (sortBy leftmost_smallest incomplete) `mplus`
listToMaybe (sortBy rightmost ticks)
listToMaybe (sortBy (leftmost_largest `on` snd) complete) `mplus`
listToMaybe (sortBy (leftmost_smallest `on` snd) incomplete) `mplus`
listToMaybe (sortBy (rightmost `on` snd) ticks)
where
ticks = arr ! line
......@@ -1782,8 +1776,8 @@ findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
findBreakByCoord mb_file (line, col) arr
| not (inRange (bounds arr) line) = Nothing
| otherwise =
listToMaybe (sortBy rightmost contains) `mplus`
listToMaybe (sortBy leftmost_smallest after_here)
listToMaybe (sortBy (rightmost `on` snd) contains ++
sortBy (leftmost_smallest `on` snd) after_here)
where
ticks = arr ! line
......@@ -1799,17 +1793,6 @@ findBreakByCoord mb_file (line, col) arr
GHC.srcSpanStartLine span == line,
GHC.srcSpanStartCol span >= col ]
leftmost_smallest (_,a) (_,b) = a `compare` b
leftmost_largest (_,a) (_,b) = (GHC.srcSpanStart a `compare` GHC.srcSpanStart b)
`thenCmp`
(GHC.srcSpanEnd b `compare` GHC.srcSpanEnd a)
rightmost (_,a) (_,b) = b `compare` a
spans :: SrcSpan -> (Int,Int) -> Bool
spans span (l,c) = GHC.srcSpanStart span <= loc && loc <= GHC.srcSpanEnd span
where loc = GHC.mkSrcLoc (GHC.srcSpanFile span) l c
-- for now, use ANSI bold on Unixy systems. On Windows, we add a line
-- of carets under the active expression instead. The Windows console
-- doesn't support ANSI escape sequences, and most Unix terminals
......
......@@ -26,7 +26,7 @@ module Util (
nTimes,
-- sorting
sortLe, sortWith,
sortLe, sortWith, on,
-- transitive closures
transitiveClosure,
......@@ -457,6 +457,10 @@ sortWith :: Ord b => (a->b) -> [a] -> [a]
sortWith get_key xs = sortLe le xs
where
x `le` y = get_key x < get_key y
on :: (a -> a -> Ordering) -> (b -> a) -> b -> b -> Ordering
on cmp sel = \x y -> sel x `cmp` sel y
\end{code}
%************************************************************************
......
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