hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Force caseSplit value. Fixes crash on GHC 7.10

Browse Source
This commit is contained in:
Nikolay Yakimov 2016-05-15 04:10:56 +03:00
parent 97dbcef96d
commit 623f9f332c
1 changed files with 11 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
Language/Haskell/GhcMod/CaseSplit.hs
View File

@ -29,6 +29,7 @@ import Language.Haskell.GhcMod.Logging
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Utils (withMappedFile) import Language.Haskell.GhcMod.Utils (withMappedFile)
import Language.Haskell.GhcMod.FileMapping (fileModSummaryWithMapping) import Language.Haskell.GhcMod.FileMapping (fileModSummaryWithMapping)
import Control.DeepSeq
---------------------------------------------------------------- ----------------------------------------------------------------
-- CASE SPLITTING -- CASE SPLITTING
@ -55,19 +56,17 @@ splits file lineNo colNo =
style <- getStyle style <- getStyle
dflag <- G.getSessionDynFlags dflag <- G.getSessionDynFlags
modSum <- fileModSummaryWithMapping (cradleCurrentDir crdl </> file) modSum <- fileModSummaryWithMapping (cradleCurrentDir crdl </> file)
whenFound' oopts (getSrcSpanTypeForSplit modSum lineNo colNo) $ \x -> case x of whenFound' oopts (getSrcSpanTypeForSplit modSum lineNo colNo) $ \x -> do
(SplitInfo varName bndLoc (varLoc,varT) _matches) -> do let (varName, bndLoc, (varLoc,varT))
let varName' = showName dflag style varName -- Convert name to string | (SplitInfo vn bl vlvt _matches) <- x
= (vn, bl, vlvt)
| (TySplitInfo vn bl vlvt) <- x
= (vn, bl, vlvt)
varName' = showName dflag style varName -- Convert name to string
t <- withMappedFile file $ \file' -> t <- withMappedFile file $ \file' ->
genCaseSplitTextFile file' (SplitToTextInfo varName' bndLoc varLoc $ genCaseSplitTextFile file' (SplitToTextInfo varName' bndLoc varLoc $
getTyCons dflag style varName varT) getTyCons dflag style varName varT)
return (fourInts bndLoc, t) return $!! (fourInts bndLoc, t)
(TySplitInfo varName bndLoc (varLoc,varT)) -> do
let varName' = showName dflag style varName -- Convert name to string
t <- withMappedFile file $ \file' ->
genCaseSplitTextFile file' (SplitToTextInfo varName' bndLoc varLoc $
getTyCons dflag style varName varT)
return (fourInts bndLoc, t)
where where
handler (SomeException ex) = do handler (SomeException ex) = do
gmLog GmException "splits" $ gmLog GmException "splits" $
@ -207,8 +206,8 @@ genCaseSplitTextFile file info = liftIO $ do
return $ getCaseSplitText (T.lines t) info return $ getCaseSplitText (T.lines t) info
getCaseSplitText :: [T.Text] -> SplitToTextInfo -> String getCaseSplitText :: [T.Text] -> SplitToTextInfo -> String
getCaseSplitText t (SplitToTextInfo { sVarName = sVN, sBindingSpan = sBS getCaseSplitText t SplitToTextInfo{ sVarName = sVN, sBindingSpan = sBS
, sVarSpan = sVS, sTycons = sT }) = , sVarSpan = sVS, sTycons = sT } =
let bindingText = getBindingText t sBS let bindingText = getBindingText t sBS
difference = srcSpanDifference sBS sVS difference = srcSpanDifference sBS sVS
replaced = map (replaceVarWithTyCon bindingText difference sVN) sT replaced = map (replaceVarWithTyCon bindingText difference sVN) sT