X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsMeta.hs;h=b24daea7810b770fab96f76175c11af4a56598c9;hb=edeee10702955ca3c53444f2f328b4cce0ab3e32;hp=3f7f4d02f864ad8d1e22b809f98c3b4b41796ac6;hpb=f69bf6be6101d6b5d7952c384dd5eeb1917b4cdb;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 3f7f4d0..b24daea 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] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -470,15 +460,17 @@ rep_specialise nm ty ispec loc rep_InlinePrag :: InlinePragma -- Never defaultInlinePragma -> DsM (Core TH.InlineSpecQ) rep_InlinePrag (InlinePragma { inl_act = activation, inl_rule = match, inl_inline = inline }) - | Nothing <- activation1 - = repInlineSpecNoPhase inline1 match1 | Just (flag, phase) <- activation1 - = repInlineSpecPhase inline1 match1 flag phase - | otherwise = {- unreachable, but shuts up -W -} panic "rep_InlineSpec" - where + = repInlineSpecPhase inline1 match1 flag phase + | otherwise + = repInlineSpecNoPhase inline1 match1 + where match1 = coreBool (rep_RuleMatchInfo match) activation1 = rep_Activation activation - inline1 = coreBool inline + inline1 = case inline of + Inline -> coreBool True + _other -> coreBool False + -- We have no representation for Inlinable rep_RuleMatchInfo FunLike = False rep_RuleMatchInfo ConLike = True @@ -1665,10 +1657,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,