No longer any need to explicitly load module interface in 'toCore'

[matthijs/master-project/cλash.git] / HsTools.hs

diff --git a/HsTools.hs b/HsTools.hs
index 0f3e463040a02777dbb068cba06c4769efc9eedd..d132ce874033020c12071996e3c112ec92477ce7 100644 (file)
--- 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