X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsMeta.hs;h=3518aaf87f6bef7d773471daebb01e3fb55c3f71;hp=9aac831b9bd0c93ca264923c3e9b41bdc9230db1;hb=432b9c9322181a3644083e3c19b7e240d90659e7;hpb=97a8fe8780307e95829034117efa98d2e27109cd diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 9aac831..3518aaf 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -333,7 +333,7 @@ repInstD' (L loc (InstDecl ty binds _ ats)) -- Ignore user pragmas for now (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))) +repForD (L loc (ForeignImport name typ (CImport cc s ch cis))) = do MkC name' <- lookupLOcc name MkC typ' <- repLTy typ MkC cc' <- repCCallConv cc @@ -341,7 +341,6 @@ repForD (L loc (ForeignImport name typ (CImport cc s ch cn cis))) cis' <- conv_cimportspec cis MkC str <- coreStringLit $ static ++ unpackFS ch ++ " " - ++ unpackFS cn ++ " " ++ cis' dec <- rep2 forImpDName [cc', s', str, name', typ'] return (loc, dec) @@ -358,7 +357,7 @@ repForD decl = notHandled "Foreign declaration" (ppr decl) repCCallConv :: CCallConv -> DsM (Core TH.Callconv) repCCallConv CCallConv = rep2 cCallName [] repCCallConv StdCallConv = rep2 stdCallName [] -repCCallConv CmmCallConv = notHandled "repCCallConv" (ppr CmmCallConv) +repCCallConv callConv = notHandled "repCCallConv" (ppr callConv) repSafety :: Safety -> DsM (Core TH.Safety) repSafety PlayRisky = rep2 unsafeName [] @@ -373,14 +372,14 @@ ds_msg = ptext (sLit "Cannot desugar this Template Haskell declaration:") ------------------------------------------------------- repC :: LConDecl Name -> DsM (Core TH.ConQ) -repC (L _ (ConDecl con _ [] (L _ []) details ResTyH98 _)) +repC (L _ (ConDecl { con_name = con, con_qvars = [], con_cxt = L _ [] + , con_details = details, con_res = ResTyH98 })) = do { con1 <- lookupLOcc con -- See note [Binders and occurrences] ; repConstr con1 details } -repC (L loc (ConDecl con expl tvs (L cloc ctxt) details ResTyH98 doc)) +repC (L loc con_decl@(ConDecl { con_qvars = tvs, con_cxt = L cloc ctxt, con_res = ResTyH98 })) = addTyVarBinds tvs $ \bndrs -> - do { c' <- repC (L loc (ConDecl con expl [] (L cloc []) details - ResTyH98 doc)) + do { c' <- repC (L loc (con_decl { con_qvars = [], con_cxt = L cloc [] })) ; ctxt' <- repContext ctxt ; bndrs' <- coreList tyVarBndrTyConName bndrs ; rep2 forallCName [unC bndrs', unC ctxt', unC c']