[commit: ghc] master: Cosmetic: Fix all uses of the word 'worker' when referring to pattern synonym builders (cf0e100)
git at git.haskell.org
git at git.haskell.org
Tue Jan 20 14:13:40 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/cf0e10077c67018669633e14e7e574d38a9fb174/ghc
>---------------------------------------------------------------
commit cf0e10077c67018669633e14e7e574d38a9fb174
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date: Tue Jan 20 19:30:42 2015 +0800
Cosmetic: Fix all uses of the word 'worker' when referring to pattern synonym builders
>---------------------------------------------------------------
cf0e10077c67018669633e14e7e574d38a9fb174
compiler/rename/RnBinds.hs | 12 ++++++------
compiler/typecheck/TcBinds.hs | 6 +++---
compiler/typecheck/TcPatSyn.hs | 26 ++++++++++++++++----------
3 files changed, 25 insertions(+), 19 deletions(-)
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index 7a9dcae..97eb457 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -595,7 +595,7 @@ rnPatSynBind _sig_fn bind@(PSB { psb_id = L _ name
; fvs' `seq` -- See Note [Free-variable space leak]
return (bind', [name], fvs1)
- -- See Note [Pattern synonym wrappers don't yield dependencies]
+ -- See Note [Pattern synonym builders don't yield dependencies]
}
where
lookupVar = wrapLocM lookupOccRn
@@ -606,10 +606,10 @@ rnPatSynBind _sig_fn bind@(PSB { psb_id = L _ name
2 (ptext (sLit "Use -XPatternSynonyms to enable this extension"))
{-
-Note [Pattern synonym wrappers don't yield dependencies]
+Note [Pattern synonym builders don't yield dependencies]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When renaming a pattern synonym that has an explicit wrapper,
-references in the wrapper definition should not be used when
+When renaming a pattern synonym that has an explicit builder,
+references in the builder definition should not be used when
calculating dependencies. For example, consider the following pattern
synonym definition:
@@ -622,9 +622,9 @@ In this case, 'P' needs to be typechecked in two passes:
1. Typecheck the pattern definition of 'P', which fully determines the
type of 'P'. This step doesn't require knowing anything about 'f',
-since the wrapper definition is not looked at.
+since the builder definition is not looked at.
-2. Typecheck the wrapper definition, which needs the typechecked
+2. Typecheck the builder definition, which needs the typechecked
definition of 'f' to be in scope.
This behaviour is implemented in 'tcValBinds', but it crucially
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index f421c74..fc84c59 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -313,9 +313,9 @@ tcValBinds top_lvl binds sigs thing_inside
; tcExtendIdEnv3 [(idName id, id) | id <- poly_ids] (mkVarSet nwc_tvs) $ do
{ (binds', (extra_binds', thing)) <- tcBindGroups top_lvl sig_fn prag_fn binds $ do
{ thing <- thing_inside
- -- See Note [Pattern synonym wrappers don't yield dependencies]
- ; patsyn_workers <- mapM tcPatSynBuilderBind patsyns
- ; let extra_binds = [ (NonRecursive, worker) | worker <- patsyn_workers ]
+ -- See Note [Pattern synonym builders don't yield dependencies]
+ ; patsyn_builders <- mapM tcPatSynBuilderBind patsyns
+ ; let extra_binds = [ (NonRecursive, builder) | builder <- patsyn_builders ]
; return (extra_binds, thing) }
; return (binds' ++ extra_binds', thing) }}
where
diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs
index 612eabe..9cc8222 100644
--- a/compiler/typecheck/TcPatSyn.hs
+++ b/compiler/typecheck/TcPatSyn.hs
@@ -191,7 +191,13 @@ tc_patsyn_finish lname dir is_infix lpat'
(ex_tvs, subst, prov_theta, prov_ev_binds, prov_dicts)
wrapped_args
pat_ty
- = do { (matcher_id, matcher_bind) <- tcPatSynMatcher lname lpat'
+ = do { traceTc "tc_patsyn_finish {" $
+ ppr (unLoc lname) $$ ppr (unLoc lpat') $$
+ ppr (univ_tvs, req_theta, req_ev_binds, req_dicts) $$
+ ppr (ex_tvs, subst, prov_theta, prov_ev_binds, prov_dicts) $$
+ ppr wrapped_args $$
+ ppr pat_ty
+ ; (matcher_id, matcher_bind) <- tcPatSynMatcher lname lpat'
(univ_tvs, req_theta, req_ev_binds, req_dicts)
(ex_tvs, subst, prov_theta, prov_ev_binds, prov_dicts)
wrapped_args
@@ -350,25 +356,25 @@ tcPatSynBuilderBind PSB{ psb_id = L loc name, psb_def = lpat
| otherwise -- Bidirectional
= do { patsyn <- tcLookupPatSyn name
- ; let Just (worker_id, need_dummy_arg) = patSynBuilder patsyn
+ ; let Just (builder_id, need_dummy_arg) = patSynBuilder patsyn
-- Bidirectional, so patSynBuilder returns Just
match_group' | need_dummy_arg = add_dummy_arg match_group
| otherwise = match_group
- bind = FunBind { fun_id = L loc (idName worker_id)
+ bind = FunBind { fun_id = L loc (idName builder_id)
, fun_infix = False
, fun_matches = match_group'
, fun_co_fn = idHsWrapper
, bind_fvs = placeHolderNamesTc
, fun_tick = [] }
- ; sig <- instTcTySigFromId worker_id
+ ; sig <- instTcTySigFromId builder_id
-- See Note [Redundant constraints for builder]
- ; (worker_binds, _, _) <- tcPolyCheck NonRecursive (const []) sig (noLoc bind)
- ; traceTc "tcPatSynDecl worker" $ ppr worker_binds
- ; return worker_binds }
+ ; (builder_binds, _, _) <- tcPolyCheck NonRecursive (const []) sig (noLoc bind)
+ ; traceTc "tcPatSynBuilderBind }" $ ppr builder_binds
+ ; return builder_binds }
where
Just match_group = mb_match_group
mb_match_group
@@ -378,10 +384,10 @@ tcPatSynBuilderBind PSB{ psb_id = L loc name, psb_def = lpat
ImplicitBidirectional -> fmap mk_mg (tcPatToExpr args lpat)
mk_mg :: LHsExpr Name -> MatchGroup Name (LHsExpr Name)
- mk_mg body = mkMatchGroupName Generated [wrapper_match]
+ mk_mg body = mkMatchGroupName Generated [builder_match]
where
- wrapper_args = [L loc (VarPat n) | L loc n <- args]
- wrapper_match = mkMatch wrapper_args body EmptyLocalBinds
+ builder_args = [L loc (VarPat n) | L loc n <- args]
+ builder_match = mkMatch builder_args body EmptyLocalBinds
args = case details of
PrefixPatSyn args -> args
More information about the ghc-commits
mailing list