module Htcc.Asm.Intrinsic.Structure.Section.Text.Operations (
incrLbl,
applyCnt,
applyBrk,
bracketBrkCnt
) where
import Data.IORef (modifyIORef,
readIORef,
writeIORef)
import Data.Tuple.Extra ((&&&))
import Control.Monad.Finally (MonadFinally (..))
import qualified Htcc.Asm.Intrinsic.Structure.Internal as C
import Htcc.Asm.Intrinsic.Structure.Section.Text.Directive
import Htcc.Utils (bothM,
(*^*))
incrLbl :: Enum e => C.Asm TextLabelCtx e e
incrLbl :: Asm TextLabelCtx e e
incrLbl = (AsmInfo e -> IO e) -> Asm TextLabelCtx e e
forall ctx e a. (AsmInfo e -> IO a) -> Asm ctx e a
C.Asm ((AsmInfo e -> IO e) -> Asm TextLabelCtx e e)
-> (AsmInfo e -> IO e) -> Asm TextLabelCtx e e
forall a b. (a -> b) -> a -> b
$ \x :: AsmInfo e
x -> IORef e -> (e -> e) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (AsmInfo e -> IORef e
forall e. AsmInfo e -> IORef e
C.lblCnt AsmInfo e
x) e -> e
forall a. Enum a => a -> a
succ IO () -> IO e -> IO e
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IORef e -> IO e
forall a. IORef a -> IO a
readIORef (AsmInfo e -> IORef e
forall e. AsmInfo e -> IORef e
C.lblCnt AsmInfo e
x)
applyCnt :: C.Asm ctx e ()
applyCnt :: Asm ctx e ()
applyCnt = (AsmInfo e -> IO ()) -> Asm ctx e ()
forall ctx e a. (AsmInfo e -> IO a) -> Asm ctx e a
C.Asm ((AsmInfo e -> IO ()) -> Asm ctx e ())
-> (AsmInfo e -> IO ()) -> Asm ctx e ()
forall a b. (a -> b) -> a -> b
$ \x :: AsmInfo e
x -> IORef e -> IO e
forall a. IORef a -> IO a
readIORef (AsmInfo e -> IORef e
forall e. AsmInfo e -> IORef e
C.lblCnt AsmInfo e
x) IO e -> (e -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef (Maybe e) -> Maybe e -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (AsmInfo e -> IORef (Maybe e)
forall e. AsmInfo e -> IORef (Maybe e)
C.cntCnt AsmInfo e
x) (Maybe e -> IO ()) -> (e -> Maybe e) -> e -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Maybe e
forall a. a -> Maybe a
Just
applyBrk :: C.Asm ctx e ()
applyBrk :: Asm ctx e ()
applyBrk = (AsmInfo e -> IO ()) -> Asm ctx e ()
forall ctx e a. (AsmInfo e -> IO a) -> Asm ctx e a
C.Asm ((AsmInfo e -> IO ()) -> Asm ctx e ())
-> (AsmInfo e -> IO ()) -> Asm ctx e ()
forall a b. (a -> b) -> a -> b
$ \x :: AsmInfo e
x -> IORef e -> IO e
forall a. IORef a -> IO a
readIORef (AsmInfo e -> IORef e
forall e. AsmInfo e -> IORef e
C.lblCnt AsmInfo e
x) IO e -> (e -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef (Maybe e) -> Maybe e -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (AsmInfo e -> IORef (Maybe e)
forall e. AsmInfo e -> IORef (Maybe e)
C.brkCnt AsmInfo e
x) (Maybe e -> IO ()) -> (e -> Maybe e) -> e -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Maybe e
forall a. a -> Maybe a
Just
bracketBrkCnt :: C.Asm TextLabelCtx e () -> C.Asm TextLabelCtx e ()
bracketBrkCnt :: Asm TextLabelCtx e () -> Asm TextLabelCtx e ()
bracketBrkCnt mc :: Asm TextLabelCtx e ()
mc = Asm TextLabelCtx e (Maybe e, Maybe e)
-> ((Maybe e, Maybe e) -> Asm TextLabelCtx e ((), ()))
-> ((Maybe e, Maybe e) -> Asm TextLabelCtx e ())
-> Asm TextLabelCtx e ()
forall (μ :: * -> *) r β α.
MonadFinally μ =>
μ r -> (r -> μ β) -> (r -> μ α) -> μ α
bracket
((AsmInfo e -> IO (Maybe e, Maybe e))
-> Asm TextLabelCtx e (Maybe e, Maybe e)
forall ctx e a. (AsmInfo e -> IO a) -> Asm ctx e a
C.Asm ((AsmInfo e -> IO (Maybe e, Maybe e))
-> Asm TextLabelCtx e (Maybe e, Maybe e))
-> (AsmInfo e -> IO (Maybe e, Maybe e))
-> Asm TextLabelCtx e (Maybe e, Maybe e)
forall a b. (a -> b) -> a -> b
$ (IORef (Maybe e) -> IO (Maybe e))
-> (IORef (Maybe e), IORef (Maybe e)) -> IO (Maybe e, Maybe e)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (a, a) -> m (b, b)
bothM IORef (Maybe e) -> IO (Maybe e)
forall a. IORef a -> IO a
readIORef ((IORef (Maybe e), IORef (Maybe e)) -> IO (Maybe e, Maybe e))
-> (AsmInfo e -> (IORef (Maybe e), IORef (Maybe e)))
-> AsmInfo e
-> IO (Maybe e, Maybe e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AsmInfo e -> IORef (Maybe e)
forall e. AsmInfo e -> IORef (Maybe e)
C.brkCnt (AsmInfo e -> IORef (Maybe e))
-> (AsmInfo e -> IORef (Maybe e))
-> AsmInfo e
-> (IORef (Maybe e), IORef (Maybe e))
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& AsmInfo e -> IORef (Maybe e)
forall e. AsmInfo e -> IORef (Maybe e)
C.cntCnt))
(\y :: (Maybe e, Maybe e)
y -> (AsmInfo e -> IO ((), ())) -> Asm TextLabelCtx e ((), ())
forall ctx e a. (AsmInfo e -> IO a) -> Asm ctx e a
C.Asm ((AsmInfo e -> IO ((), ())) -> Asm TextLabelCtx e ((), ()))
-> (AsmInfo e -> IO ((), ())) -> Asm TextLabelCtx e ((), ())
forall a b. (a -> b) -> a -> b
$ \x :: AsmInfo e
x -> (IORef (Maybe e) -> Maybe e -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (AsmInfo e -> IORef (Maybe e)
forall e. AsmInfo e -> IORef (Maybe e)
C.brkCnt AsmInfo e
x) (Maybe e -> IO ())
-> (Maybe e -> IO ()) -> (Maybe e, Maybe e) -> IO ((), ())
forall (m :: * -> *) a c b d.
Monad m =>
(a -> m c) -> (b -> m d) -> (a, b) -> m (c, d)
*^* IORef (Maybe e) -> Maybe e -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (AsmInfo e -> IORef (Maybe e)
forall e. AsmInfo e -> IORef (Maybe e)
C.cntCnt AsmInfo e
x)) (Maybe e, Maybe e)
y) (((Maybe e, Maybe e) -> Asm TextLabelCtx e ())
-> Asm TextLabelCtx e ())
-> ((Maybe e, Maybe e) -> Asm TextLabelCtx e ())
-> Asm TextLabelCtx e ()
forall a b. (a -> b) -> a -> b
$ Asm TextLabelCtx e ()
-> (Maybe e, Maybe e) -> Asm TextLabelCtx e ()
forall a b. a -> b -> a
const Asm TextLabelCtx e ()
mc