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

defining deSugar.

Browse Source
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(..) , HasType(..)
, errorMsgSpan , errorMsgSpan
, typeForUser , typeForUser
, deSugar
#if __GLASGOW_HASKELL__ >= 702 #if __GLASGOW_HASKELL__ >= 702
#else #else
, module Pretty , module Pretty
@ -32,6 +33,7 @@ import Control.Monad
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Time.Clock import Data.Time.Clock
import Desugar (deSugarExpr)
import DynFlags import DynFlags
import ErrUtils import ErrUtils
import FastString import FastString
@ -43,6 +45,8 @@ import Outputable
import PprTyThing import PprTyThing
import StringBuffer import StringBuffer
import TcType import TcType
import TcRnTypes
import CoreSyn
import qualified InstEnv import qualified InstEnv
import qualified Pretty import qualified Pretty
@ -298,3 +302,22 @@ typeForUser = pprTypeForUser
#else #else
typeForUser = pprTypeForUser False typeForUser = pprTypeForUser False
#endif #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.Maybe
import Data.Ord as O import Data.Ord as O
import Data.Time.Clock import Data.Time.Clock
import Desugar
import GHC import GHC
import GHC.SYB.Utils import GHC.SYB.Utils
import HscTypes import HscTypes
@ -30,7 +29,6 @@ import Language.Haskell.GhcMod.Gap (HasType(..))
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Outputable import Outputable
import TcHsSyn (hsPatType) import TcHsSyn (hsPatType)
import TcRnTypes
---------------------------------------------------------------- ----------------------------------------------------------------
@ -64,30 +62,11 @@ info opt cradle file modstr expr =
---------------------------------------------------------------- ----------------------------------------------------------------
#if __GLASGOW_HASKELL__ >= 707
instance HasType (LHsExpr Id) where instance HasType (LHsExpr Id) where
getType tcm e = do getType tcm e = do
hs_env <- getSession 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 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 instance HasType (LPat Id) where
getType _ (L spn pat) = return $ Just (spn, hsPatType pat) getType _ (L spn pat) = return $ Just (spn, hsPatType pat)