[commit: ghc] master: NCGMonad: Add MonadUnique NatM instance (6d5c2e7)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/6d5c2e7b428844a8ff80245579c980c015e6b7e8/ghc

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

commit 6d5c2e7b428844a8ff80245579c980c015e6b7e8
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Tue Nov 29 14:45:04 2016 -0500

    NCGMonad: Add MonadUnique NatM instance
    
    Test Plan: Validate
    
    Reviewers: austin, simonmar
    
    Reviewed By: simonmar
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2737


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

6d5c2e7b428844a8ff80245579c980c015e6b7e8
 compiler/nativeGen/NCGMonad.hs | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/compiler/nativeGen/NCGMonad.hs b/compiler/nativeGen/NCGMonad.hs
index 43547d0..b790d97 100644
--- a/compiler/nativeGen/NCGMonad.hs
+++ b/compiler/nativeGen/NCGMonad.hs
@@ -95,6 +95,14 @@ instance Applicative NatM where
 instance Monad NatM where
   (>>=) = thenNat
 
+instance MonadUnique NatM where
+  getUniqueSupplyM = NatM $ \st ->
+      case splitUniqSupply (natm_us st) of
+          (us1, us2) -> (us1, st {natm_us = us2})
+
+  getUniqueM = NatM $ \st ->
+      case takeUniqFromSupply (natm_us st) of
+          (uniq, us') -> (uniq, st {natm_us = us'})
 
 thenNat :: NatM a -> (a -> NatM b) -> NatM b
 thenNat expr cont