diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2017-12-20 15:36:49 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2017-12-21 14:14:21 +0000 |
| commit | 584cbd4a19887497776ce1f61c15df652b8b2ea4 (patch) | |
| tree | d38a508d7e3a4f243d4750174cf2a5d611f327da /compiler/typecheck/TcHsSyn.hs | |
| parent | 4d41e9212d1fdf109f2d0174d204644446f5874c (diff) | |
| download | haskell-584cbd4a19887497776ce1f61c15df652b8b2ea4.tar.gz | |
Simplify HsPatSynDetails
This is a pure refactoring. Use HsConDetails to implement
HsPatSynDetails, instead of defining a whole new data type.
Less code, fewer types, all good.
Diffstat (limited to 'compiler/typecheck/TcHsSyn.hs')
| -rw-r--r-- | compiler/typecheck/TcHsSyn.hs | 18 |
1 files changed, 13 insertions, 5 deletions
diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index 01b7176a6e..e188466107 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -267,6 +267,9 @@ zonkEnvIds (ZonkEnv _ _ id_env) = -- It's OK to use nonDetEltsUFM here because we forget the ordering -- immediately by creating a TypeEnv +zonkLIdOcc :: ZonkEnv -> Located TcId -> Located Id +zonkLIdOcc env (L loc id) = L loc (zonkIdOcc env id) + zonkIdOcc :: ZonkEnv -> TcId -> Id -- Ids defined in this module should be in the envt; -- ignore others. (Actually, data constructors are also @@ -508,8 +511,8 @@ zonk_bind env (PatSynBind bind@(PSB { psb_id = L loc id , psb_def = lpat , psb_dir = dir })) = do { id' <- zonkIdBndr env id - ; details' <- zonkPatSynDetails env details ; (env1, lpat') <- zonkPat env lpat + ; let details' = zonkPatSynDetails env1 details ; (_env2, dir') <- zonkPatSynDir env1 dir ; return $ PatSynBind $ bind { psb_id = L loc id' @@ -519,12 +522,17 @@ zonk_bind env (PatSynBind bind@(PSB { psb_id = L loc id zonkPatSynDetails :: ZonkEnv -> HsPatSynDetails (Located TcId) - -> TcM (HsPatSynDetails (Located Id)) -zonkPatSynDetails env = traverse (wrapLocM $ zonkIdBndr env) + -> HsPatSynDetails (Located Id) +zonkPatSynDetails env (PrefixCon as) + = PrefixCon (map (zonkLIdOcc env) as) +zonkPatSynDetails env (InfixCon a1 a2) + = InfixCon (zonkLIdOcc env a1) (zonkLIdOcc env a2) +zonkPatSynDetails env (RecCon flds) + = RecCon (map (fmap (zonkLIdOcc env)) flds) zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTcId -> TcM (ZonkEnv, HsPatSynDir GhcTc) -zonkPatSynDir env Unidirectional = return (env, Unidirectional) +zonkPatSynDir env Unidirectional = return (env, Unidirectional) zonkPatSynDir env ImplicitBidirectional = return (env, ImplicitBidirectional) zonkPatSynDir env (ExplicitBidirectional mg) = do mg' <- zonkMatchGroup env zonkLExpr mg @@ -1342,7 +1350,7 @@ zonkForeignExports env ls = mapM (wrapLocM (zonkForeignExport env)) ls zonkForeignExport :: ZonkEnv -> ForeignDecl GhcTcId -> TcM (ForeignDecl GhcTc) zonkForeignExport env (ForeignExport { fd_name = i, fd_co = co, fd_fe = spec }) - = return (ForeignExport { fd_name = fmap (zonkIdOcc env) i + = return (ForeignExport { fd_name = zonkLIdOcc env i , fd_sig_ty = undefined, fd_co = co , fd_fe = spec }) zonkForeignExport _ for_imp |