Massive patch for the first months work adding System FC to GHC #34

[ghc-hetmet.git] / compiler / typecheck / TcSplice.lhs

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index f1e8c56..d59b0f8 100644 (file)
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -55,6 +55,8 @@ import Id             ( idName, globalIdDetails )
 import IdInfo          ( GlobalIdDetails(..) )
 import TysWiredIn      ( mkListTy )
 import DsMeta          ( expQTyConName, typeQTyConName, decTyConName, qTyConName, nameTyConName )
+import DsExpr          ( dsLExpr )
+import DsMonad         ( initDsTc )
 import ErrUtils                ( Message )
 import SrcLoc          ( SrcSpan, noLoc, unLoc, getLoc )
 import Outputable
@@ -368,17 +370,14 @@ runMeta :: (SrcSpan -> th_syn -> Either Message hs_syn)
        -> LHsExpr Id           -- Of type X
        -> TcM hs_syn           -- Of type t
 runMeta convert expr
-  = do { hsc_env <- getTopEnv
-       ; tcg_env <- getGblEnv
-       ; this_mod <- getModule
-       ; let type_env = tcg_type_env tcg_env
-             rdr_env  = tcg_rdr_env tcg_env
+  = do {       -- Desugar
+         ds_expr <- initDsTc (dsLExpr expr)
 
        -- Compile and link it; might fail if linking fails
+       ; hsc_env <- getTopEnv
+       ; src_span <- getSrcSpanM
        ; either_hval <- tryM $ ioToTcRn $
-                        HscMain.compileExpr 
-                                     hsc_env this_mod 
-                                     rdr_env type_env expr
+                        HscMain.compileExpr hsc_env src_span ds_expr
        ; case either_hval of {
            Left exn   -> failWithTc (mk_msg "compile and link" exn) ;
            Right hval -> do
@@ -568,9 +567,9 @@ reifyThing (AGlobal (ADataCon dc))
        ; fix <- reifyFixity name
        ; return (TH.DataConI (reifyName name) ty (reifyName (dataConTyCon dc)) fix) }
 
-reifyThing (ATcId id _ _) 
-  = do { ty1 <- zonkTcType (idType id) -- Make use of all the info we have, even
-                                       -- though it may be incomplete
+reifyThing (ATcId {tct_id = id, tct_ty = ty}) 
+  = do { ty1 <- zonkTcType ty  -- Make use of all the info we have, even
+                               -- though it may be incomplete
        ; ty2 <- reifyType ty1
        ; fix <- reifyFixity (idName id)
        ; return (TH.VarI (reifyName id) ty2 Nothing fix) }