[project @ 2004-11-18 00:56:18 by igloo]

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

diff --git a/ghc/compiler/typecheck/TcSplice.lhs b/ghc/compiler/typecheck/TcSplice.lhs
index 66c0f57..31dfd31 100644 (file)
--- a/ghc/compiler/typecheck/TcSplice.lhs
+++ b/ghc/compiler/typecheck/TcSplice.lhs
@@ -43,9 +43,9 @@ import Var            ( Id, TyVar, idType )
 import Module          ( moduleUserString, mkModuleName )
 import TcRnMonad
 import IfaceEnv                ( lookupOrig )
-import Class           ( Class, classBigSig )
+import Class           ( Class, classExtraBigSig )
 import TyCon           ( TyCon, AlgTyConRhs(..), tyConTyVars, getSynTyConDefn, 
-                         isSynTyCon, isNewTyCon, tyConDataCons, algTcRhs )
+                         isSynTyCon, isNewTyCon, tyConDataCons, algTyConRhs )
 import DataCon         ( DataCon, dataConTyCon, dataConOrigArgTys, dataConStrictMarks, 
                          dataConName, dataConFieldLabels, dataConWrapId, dataConIsInfix, 
                          isVanillaDataCon )
@@ -140,7 +140,7 @@ tc_bracket (TypBr typ)
        -- Result type is Type (= Q Typ)
 
 tc_bracket (DecBr decls)
-  = tcTopSrcDecls decls                `thenM_`
+  = tcTopSrcDecls [{- no boot-names -}] decls          `thenM_`
        -- Typecheck the declarations, dicarding the result
        -- We'll get all that stuff later, when we splice it in
 
@@ -569,7 +569,7 @@ reifyTyCon tc
        ; return (TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs') }
 
 reifyTyCon tc
-  = case algTcRhs tc of
+  = case algTyConRhs tc of
       NewTyCon data_con _ _ 
        -> do   { con <- reifyDataCon data_con
                ; return (TH.NewtypeD [] (reifyName tc) (reifyTyVars (tyConTyVars tc))
@@ -608,9 +608,10 @@ reifyClass :: Class -> TcM TH.Dec
 reifyClass cls 
   = do { cxt <- reifyCxt theta
        ; ops <- mapM reify_op op_stuff
-       ; return (TH.ClassD cxt (reifyName cls) (reifyTyVars tvs) ops) }
+       ; return (TH.ClassD cxt (reifyName cls) (reifyTyVars tvs) fds' ops) }
   where
-    (tvs, theta, _, op_stuff) = classBigSig cls
+    (tvs, fds, theta, _, op_stuff) = classExtraBigSig cls
+    fds' = map reifyFunDep fds
     reify_op (op, _) = do { ty <- reifyType (idType op)
                          ; return (TH.SigD (reifyName op) ty) }
 
@@ -618,7 +619,6 @@ reifyClass cls
 reifyType :: TypeRep.Type -> TcM TH.Type
 reifyType (TyVarTy tv)     = return (TH.VarT (reifyName tv))
 reifyType (TyConApp tc tys) = reify_tc_app (reifyName tc) tys
-reifyType (NewTcApp tc tys) = reify_tc_app (reifyName tc) tys
 reifyType (NoteTy _ ty)     = reifyType ty
 reifyType (AppTy t1 t2)     = do { [r1,r2] <- reifyTypes [t1,t2] ; return (r1 `TH.AppT` r2) }
 reifyType (FunTy t1 t2)     = do { [r1,r2] <- reifyTypes [t1,t2] ; return (TH.ArrowT `TH.AppT` r1 `TH.AppT` r2) }
@@ -630,6 +630,9 @@ reifyType ty@(ForAllTy _ _) = do { cxt' <- reifyCxt cxt;
 reifyTypes = mapM reifyType
 reifyCxt   = mapM reifyPred
 
+reifyFunDep :: ([TyVar], [TyVar]) -> TH.FunDep
+reifyFunDep (xs, ys) = TH.FunDep (map reifyName xs) (map reifyName ys)
+
 reifyTyVars :: [TyVar] -> [TH.Name]
 reifyTyVars = map reifyName