-repTyClD' d = do { addDsWarn (hang msg 4 (ppr d)) ;
- return Nothing
- }
- where
- msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
-
-repInstD' (InstDecl ty binds _ loc)
- -- Ignore user pragmas for now
- = do { cxt1 <- repContext cxt ;
- inst_ty1 <- repPred (HsClassP cls tys) ;
- binds1 <- rep_monobind binds ;
- decls1 <- coreList decQTyConName binds1 ;
- i <- repInst cxt1 inst_ty1 decls1;
- return (loc, i)}
+repTyClD (L loc d) = putSrcSpanDs loc $
+ do { dsWarn (hang ds_msg 4 (ppr d))
+ ; return Nothing }
+
+-- represent fundeps
+--
+repLFunDeps :: [Located (FunDep Name)] -> DsM (Core [TH.FunDep])
+repLFunDeps fds = do fds' <- mapM repLFunDep fds
+ fdList <- coreList funDepTyConName fds'
+ return fdList
+
+repLFunDep :: Located (FunDep Name) -> DsM (Core TH.FunDep)
+repLFunDep (L _ (xs, ys)) = do xs' <- mapM lookupBinder xs
+ ys' <- mapM lookupBinder ys
+ xs_list <- coreList nameTyConName xs'
+ ys_list <- coreList nameTyConName ys'
+ repFunDep xs_list ys_list
+
+repInstD' (L loc (InstDecl ty binds _)) -- Ignore user pragmas for now
+ = do { i <- addTyVarBinds tvs $ \tv_bndrs ->
+ -- We must bring the type variables into scope, so their occurrences
+ -- don't fail, even though the binders don't appear in the resulting
+ -- data structure
+ do { cxt1 <- repContext cxt
+ ; inst_ty1 <- repPred (HsClassP cls tys)
+ ; ss <- mkGenSyms (collectHsBindBinders binds)
+ ; binds1 <- addBinds ss (rep_binds binds)
+ ; decls1 <- coreList decQTyConName binds1
+ ; decls2 <- wrapNongenSyms ss decls1
+ -- wrapNonGenSyms: do not clone the class op names!
+ -- They must be called 'op' etc, not 'op34'
+ ; repInst cxt1 inst_ty1 decls2 }
+
+ ; return (loc, i)}
+ where
+ (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
+
+repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
+repForD (L loc (ForeignImport name typ (CImport cc s ch cn cis) _))
+ = do MkC name' <- lookupLOcc name
+ MkC typ' <- repLTy typ
+ MkC cc' <- repCCallConv cc
+ MkC s' <- repSafety s
+ MkC str <- coreStringLit $ static
+ ++ unpackFS ch ++ " "
+ ++ unpackFS cn ++ " "
+ ++ conv_cimportspec cis
+ dec <- rep2 forImpDName [cc', s', str, name', typ']
+ return (loc, dec)