diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs
index 084ed657624b978694e5c14f1e6b4a0c0b7e52a6..a71569e487fd41905d29ae875644fbe16baeed62 100644
--- a/compiler/coreSyn/CoreFVs.hs
+++ b/compiler/coreSyn/CoreFVs.hs
@@ -14,6 +14,9 @@ module CoreFVs (
         exprFreeVarsDSet,
         exprFreeVarsList,
         exprFreeIds,
+        exprFreeIdsDSet,
+        exprFreeIdsList,
+        exprsFreeIdsDSet,
         exprsFreeIdsList,
         exprsFreeVars,
         exprsFreeVarsList,
@@ -122,6 +125,21 @@ exprFreeIds :: CoreExpr -> IdSet        -- Find all locally-defined free Ids
 exprFreeIds = exprSomeFreeVars isLocalId
 
 -- | Find all locally-defined free Ids in an expression
+-- returning a deterministic set.
+exprFreeIdsDSet :: CoreExpr -> DIdSet -- Find all locally-defined free Ids
+exprFreeIdsDSet = exprSomeFreeVarsDSet isLocalId
+
+-- | Find all locally-defined free Ids in an expression
+-- returning a deterministically ordered list.
+exprFreeIdsList :: CoreExpr -> [Id] -- Find all locally-defined free Ids
+exprFreeIdsList = exprSomeFreeVarsList isLocalId
+
+-- | Find all locally-defined free Ids in several expressions
+-- returning a deterministic set.
+exprsFreeIdsDSet :: [CoreExpr] -> DIdSet -- Find all locally-defined free Ids
+exprsFreeIdsDSet = exprsSomeFreeVarsDSet isLocalId
+
+-- | Find all locally-defined free Ids in several expressions
 -- returning a deterministically ordered list.
 exprsFreeIdsList :: [CoreExpr] -> [Id]   -- Find all locally-defined free Ids
 exprsFreeIdsList = exprsSomeFreeVarsList isLocalId
@@ -162,6 +180,13 @@ exprSomeFreeVarsList :: InterestingVarFun -- ^ Says which 'Var's are interesting
                      -> [Var]
 exprSomeFreeVarsList fv_cand e = fvVarList $ filterFV fv_cand $ expr_fvs e
 
+-- | Finds free variables in an expression selected by a predicate
+-- returning a deterministic set.
+exprSomeFreeVarsDSet :: InterestingVarFun -- ^ Says which 'Var's are interesting
+                     -> CoreExpr
+                     -> DVarSet
+exprSomeFreeVarsDSet fv_cand e = fvDVarSet $ filterFV fv_cand $ expr_fvs e
+
 -- | Finds free variables in several expressions selected by a predicate
 exprsSomeFreeVars :: InterestingVarFun  -- Says which 'Var's are interesting
                   -> [CoreExpr]
@@ -177,6 +202,14 @@ exprsSomeFreeVarsList :: InterestingVarFun  -- Says which 'Var's are interesting
 exprsSomeFreeVarsList fv_cand es =
   fvVarList $ filterFV fv_cand $ mapUnionFV expr_fvs es
 
+-- | Finds free variables in several expressions selected by a predicate
+-- returning a deterministic set.
+exprsSomeFreeVarsDSet :: InterestingVarFun -- ^ Says which 'Var's are interesting
+                      -> [CoreExpr]
+                      -> DVarSet
+exprsSomeFreeVarsDSet fv_cand e =
+  fvDVarSet $ filterFV fv_cand $ mapUnionFV expr_fvs e
+
 --      Comment about obselete code
 -- We used to gather the free variables the RULES at a variable occurrence
 -- with the following cryptic comment:
diff --git a/compiler/deSugar/DsArrows.hs b/compiler/deSugar/DsArrows.hs
index cdf839a47defb68bf3a6e3129b6fd5e412edb438..822708808ca665e72ff98167e54c31ca3707c46b 100644
--- a/compiler/deSugar/DsArrows.hs
+++ b/compiler/deSugar/DsArrows.hs
@@ -49,6 +49,7 @@ import SrcLoc
 import ListSetOps( assocDefault )
 import Data.List
 import Util
+import UniqDFM
 
 data DsCmdEnv = DsCmdEnv {
         arr_id, compose_id, first_id, app_id, choice_id, loop_id :: CoreExpr
@@ -291,7 +292,7 @@ to an expression e such that
 -}
 
 dsLCmd :: DsCmdEnv -> IdSet -> Type -> Type -> LHsCmd Id -> [Id]
-       -> DsM (CoreExpr, IdSet)
+       -> DsM (CoreExpr, DIdSet)
 dsLCmd ids local_vars stk_ty res_ty cmd env_ids
   = dsCmd ids local_vars stk_ty res_ty (unLoc cmd) env_ids
 
@@ -304,7 +305,7 @@ dsCmd   :: DsCmdEnv             -- arrow combinators
                                 -- This is typically fed back,
                                 -- so don't pull on it too early
         -> DsM (CoreExpr,       -- desugared expression
-                IdSet)          -- subset of local vars that occur free
+                DIdSet)         -- subset of local vars that occur free
 
 -- D |- fun :: a t1 t2
 -- D, xs |- arg :: t1
@@ -329,7 +330,7 @@ dsCmd ids local_vars stack_ty res_ty
               res_ty
               core_make_arg
               core_arrow,
-            exprFreeIds core_arg `intersectVarSet` local_vars)
+            exprFreeIdsDSet core_arg `udfmIntersectUFM` local_vars)
 
 -- D, xs |- fun :: a t1 t2
 -- D, xs |- arg :: t1
@@ -357,8 +358,8 @@ dsCmd ids local_vars stack_ty res_ty
               res_ty
               core_make_pair
               (do_app ids arg_ty res_ty),
-            (exprFreeIds core_arrow `unionVarSet` exprFreeIds core_arg)
-              `intersectVarSet` local_vars)
+            (exprsFreeIdsDSet [core_arrow, core_arg])
+              `udfmIntersectUFM` local_vars)
 
 -- D; ys |-a cmd : (t,stk) --> t'
 -- D, xs |-  exp :: t
@@ -390,8 +391,8 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdApp cmd arg) env_ids = do
                       res_ty
                       core_map
                       core_cmd,
-            free_vars `unionVarSet`
-              (exprFreeIds core_arg `intersectVarSet` local_vars))
+            free_vars `unionDVarSet`
+              (exprFreeIdsDSet core_arg `udfmIntersectUFM` local_vars))
 
 -- D; ys |-a cmd : stk t'
 -- -----------------------------------------------
@@ -428,7 +429,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 `minusVarSet` pat_vars)
+            free_vars `udfmMinusUFM` 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
@@ -460,7 +461,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 = exprFreeIds core_cond `intersectVarSet` local_vars
+        fvs_cond = exprFreeIdsDSet core_cond `udfmIntersectUFM` 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)
@@ -474,7 +475,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdIf mb_fun cond then_cmd else_cmd)
     return (do_premap ids in_ty sum_ty res_ty
                 core_if
                 (do_choice ids then_ty else_ty res_ty core_then core_else),
-        fvs_cond `unionVarSet` fvs_then `unionVarSet` fvs_else)
+        fvs_cond `unionDVarSet` fvs_then `unionDVarSet` fvs_else)
 
 {-
 Case commands are treated in much the same way as if commands
@@ -556,7 +557,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,
-            exprFreeIds core_body  `intersectVarSet` local_vars)
+            exprFreeIdsDSet core_body `udfmIntersectUFM` local_vars)
 
 -- D; ys |-a cmd : stk --> t
 -- ----------------------------------
@@ -581,7 +582,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdLet (L _ binds) body) env_ids = do
                         res_ty
                         core_map
                         core_body,
-        exprFreeIds core_binds `intersectVarSet` local_vars)
+        exprFreeIdsDSet core_binds `udfmIntersectUFM` local_vars)
 
 -- D; xs |-a ss : t
 -- ----------------------------------
@@ -611,7 +612,7 @@ dsCmd _ids local_vars _stack_ty _res_ty (HsCmdArrForm op _ args) env_ids = do
     core_op <- dsLExpr op
     (core_args, fv_sets) <- mapAndUnzipM (dsTrimCmdArg local_vars env_ids) args
     return (mkApps (App core_op (Type env_ty)) core_args,
-            unionVarSets fv_sets)
+            unionDVarSets fv_sets)
 
 dsCmd ids local_vars stack_ty res_ty (HsCmdWrap wrap cmd) env_ids = do
     (core_cmd, env_ids') <- dsCmd ids local_vars stack_ty res_ty cmd env_ids
@@ -629,7 +630,7 @@ dsTrimCmdArg
         -> [Id]                 -- list of vars in the input to this command
         -> LHsCmdTop Id         -- command argument to desugar
         -> DsM (CoreExpr,       -- desugared expression
-                IdSet)          -- subset of local vars that occur free
+                DIdSet)         -- subset of local vars that occur free
 dsTrimCmdArg local_vars env_ids (L _ (HsCmdTop cmd stack_ty cmd_ty ids)) = do
     (meth_binds, meth_ids) <- mkCmdEnv ids
     (core_cmd, free_vars, env_ids') <- dsfixCmd meth_ids local_vars stack_ty cmd_ty cmd
@@ -652,7 +653,7 @@ dsfixCmd
         -> Type                 -- return type of the command
         -> LHsCmd Id            -- command to desugar
         -> DsM (CoreExpr,       -- desugared expression
-                IdSet,          -- subset of local vars that occur free
+                DIdSet,         -- subset of local vars that occur free
                 [Id])           -- the same local vars as a list, fed back
 dsfixCmd ids local_vars stk_ty cmd_ty cmd
   = trimInput (dsLCmd ids local_vars stk_ty cmd_ty cmd)
@@ -661,16 +662,16 @@ dsfixCmd ids local_vars stk_ty cmd_ty cmd
 -- for use as the input tuple of the generated arrow.
 
 trimInput
-        :: ([Id] -> DsM (CoreExpr, IdSet))
+        :: ([Id] -> DsM (CoreExpr, DIdSet))
         -> DsM (CoreExpr,       -- desugared expression
-                IdSet,          -- subset of local vars that occur free
+                DIdSet,         -- subset of local vars that occur free
                 [Id])           -- same local vars as a list, fed back to
                                 -- the inner function to form the tuple of
                                 -- inputs to the arrow.
 trimInput build_arrow
   = fixDs (\ ~(_,_,env_ids) -> do
         (core_cmd, free_vars) <- build_arrow env_ids
-        return (core_cmd, free_vars, varSetElems free_vars))
+        return (core_cmd, free_vars, dVarSetElems free_vars))
 
 {-
 Translation of command judgements of the form
@@ -686,7 +687,7 @@ dsCmdDo :: DsCmdEnv             -- arrow combinators
                                 -- This is typically fed back,
                                 -- so don't pull on it too early
         -> DsM (CoreExpr,       -- desugared expression
-                IdSet)          -- subset of local vars that occur free
+                DIdSet)         -- subset of local vars that occur free
 
 dsCmdDo _ _ _ [] _ = panic "dsCmdDo"
 
@@ -729,7 +730,7 @@ translated to a composition of such arrows.
 -}
 
 dsCmdLStmt :: DsCmdEnv -> IdSet -> [Id] -> CmdLStmt Id -> [Id]
-           -> DsM (CoreExpr, IdSet)
+           -> DsM (CoreExpr, DIdSet)
 dsCmdLStmt ids local_vars out_ids cmd env_ids
   = dsCmdStmt ids local_vars out_ids (unLoc cmd) env_ids
 
@@ -742,7 +743,7 @@ dsCmdStmt
                                 -- This is typically fed back,
                                 -- so don't pull on it too early
         -> DsM (CoreExpr,       -- desugared expression
-                IdSet)          -- subset of local vars that occur free
+                DIdSet)         -- subset of local vars that occur free
 
 -- D; xs1 |-a c : () --> t
 -- D; xs' |-a do { ss } : t'
@@ -769,7 +770,7 @@ dsCmdStmt ids local_vars out_ids (BodyStmt cmd _ _ c_ty) env_ids = do
                 do_compose ids before_c_ty after_c_ty out_ty
                         (do_first ids in_ty1 c_ty out_ty core_cmd) $
                 do_arr ids after_c_ty out_ty snd_fn,
-              extendVarSetList fv_cmd out_ids)
+              extendDVarSetList fv_cmd out_ids)
 
 -- D; xs1 |-a c : () --> t
 -- D; xs' |-a do { ss } : t'            xs2 = xs' - defs(p)
@@ -825,7 +826,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 `unionVarSet` (mkVarSet out_ids `minusVarSet` pat_vars))
+              fv_cmd `unionDVarSet` (mkDVarSet out_ids `udfmMinusUFM` pat_vars))
 
 -- D; xs' |-a do { ss } : t
 -- --------------------------------------
@@ -842,7 +843,7 @@ dsCmdStmt ids local_vars out_ids (LetStmt (L _ binds)) env_ids = do
                         (mkBigCoreVarTupTy env_ids)
                         (mkBigCoreVarTupTy out_ids)
                         core_map,
-            exprFreeIds core_binds `intersectVarSet` local_vars)
+            exprFreeIdsDSet core_binds `udfmIntersectUFM` local_vars)
 
 -- D; ys  |-a do { ss; returnA -< ((xs1), (ys2)) } : ...
 -- D; xs' |-a do { ss' } : t
@@ -866,7 +867,7 @@ dsCmdStmt ids local_vars out_ids
     let
         later_ids_set = mkVarSet later_ids
         env2_ids = filterOut (`elemVarSet` later_ids_set) out_ids
-        env2_id_set = mkVarSet env2_ids
+        env2_id_set = mkDVarSet env2_ids
         env2_ty = mkBigCoreVarTupTy env2_ids
 
     -- post_loop_fn = \((later_ids),(env2_ids)) -> (out_ids)
@@ -908,7 +909,7 @@ dsCmdStmt ids local_vars out_ids
                         (do_arr ids post_pair_ty out_ty
                                 post_loop_fn))
 
-    return (core_body, env1_id_set `unionVarSet` env2_id_set)
+    return (core_body, env1_id_set `unionDVarSet` env2_id_set)
 
 dsCmdStmt _ _ _ _ s = pprPanic "dsCmdStmt" (ppr s)
 
@@ -924,7 +925,7 @@ dsRecCmd
         -> [Id]                 -- list of vars fed back through the loop
         -> [HsExpr Id]          -- expressions corresponding to rec_ids
         -> DsM (CoreExpr,       -- desugared statement
-                IdSet,          -- subset of local vars that occur free
+                DIdSet,         -- subset of local vars that occur free
                 [Id])           -- same local vars as a list
 
 dsRecCmd ids local_vars stmts later_ids later_rets rec_ids rec_rets = do
@@ -961,8 +962,8 @@ 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 `minusVarSet` rec_id_set
-        env1_ids = varSetElems env1_id_set
+        env1_id_set = fv_stmts `udfmMinusUFM` rec_id_set
+        env1_ids = dVarSetElems env1_id_set
         env1_ty = mkBigCoreVarTupTy env1_ids
         in_pair_ty = mkCorePairTy env1_ty rec_ty
         core_body = mkBigCoreTup (map selectVar env_ids)
@@ -998,7 +999,7 @@ dsfixCmdStmts
         -> [Id]                 -- output vars of these statements
         -> [CmdLStmt Id]        -- statements to desugar
         -> DsM (CoreExpr,       -- desugared expression
-                IdSet,          -- subset of local vars that occur free
+                DIdSet,         -- subset of local vars that occur free
                 [Id])           -- same local vars as a list
 
 dsfixCmdStmts ids local_vars out_ids stmts
@@ -1011,7 +1012,7 @@ dsCmdStmts
         -> [CmdLStmt Id]        -- statements to desugar
         -> [Id]                 -- list of vars in the input to these statements
         -> DsM (CoreExpr,       -- desugared expression
-                IdSet)          -- subset of local vars that occur free
+                DIdSet)         -- subset of local vars that occur free
 
 dsCmdStmts ids local_vars out_ids [stmt] env_ids
   = dsCmdLStmt ids local_vars out_ids stmt env_ids
diff --git a/compiler/utils/UniqDFM.hs b/compiler/utils/UniqDFM.hs
index 4bd97ef2eb8c58ac69575f0390970547e38b437c..91fb0ecbec1d4b85889281517bfe141fe29f4eb1 100644
--- a/compiler/utils/UniqDFM.hs
+++ b/compiler/utils/UniqDFM.hs
@@ -42,7 +42,7 @@ module UniqDFM (
         filterUDFM,
         isNullUDFM,
         sizeUDFM,
-        intersectUDFM,
+        intersectUDFM, udfmIntersectUFM,
         intersectsUDFM,
         disjointUDFM, disjointUdfmUfm,
         minusUDFM,
@@ -275,6 +275,11 @@ intersectUDFM (UDFM x i) (UDFM y _j) = UDFM (M.intersection x y) i
   -- M.intersection is left biased, that means the result will only have
   -- a subset of elements from the left set, so `i` is a good upper bound.
 
+udfmIntersectUFM :: UniqDFM elt -> UniqFM elt -> UniqDFM elt
+udfmIntersectUFM (UDFM x i) y = UDFM (M.intersection x (ufmToIntMap y)) i
+  -- M.intersection is left biased, that means the result will only have
+  -- a subset of elements from the left set, so `i` is a good upper bound.
+
 intersectsUDFM :: UniqDFM elt -> UniqDFM elt -> Bool
 intersectsUDFM x y = isNullUDFM (x `intersectUDFM` y)
 
diff --git a/testsuite/driver/extra_files.py b/testsuite/driver/extra_files.py
index d6e639dd28162c91efd74ab14de8974c3b4e354e..0a2bfe6686b87a367c8ba2e01a2bf69ea3a5305f 100644
--- a/testsuite/driver/extra_files.py
+++ b/testsuite/driver/extra_files.py
@@ -189,6 +189,7 @@ extra_src_files = {
   'determ005': ['A.hs'],
   'determ006': ['spec-inline-determ.hs'],
   'determ010': ['A.hs'],
+  'determ018': ['A.hs'],
   'dodgy': ['DodgyA.hs'],
   'driver011': ['A011.hs'],
   'driver012': ['A012.hs'],
diff --git a/testsuite/tests/determinism/determ018/A.hs b/testsuite/tests/determinism/determ018/A.hs
new file mode 100644
index 0000000000000000000000000000000000000000..7017f5719c98eb4c6a767f7cacf6ef73db90de41
--- /dev/null
+++ b/testsuite/tests/determinism/determ018/A.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE
+    Arrows
+  , TypeOperators
+  #-}
+-- This is extracted from arrow-list package
+-- The problem was that some internal tuples that Arrows desugaring
+-- generates the components in different orders depending on the order
+-- of Uniques.
+module A
+(
+ ifA
+)
+where
+
+import Control.Arrow
+import Prelude hiding (id, (.))
+
+class Arrow arr => ArrowList arr where
+  arrL :: (a -> [b]) -> a `arr` b
+  mapL :: ([b] -> [c]) -> (a `arr` b) -> (a `arr` c)
+
+
+empty :: ArrowList arr => (a `arr` b) -> a `arr` Bool
+empty = mapL (\xs -> [if null xs then True else False])
+
+
+ifA :: (ArrowList arr, ArrowChoice arr)
+    => (a `arr` c)  -- ^ Arrow used as condition.
+    -> (a `arr` b)  -- ^ Arrow to use when condition has results.
+    -> (a `arr` b)  -- ^ Arrow to use when condition has no results.
+    -> a `arr` b
+ifA c t e = proc i -> do x <- empty c -< i; if x then e -< i else t -< i
diff --git a/testsuite/tests/determinism/determ018/Makefile b/testsuite/tests/determinism/determ018/Makefile
new file mode 100644
index 0000000000000000000000000000000000000000..227c0903fa35a0751454b05130d511ddf120d194
--- /dev/null
+++ b/testsuite/tests/determinism/determ018/Makefile
@@ -0,0 +1,13 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS))
+
+determ018:
+	$(RM) A.hi A.o
+	'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=0 -dunique-increment=1 -O A.hs
+	$(CP) A.hi A.normal.hi
+	$(RM) A.hi A.o
+	'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=16777215 -dunique-increment=-1 -O A.hs
+	diff A.hi A.normal.hi
diff --git a/testsuite/tests/determinism/determ018/all.T b/testsuite/tests/determinism/determ018/all.T
new file mode 100644
index 0000000000000000000000000000000000000000..96c35feb3a2ce34018c3c7ec88603eef3c353b93
--- /dev/null
+++ b/testsuite/tests/determinism/determ018/all.T
@@ -0,0 +1,4 @@
+test('determ018',
+     extra_clean(['A.o', 'A.hi', 'A.normal.hi']),
+     run_command,
+     ['$MAKE -s --no-print-directory determ018'])
diff --git a/testsuite/tests/determinism/determ018/determ018.stdout b/testsuite/tests/determinism/determ018/determ018.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..60c2bc368d7fd2130884c82ab256c12c64a56950
--- /dev/null
+++ b/testsuite/tests/determinism/determ018/determ018.stdout
@@ -0,0 +1,2 @@
+[1 of 1] Compiling A                ( A.hs, A.o )
+[1 of 1] Compiling A                ( A.hs, A.o )