From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Thu, 9 Apr 2009 16:15:43 +0000 (+0200)
Subject: Add a [ModuleName] parameter to toCore.
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=da1ada4d31ea157f61c1c9e0cd3854387ac32218;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Add a [ModuleName] parameter to toCore.

This allows callers to put any number of modules into scope before
translating to Core. Previously, functions and values could be
automatically imported by using their qualified name, but now also
instances can be used from modules that would not be imported otherwise.
---

diff --git a/CoreTools.hs b/CoreTools.hs
index b8ebd85..52006fb 100644
--- a/CoreTools.hs
+++ b/CoreTools.hs
@@ -42,7 +42,7 @@ eval_tfp_int ty =
           (HsBinds.HsValBinds $ (HsBinds.ValBindsIn binds) [])
           (SrcLoc.noLoc expr)
 
-    core <- toCore expr
+    core <- toCore [] expr
     execCore core 
 
 -- | Get the length of a SizedWord type
diff --git a/HsTools.hs b/HsTools.hs
index a058c84..3e8672f 100644
--- a/HsTools.hs
+++ b/HsTools.hs
@@ -66,8 +66,12 @@ import CoreShow
 --    (==) = Prelude.(==) Int $dInt 
 --  in 
 --    \x = (==) x 1
-toCore :: HsSyn.HsExpr RdrName.RdrName -> GHC.Ghc CoreSyn.CoreExpr
-toCore expr = do
+toCore :: 
+  [Module.ModuleName] -- ^ The modules that need to be imported before translating
+                      --   this expression.
+  -> HsSyn.HsExpr RdrName.RdrName -- ^ The expression to translate to Core.
+  -> GHC.Ghc CoreSyn.CoreExpr -- ^ The resulting core expression.
+toCore modules expr = do
   env <- GHC.getSession
   let icontext = HscTypes.hsc_IC env
   
@@ -75,6 +79,7 @@ toCore 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
@@ -161,7 +166,7 @@ eval_type_level_int ty =
     let undef = hsTypedUndef $ coreToHsType ty
     let app = HsExpr.HsApp (to_int) (undef)
 
-    core <- toCore app
+    core <- toCore [] app
     execCore core 
 
 -- These functions build (parts of) a LHSExpr RdrName.