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

defining deSugar.

This commit is contained in:
Kazu Yamamoto 2013-11-19 12:54:08 +09:00
parent 13738d4391
commit 41da5cc505
2 changed files with 24 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -21,6 +21,7 @@ module Language.Haskell.GhcMod.Gap (
, HasType(..)
, errorMsgSpan
, typeForUser
, deSugar
#if __GLASGOW_HASKELL__ >= 702
#else
, module Pretty
@ -32,6 +33,7 @@ import Control.Monad
import Data.List
import Data.Maybe
import Data.Time.Clock
import Desugar (deSugarExpr)
import DynFlags
import ErrUtils
import FastString
@ -43,6 +45,8 @@ import Outputable
import PprTyThing
import StringBuffer
import TcType
import TcRnTypes
import CoreSyn
import qualified InstEnv
import qualified Pretty
@ -298,3 +302,22 @@ typeForUser = pprTypeForUser
#else
typeForUser = pprTypeForUser False
#endif
deSugar :: TypecheckedModule -> LHsExpr Id -> HscEnv
-> IO (Maybe CoreSyn.CoreExpr)
#if __GLASGOW_HASKELL__ >= 707
deSugar tcm e hs_env = snd <$> deSugarExpr hs_env modu rn_env ty_env fi_env e
where
modu = ms_mod $ pm_mod_summary $ tm_parsed_module tcm
tcgEnv = fst $ tm_internals_ tcm
rn_env = tcg_rdr_env tcgEnv
ty_env = tcg_type_env tcgEnv
fi_env = tcg_fam_inst_env tcgEnv
#else
deSugar tcm e hs_env = snd <$> deSugarExpr hs_env modu rn_env ty_env e
where
modu = ms_mod $ pm_mod_summary $ tm_parsed_module tcm
tcgEnv = fst $ tm_internals_ tcm
rn_env = tcg_rdr_env tcgEnv
ty_env = tcg_type_env tcgEnv
#endif

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

@ -18,7 +18,6 @@ import Data.List
import Data.Maybe
import Data.Ord as O
import Data.Time.Clock
import Desugar
import GHC
import GHC.SYB.Utils
import HscTypes
@ -30,7 +29,6 @@ import Language.Haskell.GhcMod.Gap (HasType(..))
import Language.Haskell.GhcMod.Types
import Outputable
import TcHsSyn (hsPatType)
import TcRnTypes
----------------------------------------------------------------
@ -64,30 +62,11 @@ info opt cradle file modstr expr =
----------------------------------------------------------------
#if __GLASGOW_HASKELL__ >= 707
instance HasType (LHsExpr Id) where
getType tcm e = do
hs_env <- getSession
(_, mbe) <- Gap.liftIO $ deSugarExpr hs_env modu rn_env ty_env fi_env e
mbe <- Gap.liftIO $ Gap.deSugar tcm e hs_env
return $ (getLoc e, ) <$> CoreUtils.exprType <$> mbe
where
modu = ms_mod $ pm_mod_summary $ tm_parsed_module tcm
tcgEnv = fst $ tm_internals_ tcm
rn_env = tcg_rdr_env tcgEnv
ty_env = tcg_type_env tcgEnv
fi_env = tcg_fam_inst_env tcgEnv
#else
instance HasType (LHsExpr Id) where
getType tcm e = do
hs_env <- getSession
(_, mbe) <- Gap.liftIO $ deSugarExpr hs_env modu rn_env ty_env e
return $ (getLoc e, ) <$> CoreUtils.exprType <$> mbe
where
modu = ms_mod $ pm_mod_summary $ tm_parsed_module tcm
tcgEnv = fst $ tm_internals_ tcm
rn_env = tcg_rdr_env tcgEnv
ty_env = tcg_type_env tcgEnv
#endif
instance HasType (LPat Id) where
getType _ (L spn pat) = return $ Just (spn, hsPatType pat)