{-|
Module      : Htcc.Asm.Intrinsic.Structure.Section.Text.Directive
Description : The modules of intrinsic (x86_64) assembly
Copyright   : (c) roki, 2019
License     : MIT
Maintainer  : falgon53@yahoo.co.jp
Stability   : experimental
Portability : POSIX

The modules of intrinsic (x86_64) assembly
-}
{-# LANGUAGE LambdaCase, OverloadedStrings #-}
module Htcc.Asm.Intrinsic.Structure.Section.Text.Directive (
    -- * Context type
    TextSectionCtx,
    TextLabelCtx,
    TargetLabelCtx,
    -- * Directives
    text,
    global,
    -- * Labels
    fn,
    label,
    begin,
    end,
    eLse,
    cAse,
    break,
    continue,
    gotoLabel,
    ref,
    refBegin,
    refEnd,
    refElse,
    refBreak,
    refHBreak,
    refContinue,
    refHContinue,
    refReturn,
    refGoto,
    -- * Generator
    makeCases
) where

import           Control.Monad                         (forM, unless)
import           Data.IORef                            (IORef, modifyIORef,
                                                        readIORef)
import           Data.Maybe                            (fromJust, isJust)
import qualified Data.Text                             as T
import qualified Data.Text.IO                          as T
import           Prelude                               hiding (break)

import qualified Htcc.Asm.Intrinsic.Structure.Internal as C
import           Htcc.Parser.AST.Core                  (ATKind (..), ATree (..))
import           Htcc.Utils                            (err, tshow)

-- | the type representing the context inside the text section
data TextSectionCtx

-- | the type representing the context inside the label
data TextLabelCtx

-- | the type representing the context inside the instruction that needs to be specified,
-- such as a @jmp@ instruction.
data TargetLabelCtx

-- | @text@ section
text :: C.Asm TextSectionCtx e a -> C.Asm C.AsmCodeCtx e a
text :: Asm TextSectionCtx e a -> Asm AsmCodeCtx e a
text = Text -> Asm TextSectionCtx e a -> Asm AsmCodeCtx e a
forall ctx e a. Text -> Asm ctx e a -> Asm AsmCodeCtx e a
C.section "text"

-- | @global@ directive
global :: T.Text -> C.Asm TextSectionCtx e ()
global :: Text -> Asm TextSectionCtx e ()
global = Text -> Asm TextSectionCtx e ()
forall ctx e. Text -> Asm ctx e ()
C.putStrLnWithIndent (Text -> Asm TextSectionCtx e ())
-> (Text -> Text) -> Text -> Asm TextSectionCtx e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append ".global "

-- | the label as function definition in text section
fn :: T.Text -> C.Asm TextLabelCtx e a -> C.Asm TextSectionCtx e a
fn :: Text -> Asm TextLabelCtx e a -> Asm TextSectionCtx e a
fn fname :: Text
fname asm :: Asm TextLabelCtx e a
asm = Maybe Text -> Asm TextSectionCtx e ()
forall ctx e. Maybe Text -> Asm ctx e ()
C.writeCurFn (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
fname) Asm TextSectionCtx e ()
-> Asm TextSectionCtx e () -> Asm TextSectionCtx e ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
    Text -> Asm TextSectionCtx e ()
forall ctx e. Text -> Asm ctx e ()
C.putStrLnWithIndent (Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":") Asm TextSectionCtx e ()
-> Asm TextSectionCtx e a -> Asm TextSectionCtx e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
    Asm TextLabelCtx e a -> Asm TextSectionCtx e a
forall ctx e a ctx'. Asm ctx e a -> Asm ctx' e a
C.unCtx (Asm TextLabelCtx e a -> Asm TextLabelCtx e a
forall ctx e a. Asm ctx e a -> Asm ctx e a
C.labeled Asm TextLabelCtx e a
asm)

-- | the label in text section
label :: (Show i, Show e) => T.Text -> i -> C.Asm TextLabelCtx e ()
label :: Text -> i -> Asm TextLabelCtx e ()
label lbl :: Text
lbl n :: i
n = (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 -> do
    Maybe Text
cf <- IORef (Maybe Text) -> IO (Maybe Text)
forall a. IORef a -> IO a
readIORef (IORef (Maybe Text) -> IO (Maybe Text))
-> IORef (Maybe Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ AsmInfo e -> IORef (Maybe Text)
forall e. AsmInfo e -> IORef (Maybe Text)
C.curFn AsmInfo e
x
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
cf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
err "stray label"
    Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ ".L." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
cf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> i -> Text
forall a. Show a => a -> Text
tshow i
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":"

-- | goto label
gotoLabel :: T.Text -> C.Asm TextLabelCtx e ()
gotoLabel :: Text -> Asm TextLabelCtx e ()
gotoLabel ident :: Text
ident = (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 -> do
    Maybe Text
cf <- IORef (Maybe Text) -> IO (Maybe Text)
forall a. IORef a -> IO a
readIORef (IORef (Maybe Text) -> IO (Maybe Text))
-> IORef (Maybe Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ AsmInfo e -> IORef (Maybe Text)
forall e. AsmInfo e -> IORef (Maybe Text)
C.curFn AsmInfo e
x
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
cf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
err "stray goto label"
    Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ ".L.label." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
cf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":"

-- | begin label
begin :: (Show e, Show i) => i -> C.Asm TextLabelCtx e ()
begin :: i -> Asm TextLabelCtx e ()
begin = Text -> i -> Asm TextLabelCtx e ()
forall i e. (Show i, Show e) => Text -> i -> Asm TextLabelCtx e ()
label "begin"

-- | end label
end :: (Show e, Show i) => i -> C.Asm TextLabelCtx e ()
end :: i -> Asm TextLabelCtx e ()
end = Text -> i -> Asm TextLabelCtx e ()
forall i e. (Show i, Show e) => Text -> i -> Asm TextLabelCtx e ()
label "end"

-- | else label
eLse :: (Show e, Show i) => i -> C.Asm TextLabelCtx e ()
eLse :: i -> Asm TextLabelCtx e ()
eLse = Text -> i -> Asm TextLabelCtx e ()
forall i e. (Show i, Show e) => Text -> i -> Asm TextLabelCtx e ()
label "else"

-- | case label
cAse :: (Show e, Show i) => i -> C.Asm TextLabelCtx e ()
cAse :: i -> Asm TextLabelCtx e ()
cAse n :: i
n = (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 -> do
    Maybe Text
cf <- IORef (Maybe Text) -> IO (Maybe Text)
forall a. IORef a -> IO a
readIORef (IORef (Maybe Text) -> IO (Maybe Text))
-> IORef (Maybe Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ AsmInfo e -> IORef (Maybe Text)
forall e. AsmInfo e -> IORef (Maybe Text)
C.curFn AsmInfo e
x
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
cf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
err "stray case"
    Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ ".L.case." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
cf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> i -> Text
forall a. Show a => a -> Text
tshow i
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":"

-- | break label
break :: (Show e, Show i) => i -> C.Asm TextLabelCtx e ()
break :: i -> Asm TextLabelCtx e ()
break = Text -> i -> Asm TextLabelCtx e ()
forall i e. (Show i, Show e) => Text -> i -> Asm TextLabelCtx e ()
label "break"

-- | continue label
continue :: (Show e, Show i) => i -> C.Asm TextLabelCtx e ()
continue :: i -> Asm TextLabelCtx e ()
continue = Text -> i -> Asm TextLabelCtx e ()
forall i e. (Show i, Show e) => Text -> i -> Asm TextLabelCtx e ()
label "continue"

-- | reference for return label
refReturn :: Show e => C.Asm TargetLabelCtx e ()
refReturn :: Asm TargetLabelCtx e ()
refReturn = (AsmInfo e -> IO ()) -> Asm TargetLabelCtx e ()
forall ctx e a. (AsmInfo e -> IO a) -> Asm ctx e a
C.Asm ((AsmInfo e -> IO ()) -> Asm TargetLabelCtx e ())
-> (AsmInfo e -> IO ()) -> Asm TargetLabelCtx e ()
forall a b. (a -> b) -> a -> b
$ \x :: AsmInfo e
x -> do
    Maybe Text
cf <- IORef (Maybe Text) -> IO (Maybe Text)
forall a. IORef a -> IO a
readIORef (AsmInfo e -> IORef (Maybe Text)
forall e. AsmInfo e -> IORef (Maybe Text)
C.curFn AsmInfo e
x)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
cf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
err "stray label"
    Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ ".L.return." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
cf

refCnt :: Show e => (C.AsmInfo a -> IORef (Maybe e)) -> T.Text -> C.Asm ctx a ()
refCnt :: (AsmInfo a -> IORef (Maybe e)) -> Text -> Asm ctx a ()
refCnt f :: AsmInfo a -> IORef (Maybe e)
f mes :: Text
mes = (AsmInfo a -> IO ()) -> Asm ctx a ()
forall ctx e a. (AsmInfo e -> IO a) -> Asm ctx e a
C.Asm ((AsmInfo a -> IO ()) -> Asm ctx a ())
-> (AsmInfo a -> IO ()) -> Asm ctx a ()
forall a b. (a -> b) -> a -> b
$ \x :: AsmInfo a
x -> do
    Maybe Text
cf <- IORef (Maybe Text) -> IO (Maybe Text)
forall a. IORef a -> IO a
readIORef (AsmInfo a -> IORef (Maybe Text)
forall e. AsmInfo e -> IORef (Maybe Text)
C.curFn AsmInfo a
x)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
cf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
err (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "stray " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mes
    Maybe e
n <- IORef (Maybe e) -> IO (Maybe e)
forall a. IORef a -> IO a
readIORef (AsmInfo a -> IORef (Maybe e)
f AsmInfo a
x)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe e -> Bool
forall a. Maybe a -> Bool
isJust Maybe e
n) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
err (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "stray " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mes
    Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ ".L." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
cf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> e -> Text
forall a. Show a => a -> Text
tshow (Maybe e -> e
forall a. HasCallStack => Maybe a -> a
fromJust Maybe e
n)

-- | reference for break label
refBreak :: (Show e, Show i) => i -> C.Asm TargetLabelCtx e ()
refBreak :: i -> Asm TargetLabelCtx e ()
refBreak = Text -> i -> Asm TargetLabelCtx e ()
forall e i.
(Show e, Show i) =>
Text -> i -> Asm TargetLabelCtx e ()
ref "break"

-- | reference for break label (applying value by `Htcc.Asm.Intrinsic.Structure.Internal.brkCnt`)
refHBreak :: Show e => C.Asm TargetLabelCtx e ()
refHBreak :: Asm TargetLabelCtx e ()
refHBreak = (AsmInfo e -> IORef (Maybe e)) -> Text -> Asm TargetLabelCtx e ()
forall e a ctx.
Show e =>
(AsmInfo a -> IORef (Maybe e)) -> Text -> Asm ctx a ()
refCnt AsmInfo e -> IORef (Maybe e)
forall e. AsmInfo e -> IORef (Maybe e)
C.brkCnt "break"

-- | reference for continue label
refContinue :: (Show e, Show i) => i -> C.Asm TargetLabelCtx e ()
refContinue :: i -> Asm TargetLabelCtx e ()
refContinue = Text -> i -> Asm TargetLabelCtx e ()
forall e i.
(Show e, Show i) =>
Text -> i -> Asm TargetLabelCtx e ()
ref "continue"

-- | reference for break label (applying value by `Htcc.Asm.Intrinsic.Structure.Internal.cntCnt`)
refHContinue :: Show e => C.Asm TargetLabelCtx e ()
refHContinue :: Asm TargetLabelCtx e ()
refHContinue = (AsmInfo e -> IORef (Maybe e)) -> Text -> Asm TargetLabelCtx e ()
forall e a ctx.
Show e =>
(AsmInfo a -> IORef (Maybe e)) -> Text -> Asm ctx a ()
refCnt AsmInfo e -> IORef (Maybe e)
forall e. AsmInfo e -> IORef (Maybe e)
C.cntCnt "continue"

-- | reference for goto label
refGoto :: T.Text -> C.Asm TargetLabelCtx e ()
refGoto :: Text -> Asm TargetLabelCtx e ()
refGoto ident :: Text
ident = (AsmInfo e -> IO ()) -> Asm TargetLabelCtx e ()
forall ctx e a. (AsmInfo e -> IO a) -> Asm ctx e a
C.Asm ((AsmInfo e -> IO ()) -> Asm TargetLabelCtx e ())
-> (AsmInfo e -> IO ()) -> Asm TargetLabelCtx e ()
forall a b. (a -> b) -> a -> b
$ \x :: AsmInfo e
x -> do
    Maybe Text
cf <- IORef (Maybe Text) -> IO (Maybe Text)
forall a. IORef a -> IO a
readIORef (AsmInfo e -> IORef (Maybe Text)
forall e. AsmInfo e -> IORef (Maybe Text)
C.curFn AsmInfo e
x)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
cf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
err "stray label"
    Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ ".L.label." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
cf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident

-- | reference to begin label
refBegin :: (Show e, Show i) => i -> C.Asm TargetLabelCtx e ()
refBegin :: i -> Asm TargetLabelCtx e ()
refBegin = Text -> i -> Asm TargetLabelCtx e ()
forall e i.
(Show e, Show i) =>
Text -> i -> Asm TargetLabelCtx e ()
ref "begin"

-- | reference to end label
refEnd :: (Show e, Show i) => i -> C.Asm TargetLabelCtx e ()
refEnd :: i -> Asm TargetLabelCtx e ()
refEnd = Text -> i -> Asm TargetLabelCtx e ()
forall e i.
(Show e, Show i) =>
Text -> i -> Asm TargetLabelCtx e ()
ref "end"

-- | reference to else label
refElse :: (Show e, Show i) => i -> C.Asm TargetLabelCtx e ()
refElse :: i -> Asm TargetLabelCtx e ()
refElse = Text -> i -> Asm TargetLabelCtx e ()
forall e i.
(Show e, Show i) =>
Text -> i -> Asm TargetLabelCtx e ()
ref "else"

-- | reference to general label
ref :: (Show e, Show i) => T.Text -> i -> C.Asm TargetLabelCtx e ()
ref :: Text -> i -> Asm TargetLabelCtx e ()
ref lbl :: Text
lbl n :: i
n = (AsmInfo e -> IO ()) -> Asm TargetLabelCtx e ()
forall ctx e a. (AsmInfo e -> IO a) -> Asm ctx e a
C.Asm ((AsmInfo e -> IO ()) -> Asm TargetLabelCtx e ())
-> (AsmInfo e -> IO ()) -> Asm TargetLabelCtx e ()
forall a b. (a -> b) -> a -> b
$ \x :: AsmInfo e
x -> do
    Maybe Text
cf <- IORef (Maybe Text) -> IO (Maybe Text)
forall a. IORef a -> IO a
readIORef (AsmInfo e -> IORef (Maybe Text)
forall e. AsmInfo e -> IORef (Maybe Text)
C.curFn AsmInfo e
x)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
cf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
err "stray label"
    Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ ".L." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
cf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> i -> Text
forall a. Show a => a -> Text
tshow i
n

-- | generate cases and return abstract tree
makeCases :: (Show e, Enum e, Integral e, Show i, Num i) => [ATree i] -> C.Asm TextLabelCtx e [ATree i]
makeCases :: [ATree i] -> Asm TextLabelCtx e [ATree i]
makeCases cases :: [ATree i]
cases = (AsmInfo e -> IO [ATree i]) -> Asm TextLabelCtx e [ATree i]
forall ctx e a. (AsmInfo e -> IO a) -> Asm ctx e a
C.Asm ((AsmInfo e -> IO [ATree i]) -> Asm TextLabelCtx e [ATree i])
-> (AsmInfo e -> IO [ATree i]) -> Asm TextLabelCtx e [ATree i]
forall a b. (a -> b) -> a -> b
$ \x :: AsmInfo e
x -> do
    Maybe Text
cf <- IORef (Maybe Text) -> IO (Maybe Text)
forall a. IORef a -> IO a
readIORef (AsmInfo e -> IORef (Maybe Text)
forall e. AsmInfo e -> IORef (Maybe Text)
C.curFn AsmInfo e
x)
    [ATree i] -> (ATree i -> IO (ATree i)) -> IO [ATree i]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ATree i]
cases ((ATree i -> IO (ATree i)) -> IO [ATree i])
-> (ATree i -> IO (ATree i)) -> IO [ATree i]
forall a b. (a -> b) -> a -> b
$ \case
        (ATNode (ATCase _ cn :: i
cn) t :: StorageClass i
t lhs :: ATree i
lhs rhs :: ATree i
rhs) -> do
            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
            e
n' <- 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)
            Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "\tcmp rax, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> i -> Text
forall a. Show a => a -> Text
tshow i
cn
            Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "\tje .L.case." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
cf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> e -> Text
forall a. Show a => a -> Text
tshow e
n'
            ATree i -> IO (ATree i)
forall (m :: * -> *) a. Monad m => a -> m a
return (ATree i -> IO (ATree i)) -> ATree i -> IO (ATree i)
forall a b. (a -> b) -> a -> b
$ ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode (i -> i -> ATKind i
forall a. a -> a -> ATKind a
ATCase (e -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral e
n') i
cn) StorageClass i
t ATree i
lhs ATree i
rhs
        (ATNode (ATDefault _) t :: StorageClass i
t lhs :: ATree i
lhs rhs :: ATree i
rhs) -> do
            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
            e
n' <- 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)
            Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "\tjmp .L.case." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
cf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> e -> Text
forall a. Show a => a -> Text
tshow e
n'
            ATree i -> IO (ATree i)
forall (m :: * -> *) a. Monad m => a -> m a
return (ATree i -> IO (ATree i)) -> ATree i -> IO (ATree i)
forall a b. (a -> b) -> a -> b
$ ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode (i -> ATKind i
forall a. a -> ATKind a
ATDefault (i -> ATKind i) -> i -> ATKind i
forall a b. (a -> b) -> a -> b
$ e -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral e
n') StorageClass i
t ATree i
lhs ATree i
rhs
        at :: ATree i
at -> ATree i -> IO (ATree i)
forall (m :: * -> *) a. Monad m => a -> m a
return ATree i
at