From: Twan van Laarhoven <twanvl@gmail.com>
Date: Thu, 17 Jan 2008 17:56:16 +0000 (+0000)
Subject: Added MonadUnique class for monads that have a unique supply
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=a594f2fe4a1f7fa6805fb3aa79a1b7617b343a33

Added MonadUnique class for monads that have a unique supply
---

diff --git a/compiler/basicTypes/UniqSupply.lhs b/compiler/basicTypes/UniqSupply.lhs
index d28372a..29d5b17 100644
--- a/compiler/basicTypes/UniqSupply.lhs
+++ b/compiler/basicTypes/UniqSupply.lhs
@@ -23,6 +23,8 @@ module UniqSupply (
 	mapUs, mapAndUnzipUs, mapAndUnzip3Us,
 	thenMaybeUs, mapAccumLUs,
 	lazyThenUs, lazyMapUs,
+	module MonadUtils, mapAndUnzipM,
+	MonadUnique(..),
 
 	mkSplitUniqSupply,
 	splitUniqSupply, listSplitUniqSupply
@@ -154,6 +156,23 @@ withUs f = USM (\us -> f us)	-- Ha ha!
 getUs :: UniqSM UniqSupply
 getUs = USM (\us -> splitUniqSupply us)
 
+-- | A monad for generating unique identifiers
+class Monad m => MonadUnique m where
+    -- | Get a new UniqueSupply
+    getUniqueSupplyM :: m UniqSupply
+    -- | Get a new unique identifier
+    getUniqueM  :: m Unique
+    -- | Get an infinite list of new unique identifiers
+    getUniquesM :: m [Unique]
+    
+    getUniqueM  = liftM uniqFromSupply  getUniqueSupplyM
+    getUniquesM = liftM uniqsFromSupply getUniqueSupplyM
+
+instance MonadUnique UniqSM where
+    getUniqueSupplyM = USM (\us -> splitUniqSupply us)
+    getUniqueM  = getUniqueUs
+    getUniquesM = getUniquesUs
+
 getUniqueUs :: UniqSM Unique
 getUniqueUs = USM (\us -> case splitUniqSupply us of
 			   (us1,us2) -> (uniqFromSupply us1, us2))