Commit cf0e1007 authored by cactus's avatar cactus

Cosmetic: Fix all uses of the word 'worker' when referring to pattern synonym builders

parent 6108d95a
......@@ -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
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment