[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