1 files changed, 29 insertions, 0 deletions
diff --git a/utils/CC/IdSupply.hs b/utils/CC/IdSupply.hs
new file mode 100644
index 0000000..234f6cc
--- /dev/null
+++ b/utils/CC/IdSupply.hs
@@ -0,0 +1,29 @@
+module CC.IdSupply(IdSupply, runIdSupply, genId) where
+
+import Control.Monad.Trans
+
+
+data IdSupply a = IdSupply (Int -> (Int, a))
+
+instance Functor IdSupply where
+    fmap f (IdSupply act) = IdSupply (fmap f . act)
+
+instance Applicative IdSupply where
+    pure x = IdSupply (\idval -> (idval, x))
+    IdSupply f <*> IdSupply x =
+        IdSupply (\idval -> let (idval', f') = f idval
+                            in f' <$> x idval')
+
+instance Monad IdSupply where
+    IdSupply x >>= f =
+        IdSupply (\idval -> let (idval', x') = x idval
+                                IdSupply res = f x'
+                            in res idval')
+
+instance MonadTrans
+
+runIdSupply :: Int -> IdSupply a -> a
+runIdSupply startid (IdSupply f) = snd (f startid)
+
+genId :: IdSupply Int
+genId = IdSupply (\idval -> (idval + 1, idval))