[commit: ghc] wip/gadtpm: Moved the UniqSupply-specific functions from Check to UniqSupply (4cfc381)

git at git.haskell.org git at git.haskell.org
Sat Nov 28 18:50:30 UTC 2015


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/gadtpm
Link       : http://ghc.haskell.org/trac/ghc/changeset/4cfc381775da75449fa869e417ebd2dc31951392/ghc

>---------------------------------------------------------------

commit 4cfc381775da75449fa869e417ebd2dc31951392
Author: George Karachalias <george.karachalias at gmail.com>
Date:   Sat Nov 28 14:38:42 2015 +0100

    Moved the UniqSupply-specific functions from Check to UniqSupply


>---------------------------------------------------------------

4cfc381775da75449fa869e417ebd2dc31951392
 compiler/basicTypes/UniqSupply.hs | 21 +++++++++++++++++++++
 compiler/deSugar/Check.hs         | 18 ------------------
 2 files changed, 21 insertions(+), 18 deletions(-)

diff --git a/compiler/basicTypes/UniqSupply.hs b/compiler/basicTypes/UniqSupply.hs
index 67a7281..16734bc 100644
--- a/compiler/basicTypes/UniqSupply.hs
+++ b/compiler/basicTypes/UniqSupply.hs
@@ -15,6 +15,7 @@ module UniqSupply (
 
         mkSplitUniqSupply,
         splitUniqSupply, listSplitUniqSupply,
+        splitUniqSupply3, splitUniqSupply4,
 
         -- * Unique supply monad and its abstraction
         UniqSM, MonadUnique(..), liftUs,
@@ -22,6 +23,7 @@ module UniqSupply (
         -- ** Operations on the monad
         initUs, initUs_,
         lazyThenUs, lazyMapUs,
+        getUniqueSupplyM3,
 
         -- * Set supply strategy
         initUniqSupply
@@ -97,6 +99,22 @@ uniqFromSupply  (MkSplitUniqSupply n _ _)  = mkUniqueGrimily n
 uniqsFromSupply (MkSplitUniqSupply n _ s2) = mkUniqueGrimily n : uniqsFromSupply s2
 takeUniqFromSupply (MkSplitUniqSupply n s1 _) = (mkUniqueGrimily n, s1)
 
+-- | Build three 'UniqSupply' from a single one,
+-- each of which can supply its own unique
+splitUniqSupply3 :: UniqSupply -> (UniqSupply, UniqSupply, UniqSupply)
+splitUniqSupply3 us = (us1, us2, us3)
+  where
+    (us1, us') = splitUniqSupply us
+    (us2, us3) = splitUniqSupply us'
+
+-- | Build four 'UniqSupply' from a single one,
+-- each of which can supply its own unique
+splitUniqSupply4 :: UniqSupply -> (UniqSupply, UniqSupply, UniqSupply, UniqSupply)
+splitUniqSupply4 us = (us1, us2, us3, us4)
+  where
+    (us1, us2, us') = splitUniqSupply3 us
+    (us3, us4)      = splitUniqSupply us'
+
 {-
 ************************************************************************
 *                                                                      *
@@ -185,6 +203,9 @@ instance MonadUnique UniqSM where
     getUniqueM  = getUniqueUs
     getUniquesM = getUniquesUs
 
+getUniqueSupplyM3 :: MonadUnique m => m (UniqSupply, UniqSupply, UniqSupply)
+getUniqueSupplyM3 = liftM3 (,,) getUniqueSupplyM getUniqueSupplyM getUniqueSupplyM
+
 liftUs :: MonadUnique m => UniqSM a -> m a
 liftUs m = getUniqueSupplyM >>= return . flip initUs_ m
 
diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 57ce45d..57343ff 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -495,24 +495,6 @@ process_guards us  gs
         (css, uss, dss) = go us4 us gvs
 
 -- ----------------------------------------------------------------------------
--- | Getting some more uniques
-
-splitUniqSupply3 :: UniqSupply -> (UniqSupply, UniqSupply, UniqSupply)
-splitUniqSupply3 us = (us1, us2, us3)
-  where
-    (us1, us') = splitUniqSupply us
-    (us2, us3) = splitUniqSupply us'
-
-splitUniqSupply4 :: UniqSupply -> (UniqSupply, UniqSupply, UniqSupply, UniqSupply)
-splitUniqSupply4 us = (us1, us2, us3, us4)
-  where
-    (us1, us2, us') = splitUniqSupply3 us
-    (us3, us4)      = splitUniqSupply us'
-
-getUniqueSupplyM3 :: MonadUnique m => m (UniqSupply, UniqSupply, UniqSupply)
-getUniqueSupplyM3 = liftM3 (,,) getUniqueSupplyM getUniqueSupplyM getUniqueSupplyM
-
--- ----------------------------------------------------------------------------
 -- | Basic utilities
 
 patternType :: Pattern -> Type



More information about the ghc-commits mailing list