diff options
author | Dr. ERDI Gergo <gergo@erdi.hu> | 2015-01-20 19:30:42 +0800 |
---|---|---|
committer | Dr. ERDI Gergo <gergo@erdi.hu> | 2015-01-20 22:10:37 +0800 |
commit | cf0e10077c67018669633e14e7e574d38a9fb174 (patch) | |
tree | 46806dfd9a1846cf5debb793f6a89c2cc8f001f4 | |
parent | 6108d95a73f93d486223064ad72bf6bedc116cbd (diff) | |
download | haskell-cf0e10077c67018669633e14e7e574d38a9fb174.tar.gz |
Cosmetic: Fix all uses of the word 'worker' when referring to pattern synonym builders
-rw-r--r-- | compiler/rename/RnBinds.hs | 12 | ||||
-rw-r--r-- | compiler/typecheck/TcBinds.hs | 6 | ||||
-rw-r--r-- | compiler/typecheck/TcPatSyn.hs | 28 |
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 |