diff options
| author | Ben Gamari <bgamari.foss@gmail.com> | 2016-11-29 19:45:04 (GMT) |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2016-11-29 19:45:05 (GMT) |
| commit | 6d5c2e7b428844a8ff80245579c980c015e6b7e8 (patch) | |
| tree | 4fbc7040b9885015528f41f7e24fd72b262370e4 | |
| parent | 775327350c6b16acdf01e49ac174722cc91e4973 (diff) | |
| download | ghc-6d5c2e7b428844a8ff80245579c980c015e6b7e8.zip ghc-6d5c2e7b428844a8ff80245579c980c015e6b7e8.tar.gz ghc-6d5c2e7b428844a8ff80245579c980c015e6b7e8.tar.bz2 | |
NCGMonad: Add MonadUnique NatM instance
Test Plan: Validate
Reviewers: austin, simonmar
Reviewed By: simonmar
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2737
| -rw-r--r-- | compiler/nativeGen/NCGMonad.hs | 8 |
1 files changed, 8 insertions, 0 deletions
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 |