X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=HsTools.hs;h=d132ce874033020c12071996e3c112ec92477ce7;hb=87bdc71306c507319ff560d3dd3253e17e9c46fe;hp=0f3e463040a02777dbb068cba06c4769efc9eedd;hpb=1c0228a91d0b3ba02697c092818333d95fcc3100;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/HsTools.hs b/HsTools.hs index 0f3e463..d132ce8 100644 --- a/HsTools.hs +++ b/HsTools.hs @@ -3,7 +3,7 @@ module HsTools where -- Standard modules import qualified Unsafe.Coerce - +import qualified Maybe -- GHC API import qualified GHC @@ -31,6 +31,7 @@ import qualified RnEnv import qualified TcExpr import qualified TcEnv import qualified TcSimplify +import qualified TcTyFuns import qualified Desugar import qualified InstEnv import qualified FamInstEnv @@ -66,12 +67,10 @@ import CoreShow -- (==) = Prelude.(==) Int $dInt -- in -- \x = (==) x 1 -toCore :: - [Module.ModuleName] -- ^ The modules that need to be imported before translating - -- this expression. - -> HsSyn.HsExpr RdrName.RdrName -- ^ The expression to translate to Core. +toCore :: + HsSyn.HsExpr RdrName.RdrName -- ^ The expression to translate to Core. -> GHC.Ghc CoreSyn.CoreExpr -- ^ The resulting core expression. -toCore modules expr = do +toCore expr = do env <- GHC.getSession let icontext = HscTypes.hsc_IC env @@ -79,7 +78,6 @@ toCore modules expr = do -- Translage the TcRn (typecheck-rename) monad into an IO monad TcRnMonad.initTcPrintErrors env PrelNames.iNTERACTIVE $ do (tc_expr, insts) <- TcRnMonad.getLIE $ do - mapM importModule modules -- Rename the expression, resulting in a HsExpr Name (rn_expr, freevars) <- RnExpr.rnExpr expr -- Typecheck the expression, resulting in a HsExpr Id and a list of @@ -123,6 +121,20 @@ mkId rdr_name = do TcEnv.tcLookupId name return id +normaliseType :: + HscTypes.HscEnv + -> Type.Type + -> IO Type.Type +normaliseType env ty = do + (err, nty) <- MonadUtils.liftIO $ + -- Initialize the typechecker monad + TcRnMonad.initTcPrintErrors env PrelNames.iNTERACTIVE $ do + -- Normalize the type + (_, nty) <- TcTyFuns.tcNormaliseFamInst ty + return nty + let normalized_ty = Maybe.fromJust nty + return normalized_ty + -- | Translate a core Type to an HsType. Far from complete so far. coreToHsType :: Type.Type -> HsTypes.LHsType RdrName.RdrName -- Translate TyConApps