diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2020-11-26 15:34:46 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-01-22 14:58:53 -0500 |
| commit | 29173f888892f18f3461880ef81ee7ba5fd539db (patch) | |
| tree | 53c5cd78554d732c891a670954b22df178fb97ec /compiler/GHC/HsToCore/Quote.hs | |
| parent | 01ea56a22d7cf55f5285b130b357d3112c92de5b (diff) | |
| download | haskell-29173f888892f18f3461880ef81ee7ba5fd539db.tar.gz | |
Factorize and document binder collect functions
Parameterize collect*Binders functions with a flag indicating if
evidence binders should be collected.
The related note in GHC.Hs.Utils has been updated.
Bump haddock submodule
Diffstat (limited to 'compiler/GHC/HsToCore/Quote.hs')
| -rw-r--r-- | compiler/GHC/HsToCore/Quote.hs | 14 |
1 files changed, 7 insertions, 7 deletions
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs index d39a6d716a..629b082f6e 100644 --- a/compiler/GHC/HsToCore/Quote.hs +++ b/compiler/GHC/HsToCore/Quote.hs @@ -265,7 +265,7 @@ first generate a polymorphic definition and then just apply the wrapper at the e data M a repTopP :: LPat GhcRn -> MetaM (Core (M TH.Pat)) -repTopP pat = do { ss <- mkGenSyms (collectPatBinders pat) +repTopP pat = do { ss <- mkGenSyms (collectPatBinders CollNoDictBinders pat) ; pat' <- addBinds ss (repLP pat) ; wrapGenSyms ss pat' } @@ -1618,7 +1618,7 @@ repE e = notHandled "Expression form" (ppr e) repMatchTup :: LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Match)) repMatchTup (L _ (Match { m_pats = [p] , m_grhss = GRHSs _ guards (L _ wheres) })) = - do { ss1 <- mkGenSyms (collectPatBinders p) + do { ss1 <- mkGenSyms (collectPatBinders CollNoDictBinders p) ; addBinds ss1 $ do { ; p1 <- repLP p ; (ss2,ds) <- repBinds wheres @@ -1631,7 +1631,7 @@ repMatchTup _ = panic "repMatchTup: case alt with more than one arg" repClauseTup :: LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Clause)) repClauseTup (L _ (Match { m_pats = ps , m_grhss = GRHSs _ guards (L _ wheres) })) = - do { ss1 <- mkGenSyms (collectPatsBinders ps) + do { ss1 <- mkGenSyms (collectPatsBinders CollNoDictBinders ps) ; addBinds ss1 $ do { ps1 <- repLPs ps ; (ss2,ds) <- repBinds wheres @@ -1714,7 +1714,7 @@ repLSts stmts = repSts (map unLoc stmts) repSts :: [Stmt GhcRn (LHsExpr GhcRn)] -> MetaM ([GenSymBind], [Core (M TH.Stmt)]) repSts (BindStmt _ p e : ss) = do { e2 <- repLE e - ; ss1 <- mkGenSyms (collectPatBinders p) + ; ss1 <- mkGenSyms (collectPatBinders CollNoDictBinders p) ; addBinds ss1 $ do { ; p1 <- repLP p; ; (ss2,zs) <- repSts ss @@ -1749,7 +1749,7 @@ repSts [LastStmt _ e _ _] ; z <- repNoBindSt e2 ; return ([], [z]) } repSts (stmt@RecStmt{} : ss) - = do { let binders = collectLStmtsBinders (recS_stmts stmt) + = do { let binders = collectLStmtsBinders CollNoDictBinders (recS_stmts stmt) ; ss1 <- mkGenSyms binders -- Bring all of binders in the recursive group into scope for the -- whole group. @@ -1779,7 +1779,7 @@ repBinds (HsIPBinds _ (IPBinds _ decs)) } repBinds (HsValBinds _ decs) - = do { let { bndrs = hsScopedTvBinders decs ++ collectHsValBinders decs } + = do { let { bndrs = hsScopedTvBinders decs ++ collectHsValBinders CollNoDictBinders decs } -- No need to worry about detailed scopes within -- the binding group, because we are talking Names -- here, so we can safely treat it as a mutually @@ -1971,7 +1971,7 @@ repLambda :: LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Exp)) repLambda (L _ (Match { m_pats = ps , m_grhss = GRHSs _ [L _ (GRHS _ [] e)] (L _ (EmptyLocalBinds _)) } )) - = do { let bndrs = collectPatsBinders ps ; + = do { let bndrs = collectPatsBinders CollNoDictBinders ps ; ; ss <- mkGenSyms bndrs ; lam <- addBinds ss ( do { xs <- repLPs ps; body <- repLE e; repLam xs body }) |