summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDr. ERDI Gergo <gergo@erdi.hu>2015-01-20 19:30:42 +0800
committerDr. ERDI Gergo <gergo@erdi.hu>2015-01-20 22:10:37 +0800
commitcf0e10077c67018669633e14e7e574d38a9fb174 (patch)
tree46806dfd9a1846cf5debb793f6a89c2cc8f001f4
parent6108d95a73f93d486223064ad72bf6bedc116cbd (diff)
downloadhaskell-cf0e10077c67018669633e14e7e574d38a9fb174.tar.gz
Cosmetic: Fix all uses of the word 'worker' when referring to pattern synonym builders
-rw-r--r--compiler/rename/RnBinds.hs12
-rw-r--r--compiler/typecheck/TcBinds.hs6
-rw-r--r--compiler/typecheck/TcPatSyn.hs28
3 files changed, 26 insertions, 20 deletions
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index 7a9dcae6ae..97eb4577bd 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 f421c74f54..fc84c595e6 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 612eabe5f3..9cc8222451 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,38 +356,38 @@ 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
+ mb_match_group
= case dir of
Unidirectional -> Nothing
ExplicitBidirectional explicit_mg -> Just explicit_mg
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