diff options
author | Sebastian Graf <sebastian.graf@kit.edu> | 2018-11-13 14:54:54 +0100 |
---|---|---|
committer | Sebastian Graf <sebastian.graf@kit.edu> | 2018-11-13 14:54:55 +0100 |
commit | 5b98a38a32f2bc8491dc897631be8892919e2143 (patch) | |
tree | 0de170c19d2ad70b0bf59b29c6e5353c5c228b4f /compiler/deSugar/DsArrows.hs | |
parent | 0f2ac24c26fb951cc81100085c7773906a241523 (diff) | |
download | haskell-5b98a38a32f2bc8491dc897631be8892919e2143.tar.gz |
Make `UniqDSet` a newtype
Summary:
This brings the situation of `UniqDSet` in line with `UniqSet`.
@dfeuer said in D3146#92820 that he would do this, but probably
never got around to it.
Validated locally.
Reviewers: AndreasK, mpickering, bgamari, dfeuer, simonpj
Reviewed By: simonpj
Subscribers: simonpj, rwbarton, carter, dfeuer
GHC Trac Issues: #15879, #13114
Differential Revision: https://phabricator.haskell.org/D5313
Diffstat (limited to 'compiler/deSugar/DsArrows.hs')
-rw-r--r-- | compiler/deSugar/DsArrows.hs | 23 |
1 files changed, 11 insertions, 12 deletions
diff --git a/compiler/deSugar/DsArrows.hs b/compiler/deSugar/DsArrows.hs index 8837eeae40..5bafcbf001 100644 --- a/compiler/deSugar/DsArrows.hs +++ b/compiler/deSugar/DsArrows.hs @@ -52,8 +52,7 @@ import SrcLoc import ListSetOps( assocMaybe ) import Data.List import Util -import UniqDFM -import UniqSet +import UniqDSet data DsCmdEnv = DsCmdEnv { arr_id, compose_id, first_id, app_id, choice_id, loop_id :: CoreExpr @@ -379,7 +378,7 @@ dsCmd ids local_vars stack_ty res_ty res_ty core_make_arg core_arrow, - exprFreeIdsDSet core_arg `udfmIntersectUFM` (getUniqSet local_vars)) + exprFreeIdsDSet core_arg `uniqDSetIntersectUniqSet` local_vars) -- D, xs |- fun :: a t1 t2 -- D, xs |- arg :: t1 @@ -408,7 +407,7 @@ dsCmd ids local_vars stack_ty res_ty core_make_pair (do_app ids arg_ty res_ty), (exprsFreeIdsDSet [core_arrow, core_arg]) - `udfmIntersectUFM` getUniqSet local_vars) + `uniqDSetIntersectUniqSet` local_vars) -- D; ys |-a cmd : (t,stk) --> t' -- D, xs |- exp :: t @@ -441,7 +440,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdApp _ cmd arg) env_ids = do core_map core_cmd, free_vars `unionDVarSet` - (exprFreeIdsDSet core_arg `udfmIntersectUFM` getUniqSet local_vars)) + (exprFreeIdsDSet core_arg `uniqDSetIntersectUniqSet` local_vars)) -- D; ys |-a cmd : stk t' -- ----------------------------------------------- @@ -479,7 +478,7 @@ dsCmd ids local_vars stack_ty res_ty -- match the old environment and stack against the input select_code <- matchEnvStack env_ids stack_id param_code return (do_premap ids in_ty in_ty' res_ty select_code core_body, - free_vars `udfmMinusUFM` getUniqSet pat_vars) + free_vars `uniqDSetMinusUniqSet` pat_vars) dsCmd ids local_vars stack_ty res_ty (HsCmdPar _ cmd) env_ids = dsLCmd ids local_vars stack_ty res_ty cmd env_ids @@ -511,7 +510,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdIf _ mb_fun cond then_cmd else_cmd) then_ty = envStackType then_ids stack_ty else_ty = envStackType else_ids stack_ty sum_ty = mkTyConApp either_con [then_ty, else_ty] - fvs_cond = exprFreeIdsDSet core_cond `udfmIntersectUFM` getUniqSet local_vars + fvs_cond = exprFreeIdsDSet core_cond `uniqDSetIntersectUniqSet` local_vars core_left = mk_left_expr then_ty else_ty (buildEnvStack then_ids stack_id) core_right = mk_right_expr then_ty else_ty (buildEnvStack else_ids stack_id) @@ -611,7 +610,7 @@ dsCmd ids local_vars stack_ty res_ty core_matches <- matchEnvStack env_ids stack_id core_body return (do_premap ids in_ty sum_ty res_ty core_matches core_choices, - exprFreeIdsDSet core_body `udfmIntersectUFM` getUniqSet local_vars) + exprFreeIdsDSet core_body `uniqDSetIntersectUniqSet` local_vars) -- D; ys |-a cmd : stk --> t -- ---------------------------------- @@ -637,7 +636,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdLet _ lbinds@(L _ binds) body) res_ty core_map core_body, - exprFreeIdsDSet core_binds `udfmIntersectUFM` getUniqSet local_vars) + exprFreeIdsDSet core_binds `uniqDSetIntersectUniqSet` local_vars) -- D; xs |-a ss : t -- ---------------------------------- @@ -892,7 +891,7 @@ dsCmdStmt ids local_vars out_ids (BindStmt _ pat cmd _ _) env_ids = do do_compose ids before_c_ty after_c_ty out_ty (do_first ids in_ty1 pat_ty in_ty2 core_cmd) $ do_arr ids after_c_ty out_ty proj_expr, - fv_cmd `unionDVarSet` (mkDVarSet out_ids `udfmMinusUFM` getUniqSet pat_vars)) + fv_cmd `unionDVarSet` (mkDVarSet out_ids `uniqDSetMinusUniqSet` pat_vars)) -- D; xs' |-a do { ss } : t -- -------------------------------------- @@ -909,7 +908,7 @@ dsCmdStmt ids local_vars out_ids (LetStmt _ binds) env_ids = do (mkBigCoreVarTupTy env_ids) (mkBigCoreVarTupTy out_ids) core_map, - exprFreeIdsDSet core_binds `udfmIntersectUFM` getUniqSet local_vars) + exprFreeIdsDSet core_binds `uniqDSetIntersectUniqSet` local_vars) -- D; ys |-a do { ss; returnA -< ((xs1), (ys2)) } : ... -- D; xs' |-a do { ss' } : t @@ -1029,7 +1028,7 @@ dsRecCmd ids local_vars stmts later_ids later_rets rec_ids rec_rets = do rec_id <- newSysLocalDs rec_ty let - env1_id_set = fv_stmts `udfmMinusUFM` getUniqSet rec_id_set + env1_id_set = fv_stmts `uniqDSetMinusUniqSet` rec_id_set env1_ids = dVarSetElems env1_id_set env1_ty = mkBigCoreVarTupTy env1_ids in_pair_ty = mkCorePairTy env1_ty rec_ty |