X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsMeta.hs;h=3310ffa4c280448384611dddec344310ee1a296e;hb=afe4534704e8e0c25e2f90c6c0a2e397ecef24db;hp=f071a172ffe6f510cf123f8c9f1c6e80019c7743;hpb=f1cc3eb980a634e62f2739a7a25387c902fa9d8a;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index f071a17..3310ffa 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -106,7 +106,7 @@ repTopP pat = do { ss <- mkGenSyms (collectPatBinders pat) repTopDs :: HsGroup Name -> DsM (Core (TH.Q [TH.Dec])) repTopDs group - = do { let { bndrs = groupBinders group } ; + = do { let { bndrs = hsGroupBinders group } ; ss <- mkGenSyms bndrs ; -- Bind all the names mainly to avoid repeated use of explicit strings. @@ -135,16 +135,6 @@ repTopDs group -- Do *not* gensym top-level binders } -groupBinders :: HsGroup Name -> [Name] -groupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls, - hs_instds = inst_decls, hs_fords = foreign_decls }) --- Collect the binders of a Group - = collectHsValBinders val_decls ++ - [n | d <- tycl_decls ++ assoc_tycl_decls, L _ n <- tyClDeclNames (unLoc d)] ++ - [n | L _ (ForeignImport (L _ n) _ _) <- foreign_decls] - where - assoc_tycl_decls = concat [ats | L _ (InstDecl _ _ _ ats) <- inst_decls] - {- Note [Binders and occurrences] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -644,7 +634,7 @@ repKind ki = do { let (kis, ki') = splitKindFunTys ki ; kis_rep <- mapM repKind kis ; ki'_rep <- repNonArrowKind ki' - ; foldlM repArrowK ki'_rep kis_rep + ; foldrM repArrowK ki'_rep kis_rep } where repNonArrowKind k | isLiftedTypeKind k = repStarK @@ -1665,10 +1655,11 @@ templateHaskellNames :: [Name] templateHaskellNames = [ returnQName, bindQName, sequenceQName, newNameName, liftName, mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName, - + liftStringName, + -- Lit charLName, stringLName, integerLName, intPrimLName, wordPrimLName, - floatPrimLName, doublePrimLName, rationalLName, + floatPrimLName, doublePrimLName, rationalLName, -- Pat litPName, varPName, tupPName, conPName, tildePName, bangPName, infixPName, asPName, wildPName, recPName, listPName, sigPName,