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

Another try at case split for type families

Browse Source
This commit is contained in:
Alejandro Serrano 2014-07-26 13:07:45 +02:00
parent 3fb9163011
commit 9b500da4b8
1 changed files with 14 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -24,6 +24,7 @@ import qualified Type as Ty
import Debug.Trace import Debug.Trace
import Language.Haskell.GhcMod.Doc import Language.Haskell.GhcMod.Doc
import ErrUtils
---------------------------------------------------------------- ----------------------------------------------------------------
-- CASE SPLITTING -- CASE SPLITTING
@ -59,7 +60,7 @@ splits file lineNo colNo = ghandle handler body
text <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc $ text <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc $
getTyCons dflag style varName varT) getTyCons dflag style varName varT)
return (fourInts bndLoc, text) return (fourInts bndLoc, text)
handler (SomeException _) = emptyResult =<< options handler (SomeException e) = trace (show e) $ emptyResult =<< options
---------------------------------------------------------------- ----------------------------------------------------------------
-- a. Code for getting the information of the variable -- a. Code for getting the information of the variable
@ -100,18 +101,19 @@ getPatternVarName _ = error "This should never happened"
getSrcSpanTypeForTypeSplit :: GhcMonad m => DynFlags -> PprStyle -> G.ModSummary -> Int -> Int -> m (Maybe SplitInfo) getSrcSpanTypeForTypeSplit :: GhcMonad m => DynFlags -> PprStyle -> G.ModSummary -> Int -> Int -> m (Maybe SplitInfo)
getSrcSpanTypeForTypeSplit dflag style modSum lineNo colNo = do getSrcSpanTypeForTypeSplit dflag style modSum lineNo colNo = do
p <- G.parseModule modSum p <- G.parseModule modSum
TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p TypecheckedModule{tm_renamed_source = Just rs
let lst = listifySpans tcs (lineNo, colNo) :: [G.LTyFamInstEqn Id] ,tm_checked_module_info = modinfo} <- G.typecheckModule p
(L eqL _):_ = trace (showOneLine dflag style $ ppr lst) $ sortBy (cmp `on` G.getLoc) lst case listifyRenamedSpans rs (lineNo, colNo) :: [G.LTyFamInstEqn G.Name] of
varPat = find isTypePatternVar $ listifySpans tcs (lineNo, colNo) :: Maybe (G.LHsType Id) [L loc (G.TyFamInstEqn (L _ name) _ _)] -> do
case trace (showPage dflag style (ppr tcs)) $ varPat of -- We found a type family instance declaration
Just (L varSpan (G.HsTyVar vName)) -> let lst = listifyRenamedSpans rs (lineNo, colNo) :: [G.LHsType G.Name]
return $ Just (TySplitInfo (G.getName vName) eqL (varSpan, G.idType vName)) hsTypes = sortBy (cmp `on` G.getLoc) lst
(L varLoc (G.HsTyVar varName)):_ = trace (showOneLine dflag style $ ppr hsTypes) $ hsTypes
tcResult <- G.lookupName varName
case trace (showOneLine dflag style $ ppr tcResult) $ tcResult of
Just _ -> return $ Nothing -- Just (TySplitInfo name loc (varLoc, tcKi))
_ -> return Nothing
_ -> return Nothing _ -> return Nothing
isTypePatternVar :: G.LHsType Id -> Bool
isTypePatternVar (L _ (G.HsTyVar _)) = True
isTypePatternVar _ = False
---------------------------------------------------------------- ----------------------------------------------------------------
-- b. Code for getting the possible constructors -- b. Code for getting the possible constructors
@ -122,12 +124,6 @@ getTyCons dflag style name ty | Just (tyCon, _) <- Ty.splitTyConApp_maybe ty =
in getTyCon dflag style name' tyCon in getTyCon dflag style name' tyCon
getTyCons dflag style name _ = [showName dflag style name] getTyCons dflag style name _ = [showName dflag style name]
getKiCons :: DynFlags -> PprStyle -> G.Name -> G.Kind -> [String]
getKiCons dflag style name ty | Just (tyCon, _) <- Ty.splitTyConApp_maybe ty =
let name' = showName dflag style name -- Convert name to string
in getTyCon dflag style name' tyCon
getKiCons dflag style name _ = [showName dflag style name]
-- Write cases for one type -- Write cases for one type
getTyCon :: DynFlags -> PprStyle -> String -> Ty.TyCon -> [String] getTyCon :: DynFlags -> PprStyle -> String -> Ty.TyCon -> [String]
-- 1. Non-matcheable type constructors -- 1. Non-matcheable type constructors