{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}

-- pipeline
module P ( Err (..)
         , CCtx
         , tyParse
         , tyParseCtx
         , tyExpr
         , tyOf
         , tyC
         , getTy
         , parseInline
         , parseRename
         , rwP
         , opt
         , ir
         , cmm
         , eDumpC
         , eDumpIR
         , aarch64
         , as, x86G
         , eDumpX86, eDumpAarch64
         , ex86G, eAarch64
         , bytes
         , funP, aFunP
         , eFunP, eAFunP
         , ctxFunP, actxFunP
         ) where

import           A
import           A.Eta
import           A.Opt
import           Asm.Aarch64
import qualified Asm.Aarch64.Byte           as Aarch64
import qualified Asm.Aarch64.Opt            as Aarch64
import qualified Asm.Aarch64.P              as Aarch64
import           Asm.Aarch64.T
import           Asm.M
import           Asm.X86
import           Asm.X86.Byte
import           Asm.X86.Opt
import qualified Asm.X86.P                  as X86
import           Asm.X86.Trans
import           C
import           C.Alloc
import           C.Trans                    as C
import           CF                         (Liveness)
import           Control.DeepSeq            (NFData)
import           Control.Exception          (Exception, throw, throwIO)
import           Control.Monad              ((<=<))
import           Control.Monad.State.Strict (evalState, state)
import           Data.Bifunctor             (first, second)
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Lazy       as BSL
import qualified Data.Text                  as T
import           Data.Tuple.Extra           (first3)
import           Data.Typeable              (Typeable)
import           Data.Word                  (Word64)
import           Foreign.Ptr                (FunPtr, Ptr)
import           GHC.Generics               (Generic)
import           I
import           IR
import           IR.C
import           IR.Hoist
import           IR.Opt
import           L
import           Nm
import           Parser
import           Parser.Rw
import           Prettyprinter              (Doc, Pretty (..))
import           Prettyprinter.Ext
import           R.Dfn
import           R.R
import           Sys.DL
import           Ty
import           Ty.M

data Err a = PErr ParseE | TyErr (TyE a) | RErr RE deriving ((forall x. Err a -> Rep (Err a) x)
-> (forall x. Rep (Err a) x -> Err a) -> Generic (Err a)
forall x. Rep (Err a) x -> Err a
forall x. Err a -> Rep (Err a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Err a) x -> Err a
forall a x. Err a -> Rep (Err a) x
$cfrom :: forall a x. Err a -> Rep (Err a) x
from :: forall x. Err a -> Rep (Err a) x
$cto :: forall a x. Rep (Err a) x -> Err a
to :: forall x. Rep (Err a) x -> Err a
Generic)

instance Pretty a => Show (Err a) where
    show :: Err a -> String
show = Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> (Err a -> Doc Any) -> Err a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err a -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. Err a -> Doc ann
pretty

instance (Pretty a, Typeable a) => Exception (Err a) where

instance NFData a => NFData (Err a) where

instance Pretty a => Pretty (Err a) where
    pretty :: forall ann. Err a -> Doc ann
pretty (PErr ParseE
err)  = ParseE -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ParseE -> Doc ann
pretty ParseE
err
    pretty (TyErr TyE a
err) = TyE a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TyE a -> Doc ann
pretty TyE a
err
    pretty (RErr RE
err)  = RE -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. RE -> Doc ann
pretty RE
err

rwP :: AlexUserState -> ByteString -> Either ParseE (E AlexPosn, Int)
rwP AlexUserState
st = ((Int, E AlexPosn) -> (E AlexPosn, Int))
-> Either ParseE (Int, E AlexPosn)
-> Either ParseE (E AlexPosn, Int)
forall a b. (a -> b) -> Either ParseE a -> Either ParseE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> E AlexPosn -> (E AlexPosn, Int))
-> (Int, E AlexPosn) -> (E AlexPosn, Int)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> E AlexPosn -> (E AlexPosn, Int)
forall a. Int -> E a -> (E a, Int)
renameECtx((Int, E AlexPosn) -> (E AlexPosn, Int))
-> ((Int, E AlexPosn) -> (Int, E AlexPosn))
-> (Int, E AlexPosn)
-> (E AlexPosn, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(E AlexPosn -> E AlexPosn)
-> (Int, E AlexPosn) -> (Int, E AlexPosn)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second E AlexPosn -> E AlexPosn
forall {a}. E a -> E a
rewrite) (Either ParseE (Int, E AlexPosn)
 -> Either ParseE (E AlexPosn, Int))
-> (ByteString -> Either ParseE (Int, E AlexPosn))
-> ByteString
-> Either ParseE (E AlexPosn, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlexUserState -> ByteString -> Either ParseE (Int, E AlexPosn)
parseWithMaxCtx AlexUserState
st

parseRenameCtx :: AlexUserState -> BSL.ByteString -> Either ParseE (E AlexPosn, Int)
parseRenameCtx :: AlexUserState -> ByteString -> Either ParseE (E AlexPosn, Int)
parseRenameCtx AlexUserState
st = ((Int, E AlexPosn) -> (E AlexPosn, Int))
-> Either ParseE (Int, E AlexPosn)
-> Either ParseE (E AlexPosn, Int)
forall a b. (a -> b) -> Either ParseE a -> Either ParseE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> E AlexPosn -> (E AlexPosn, Int))
-> (Int, E AlexPosn) -> (E AlexPosn, Int)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> E AlexPosn -> (E AlexPosn, Int)
forall a. Int -> E a -> (E a, Int)
renameECtx((Int, E AlexPosn) -> (E AlexPosn, Int))
-> ((Int, E AlexPosn) -> (Int, E AlexPosn))
-> (Int, E AlexPosn)
-> (E AlexPosn, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(E AlexPosn -> E AlexPosn)
-> (Int, E AlexPosn) -> (Int, E AlexPosn)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second E AlexPosn -> E AlexPosn
forall {a}. E a -> E a
rewrite) (Either ParseE (Int, E AlexPosn)
 -> Either ParseE (E AlexPosn, Int))
-> (ByteString -> Either ParseE (Int, E AlexPosn))
-> ByteString
-> Either ParseE (E AlexPosn, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlexUserState -> ByteString -> Either ParseE (Int, E AlexPosn)
parseWithMaxCtx AlexUserState
st

renameECtx :: Int -> E a -> (E a, Int)
renameECtx :: forall a. Int -> E a -> (E a, Int)
renameECtx Int
i E a
ast = let (E a
e, Int
m) = Int -> E a -> (E a, Int)
forall a. Int -> E a -> (E a, Int)
dedfn Int
i E a
ast in Int -> E a -> (E a, Int)
forall a. Int -> E a -> (E a, Int)
rG Int
m E a
e

parseRename :: BSL.ByteString -> Either ParseE (E AlexPosn, Int)
parseRename :: ByteString -> Either ParseE (E AlexPosn, Int)
parseRename = AlexUserState -> ByteString -> Either ParseE (E AlexPosn, Int)
parseRenameCtx AlexUserState
alexInitUserState

tyC :: Int -> E a -> Either (Err a) (E (T ()), [(Nm a, C)], Int)
tyC :: forall a. Int -> E a -> Either (Err a) (E (T ()), [(Nm a, C)], Int)
tyC Int
u = (\(E (T ())
e,[(Nm a, C)]
cs,Int
uϵ) -> (,[(Nm a, C)]
cs,Int
uϵ)(E (T ()) -> (E (T ()), [(Nm a, C)], Int))
-> Either (Err a) (E (T ()))
-> Either (Err a) (E (T ()), [(Nm a, C)], Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>E (T ()) -> Either (Err a) (E (T ()))
forall a. E (T ()) -> Either (Err a) (E (T ()))
checkM E (T ())
e) ((E (T ()), [(Nm a, C)], Int)
 -> Either (Err a) (E (T ()), [(Nm a, C)], Int))
-> (E a -> Either (Err a) (E (T ()), [(Nm a, C)], Int))
-> E a
-> Either (Err a) (E (T ()), [(Nm a, C)], Int)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (TyE a -> Err a)
-> Either (TyE a) (E (T ()), [(Nm a, C)], Int)
-> Either (Err a) (E (T ()), [(Nm a, C)], Int)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TyE a -> Err a
forall a. TyE a -> Err a
TyErr (Either (TyE a) (E (T ()), [(Nm a, C)], Int)
 -> Either (Err a) (E (T ()), [(Nm a, C)], Int))
-> (E a -> Either (TyE a) (E (T ()), [(Nm a, C)], Int))
-> E a
-> Either (Err a) (E (T ()), [(Nm a, C)], Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> E a -> Either (TyE a) (E (T ()), [(Nm a, C)], Int)
forall a. Int -> E a -> Either (TyE a) (E (T ()), [(Nm a, C)], Int)
tyClosed Int
u

tyExpr :: BSL.ByteString -> Either (Err AlexPosn) (Doc ann)
tyExpr :: forall ann. ByteString -> Either (Err AlexPosn) (Doc ann)
tyExpr = ((T (), [(Nm AlexPosn, C)]) -> Doc ann)
-> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)])
-> Either (Err AlexPosn) (Doc ann)
forall a b.
(a -> b) -> Either (Err AlexPosn) a -> Either (Err AlexPosn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (T (), [(Nm AlexPosn, C)]) -> Doc ann
forall a ann. (T (), [(Nm a, C)]) -> Doc ann
prettyC(Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)])
 -> Either (Err AlexPosn) (Doc ann))
-> (ByteString -> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)]))
-> ByteString
-> Either (Err AlexPosn) (Doc ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString -> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)])
tyOf

tyOf :: BSL.ByteString -> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)])
tyOf :: ByteString -> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)])
tyOf = ((E (T ()), [(Nm AlexPosn, C)]) -> (T (), [(Nm AlexPosn, C)]))
-> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)])
-> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)])
forall a b.
(a -> b) -> Either (Err AlexPosn) a -> Either (Err AlexPosn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((E (T ()) -> T ())
-> (E (T ()), [(Nm AlexPosn, C)]) -> (T (), [(Nm AlexPosn, C)])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first E (T ()) -> T ()
forall a. E a -> a
eAnn) (Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)])
 -> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)]))
-> (ByteString
    -> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)]))
-> ByteString
-> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)])
annTy

getTy :: BSL.ByteString -> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)])
getTy :: ByteString -> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)])
getTy = ((E (T ()), [(Nm AlexPosn, C)]) -> (T (), [(Nm AlexPosn, C)]))
-> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)])
-> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)])
forall a b.
(a -> b) -> Either (Err AlexPosn) a -> Either (Err AlexPosn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((E (T ()) -> T ())
-> (E (T ()), [(Nm AlexPosn, C)]) -> (T (), [(Nm AlexPosn, C)])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first E (T ()) -> T ()
forall a. E a -> a
eAnn) (Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)])
 -> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)]))
-> ((E (T ()), [(Nm AlexPosn, C)])
    -> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)]))
-> (E (T ()), [(Nm AlexPosn, C)])
-> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (E (T ()), [(Nm AlexPosn, C)])
-> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)])
forall b a. (E (T ()), b) -> Either (Err a) (E (T ()), b)
checkCtx ((E (T ()), [(Nm AlexPosn, C)])
 -> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)]))
-> (ByteString
    -> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)]))
-> ByteString
-> Either (Err AlexPosn) (T (), [(Nm AlexPosn, C)])
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)])
annTy

annTy :: BSL.ByteString -> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)])
annTy :: ByteString -> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)])
annTy = ((E (T ()), [(Nm AlexPosn, C)], Int)
 -> (E (T ()), [(Nm AlexPosn, C)]))
-> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
-> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)])
forall a b.
(a -> b) -> Either (Err AlexPosn) a -> Either (Err AlexPosn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (E (T ()), [(Nm AlexPosn, C)], Int)
-> (E (T ()), [(Nm AlexPosn, C)])
forall {a} {b} {c}. (a, b, c) -> (a, b)
discard (Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
 -> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)]))
-> (ByteString
    -> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int))
-> ByteString
-> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlexUserState
-> ByteString
-> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
tyConstrCtx AlexUserState
alexInitUserState where discard :: (a, b, c) -> (a, b)
discard (a
x, b
y, c
_) = (a
x, b
y)

eFunP :: (Pretty a, Typeable a) => Int -> CCtx -> E a -> IO (Int, FunPtr b, Maybe (Ptr Word64))
eFunP :: forall a b.
(Pretty a, Typeable a) =>
Int -> CCtx -> E a -> IO (Int, FunPtr b, Maybe (Ptr Word64))
eFunP = (CCtx
 -> (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
 -> IO (ByteString, FunPtr b, Maybe (Ptr Word64)))
-> (Int
    -> E a
    -> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()]))
-> Int
-> CCtx
-> E a
-> IO (Int, FunPtr b, Maybe (Ptr Word64))
forall {a} {t} {b} {b} {c} {t} {a}.
Exception a =>
(t -> b -> IO (ByteString, b, c))
-> (t -> a -> Either a b) -> t -> t -> a -> IO (Int, b, c)
eFunPG CCtx
-> (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
-> IO (ByteString, FunPtr b, Maybe (Ptr Word64))
forall a b.
CCtx
-> (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 a])
-> IO (ByteString, FunPtr b, Maybe (Ptr Word64))
assembleCtx Int
-> E a
-> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
forall a.
Int
-> E a
-> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
ex86G

eAFunP :: (Pretty a, Typeable a) => Int -> (CCtx, MCtx) -> E a -> IO (Int, FunPtr b, Maybe (Ptr Word64))
eAFunP :: forall a b.
(Pretty a, Typeable a) =>
Int
-> (CCtx, MCtx) -> E a -> IO (Int, FunPtr b, Maybe (Ptr Word64))
eAFunP = ((CCtx, MCtx)
 -> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
 -> IO (ByteString, FunPtr b, Maybe (Ptr Word64)))
-> (Int
    -> E a
    -> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> Int
-> (CCtx, MCtx)
-> E a
-> IO (Int, FunPtr b, Maybe (Ptr Word64))
forall {a} {t} {b} {b} {c} {t} {a}.
Exception a =>
(t -> b -> IO (ByteString, b, c))
-> (t -> a -> Either a b) -> t -> t -> a -> IO (Int, b, c)
eFunPG (CCtx, MCtx)
-> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
-> IO (ByteString, FunPtr b, Maybe (Ptr Word64))
forall b.
(CCtx, MCtx)
-> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
-> IO (ByteString, FunPtr b, Maybe (Ptr Word64))
Aarch64.assembleCtx Int
-> E a
-> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall a.
Int
-> E a
-> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
eAarch64

eFunPG :: (t -> b -> IO (ByteString, b, c))
-> (t -> a -> Either a b) -> t -> t -> a -> IO (Int, b, c)
eFunPG t -> b -> IO (ByteString, b, c)
jit t -> a -> Either a b
asm t
m t
ctx = ((ByteString, b, c) -> (Int, b, c))
-> IO (ByteString, b, c) -> IO (Int, b, c)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Int) -> (ByteString, b, c) -> (Int, b, c)
forall a a' b c. (a -> a') -> (a, b, c) -> (a', b, c)
first3 ByteString -> Int
BS.length) (IO (ByteString, b, c) -> IO (Int, b, c))
-> (a -> IO (ByteString, b, c)) -> a -> IO (Int, b, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> b -> IO (ByteString, b, c)
jit t
ctx (b -> IO (ByteString, b, c))
-> (a -> IO b) -> a -> IO (ByteString, b, c)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (a -> IO b) -> (b -> IO b) -> Either a b -> IO b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> IO b
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a b -> IO b) -> (a -> Either a b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> a -> Either a b
asm t
m)

ctxFunP :: CCtx -> BSL.ByteString -> IO (Int, FunPtr a, Maybe (Ptr Word64))
ctxFunP :: forall a.
CCtx -> ByteString -> IO (Int, FunPtr a, Maybe (Ptr Word64))
ctxFunP = (CCtx
 -> (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
 -> IO (ByteString, FunPtr a, Maybe (Ptr Word64)))
-> (ByteString
    -> Either
         (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()]))
-> CCtx
-> ByteString
-> IO (Int, FunPtr a, Maybe (Ptr Word64))
forall {a} {t} {b} {b} {c} {a}.
Exception a =>
(t -> b -> IO (ByteString, b, c))
-> (a -> Either a b) -> t -> a -> IO (Int, b, c)
ctxFunPG CCtx
-> (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
-> IO (ByteString, FunPtr a, Maybe (Ptr Word64))
forall a b.
CCtx
-> (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 a])
-> IO (ByteString, FunPtr b, Maybe (Ptr Word64))
assembleCtx ByteString
-> Either
     (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
x86G

actxFunP :: (CCtx, MCtx) -> BSL.ByteString -> IO (Int, FunPtr a, Maybe (Ptr Word64))
actxFunP :: forall a.
(CCtx, MCtx)
-> ByteString -> IO (Int, FunPtr a, Maybe (Ptr Word64))
actxFunP = ((CCtx, MCtx)
 -> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
 -> IO (ByteString, FunPtr a, Maybe (Ptr Word64)))
-> (ByteString
    -> Either
         (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> (CCtx, MCtx)
-> ByteString
-> IO (Int, FunPtr a, Maybe (Ptr Word64))
forall {a} {t} {b} {b} {c} {a}.
Exception a =>
(t -> b -> IO (ByteString, b, c))
-> (a -> Either a b) -> t -> a -> IO (Int, b, c)
ctxFunPG (CCtx, MCtx)
-> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
-> IO (ByteString, FunPtr a, Maybe (Ptr Word64))
forall b.
(CCtx, MCtx)
-> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
-> IO (ByteString, FunPtr b, Maybe (Ptr Word64))
Aarch64.assembleCtx ByteString
-> Either
     (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
aarch64

ctxFunPG :: (t -> b -> IO (ByteString, b, c))
-> (a -> Either a b) -> t -> a -> IO (Int, b, c)
ctxFunPG t -> b -> IO (ByteString, b, c)
jit a -> Either a b
asm t
ctx = ((ByteString, b, c) -> (Int, b, c))
-> IO (ByteString, b, c) -> IO (Int, b, c)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Int) -> (ByteString, b, c) -> (Int, b, c)
forall a a' b c. (a -> a') -> (a, b, c) -> (a', b, c)
first3 ByteString -> Int
BS.length) (IO (ByteString, b, c) -> IO (Int, b, c))
-> (a -> IO (ByteString, b, c)) -> a -> IO (Int, b, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> b -> IO (ByteString, b, c)
jit t
ctx (b -> IO (ByteString, b, c))
-> (a -> IO b) -> a -> IO (ByteString, b, c)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (a -> IO b) -> (b -> IO b) -> Either a b -> IO b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> IO b
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a b -> IO b) -> (a -> Either a b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
asm)

funP :: BSL.ByteString -> IO (FunPtr a, Maybe (Ptr Word64))
funP :: forall a. ByteString -> IO (FunPtr a, Maybe (Ptr Word64))
funP = (([ByteString], FunPtr a, Maybe (Ptr Word64))
 -> (FunPtr a, Maybe (Ptr Word64)))
-> IO ([ByteString], FunPtr a, Maybe (Ptr Word64))
-> IO (FunPtr a, Maybe (Ptr Word64))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ByteString], FunPtr a, Maybe (Ptr Word64))
-> (FunPtr a, Maybe (Ptr Word64))
forall a b c. (a, b, c) -> (b, c)
π(IO ([ByteString], FunPtr a, Maybe (Ptr Word64))
 -> IO (FunPtr a, Maybe (Ptr Word64)))
-> ((IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
    -> IO ([ByteString], FunPtr a, Maybe (Ptr Word64)))
-> (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
-> IO (FunPtr a, Maybe (Ptr Word64))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
-> IO ([ByteString], FunPtr a, Maybe (Ptr Word64))
forall a b.
(IntMap [Word64], [X86 X86Reg FX86Reg F2X86 a])
-> IO ([ByteString], FunPtr b, Maybe (Ptr Word64))
allFp ((IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
 -> IO (FunPtr a, Maybe (Ptr Word64)))
-> (ByteString
    -> IO (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()]))
-> ByteString
-> IO (FunPtr a, Maybe (Ptr Word64))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Err AlexPosn
 -> IO (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()]))
-> ((IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
    -> IO (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()]))
-> Either
     (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
-> IO (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Err AlexPosn -> IO (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
-> IO (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
 -> IO (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()]))
-> (ByteString
    -> Either
         (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()]))
-> ByteString
-> IO (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Either
     (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
x86G

π :: (a, b, c) -> (b, c)
π :: forall a b c. (a, b, c) -> (b, c)
π (a
_,b
y,c
z) = (b
y,c
z)

aFunP :: BSL.ByteString -> IO (FunPtr a, Maybe (Ptr Word64))
aFunP :: forall a. ByteString -> IO (FunPtr a, Maybe (Ptr Word64))
aFunP = (([ByteString], FunPtr a, Maybe (Ptr Word64))
 -> (FunPtr a, Maybe (Ptr Word64)))
-> IO ([ByteString], FunPtr a, Maybe (Ptr Word64))
-> IO (FunPtr a, Maybe (Ptr Word64))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ByteString], FunPtr a, Maybe (Ptr Word64))
-> (FunPtr a, Maybe (Ptr Word64))
forall a b c. (a, b, c) -> (b, c)
π(IO ([ByteString], FunPtr a, Maybe (Ptr Word64))
 -> IO (FunPtr a, Maybe (Ptr Word64)))
-> ((IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
    -> IO ([ByteString], FunPtr a, Maybe (Ptr Word64)))
-> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
-> IO (FunPtr a, Maybe (Ptr Word64))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
-> IO ([ByteString], FunPtr a, Maybe (Ptr Word64))
forall b.
(IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
-> IO ([ByteString], FunPtr b, Maybe (Ptr Word64))
Aarch64.allFp ((IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
 -> IO (FunPtr a, Maybe (Ptr Word64)))
-> (ByteString
    -> IO (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> ByteString
-> IO (FunPtr a, Maybe (Ptr Word64))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Err AlexPosn
 -> IO (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> ((IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
    -> IO (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> Either
     (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
-> IO (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Err AlexPosn -> IO (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
-> IO (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
 -> IO (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> (ByteString
    -> Either
         (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> ByteString
-> IO (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Either
     (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
aarch64

bytes :: BSL.ByteString -> Either (Err AlexPosn) BS.ByteString
bytes :: ByteString -> Either (Err AlexPosn) ByteString
bytes = ((IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()]) -> ByteString)
-> Either
     (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
-> Either (Err AlexPosn) ByteString
forall a b.
(a -> b) -> Either (Err AlexPosn) a -> Either (Err AlexPosn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()]) -> ByteString
forall a.
(IntMap [Word64], [X86 X86Reg FX86Reg F2X86 a]) -> ByteString
assemble (Either
   (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
 -> Either (Err AlexPosn) ByteString)
-> (ByteString
    -> Either
         (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()]))
-> ByteString
-> Either (Err AlexPosn) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Either
     (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
x86G

as :: T.Text -> BSL.ByteString -> Doc ann
as :: forall ann. Text -> ByteString -> Doc ann
as Text
f = (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]) -> Doc ann
forall {t :: * -> *} {isn} {a}.
(Foldable t, Functor t, Pretty isn) =>
(IntMap (t Word64), [isn]) -> Doc a
prolegomena((IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]) -> Doc ann)
-> (ByteString -> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> ByteString
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Err AlexPosn -> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> ((IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
    -> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> Either
     (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
-> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Err AlexPosn -> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall a e. (HasCallStack, Exception e) => e -> a
throw (([AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()])
-> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
-> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()]
forall {reg} {freg} {f2}.
Eq reg =>
[AArch64 reg freg f2 ()] -> [AArch64 reg freg f2 ()]
aso)(Either
   (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
 -> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> (ByteString
    -> Either
         (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> ByteString
-> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString
-> Either
     (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
aarch64
    where prolegomena :: (IntMap (t Word64), [isn]) -> Doc a
prolegomena (IntMap (t Word64)
d,[isn]
i) = Doc a
".p2align 2\n\n.data\n\n" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> IntMap (t Word64) -> Doc a
forall {t :: * -> *} {ann}.
(Foldable t, Functor t) =>
IntMap (t Word64) -> Doc ann
pAD IntMap (t Word64)
d Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<#> Doc a
".text\n\n.global " Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a ann. Pretty a => a -> Doc ann
pSym Text
f Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<#> Text -> Doc a
forall a ann. Pretty a => a -> Doc ann
pSym Text
f Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
":" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<#> [isn] -> Doc a
forall isn ann. Pretty isn => [isn] -> Doc ann
pAsm [isn]
i

-- TODO: Call internal
aso :: [AArch64 reg freg f2 ()] -> [AArch64 reg freg f2 ()]
aso (MovRCf () reg
r0 CFunc
f:Blr () reg
r1:[AArch64 reg freg f2 ()]
asms) | reg
r0 reg -> reg -> Bool
forall a. Eq a => a -> a -> Bool
== reg
r1 = () -> CFunc -> AArch64 reg freg f2 ()
forall reg freg f2 a. a -> CFunc -> AArch64 reg freg f2 a
Bl () CFunc
fAArch64 reg freg f2 ()
-> [AArch64 reg freg f2 ()] -> [AArch64 reg freg f2 ()]
forall a. a -> [a] -> [a]
:[AArch64 reg freg f2 ()] -> [AArch64 reg freg f2 ()]
aso [AArch64 reg freg f2 ()]
asms
aso (AArch64 reg freg f2 ()
asm:[AArch64 reg freg f2 ()]
asms) = AArch64 reg freg f2 ()
asmAArch64 reg freg f2 ()
-> [AArch64 reg freg f2 ()] -> [AArch64 reg freg f2 ()]
forall a. a -> [a] -> [a]
:[AArch64 reg freg f2 ()] -> [AArch64 reg freg f2 ()]
aso [AArch64 reg freg f2 ()]
asms; aso [] = []

aarch64 :: BSL.ByteString -> Either (Err AlexPosn) (IR.AsmData, [AArch64 AReg FAReg F2Reg ()])
aarch64 :: ByteString
-> Either
     (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
aarch64 = (([Stmt], IntMap [Word64], WSt)
 -> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt)
-> Either
     (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall a b.
(a -> b) -> Either (Err AlexPosn) a -> Either (Err AlexPosn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, [AArch64 AbsReg FAbsReg F2Abs ()])
 -> [AArch64 AReg FAReg F2Reg ()])
-> (IntMap [Word64], (Int, [AArch64 AbsReg FAbsReg F2Abs ()]))
-> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()]
forall reg freg f2reg.
(Eq reg, Eq freg) =>
[AArch64 reg freg f2reg ()] -> [AArch64 reg freg f2reg ()]
Aarch64.opt ([AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()])
-> ((Int, [AArch64 AbsReg FAbsReg F2Abs ()])
    -> [AArch64 AReg FAReg F2Reg ()])
-> (Int, [AArch64 AbsReg FAbsReg F2Abs ()])
-> [AArch64 AReg FAReg F2Reg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()]
forall reg freg f2reg.
(Eq reg, Eq freg) =>
[AArch64 reg freg f2reg ()] -> [AArch64 reg freg f2reg ()]
Aarch64.opt ([AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()])
-> ((Int, [AArch64 AbsReg FAbsReg F2Abs ()])
    -> [AArch64 AReg FAReg F2Reg ()])
-> (Int, [AArch64 AbsReg FAbsReg F2Abs ()])
-> [AArch64 AReg FAReg F2Reg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
 -> [AArch64 AbsReg FAbsReg F2Abs ()]
 -> [AArch64 AReg FAReg F2Reg ()])
-> (Int, [AArch64 AbsReg FAbsReg F2Abs ()])
-> [AArch64 AReg FAReg F2Reg ()]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int
-> [AArch64 AbsReg FAbsReg F2Abs ()]
-> [AArch64 AReg FAReg F2Reg ()]
Aarch64.gallocFrame)((IntMap [Word64], (Int, [AArch64 AbsReg FAbsReg F2Abs ()]))
 -> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> (([Stmt], IntMap [Word64], WSt)
    -> (IntMap [Word64], (Int, [AArch64 AbsReg FAbsReg F2Abs ()])))
-> ([Stmt], IntMap [Word64], WSt)
-> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\([Stmt]
x,IntMap [Word64]
aa,WSt
st) -> (IntMap [Word64]
aa,WSt -> [Stmt] -> (Int, [AArch64 AbsReg FAbsReg F2Abs ()])
irToAarch64 WSt
st [Stmt]
x))) (Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt)
 -> Either
      (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> (ByteString
    -> Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt))
-> ByteString
-> Either
     (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt)
ir

x86G :: BSL.ByteString -> Either (Err AlexPosn) (IR.AsmData, [X86 X86Reg FX86Reg F2X86 ()])
x86G :: ByteString
-> Either
     (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
x86G = ((Int, [X86 AbsReg FAbsReg X2Abs ()])
 -> [X86 X86Reg FX86Reg F2X86 ()])
-> ByteString
-> Either
     (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
forall {reg} {freg} {f2}.
(E reg, E freg, Eq reg, Eq freg) =>
((Int, [X86 AbsReg FAbsReg X2Abs ()]) -> [X86 reg freg f2 ()])
-> ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [X86 reg freg f2 ()])
walloc ((Int
 -> [X86 AbsReg FAbsReg X2Abs ()] -> [X86 X86Reg FX86Reg F2X86 ()])
-> (Int, [X86 AbsReg FAbsReg X2Abs ()])
-> [X86 X86Reg FX86Reg F2X86 ()]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int
-> [X86 AbsReg FAbsReg X2Abs ()] -> [X86 X86Reg FX86Reg F2X86 ()]
X86.gallocFrame)

eAarch64 :: Int -> E a -> Either (Err a) (IR.AsmData, [AArch64 AReg FAReg F2Reg ()])
eAarch64 :: forall a.
Int
-> E a
-> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
eAarch64 Int
i = (([Stmt], IntMap [Word64], WSt)
 -> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> Either (Err a) ([Stmt], IntMap [Word64], WSt)
-> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall a b. (a -> b) -> Either (Err a) a -> Either (Err a) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, [AArch64 AbsReg FAbsReg F2Abs ()])
 -> [AArch64 AReg FAReg F2Reg ()])
-> (IntMap [Word64], (Int, [AArch64 AbsReg FAbsReg F2Abs ()]))
-> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()]
forall reg freg f2reg.
(Eq reg, Eq freg) =>
[AArch64 reg freg f2reg ()] -> [AArch64 reg freg f2reg ()]
Aarch64.opt ([AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()])
-> ((Int, [AArch64 AbsReg FAbsReg F2Abs ()])
    -> [AArch64 AReg FAReg F2Reg ()])
-> (Int, [AArch64 AbsReg FAbsReg F2Abs ()])
-> [AArch64 AReg FAReg F2Reg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()]
forall reg freg f2reg.
(Eq reg, Eq freg) =>
[AArch64 reg freg f2reg ()] -> [AArch64 reg freg f2reg ()]
Aarch64.opt ([AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()])
-> ((Int, [AArch64 AbsReg FAbsReg F2Abs ()])
    -> [AArch64 AReg FAReg F2Reg ()])
-> (Int, [AArch64 AbsReg FAbsReg F2Abs ()])
-> [AArch64 AReg FAReg F2Reg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
 -> [AArch64 AbsReg FAbsReg F2Abs ()]
 -> [AArch64 AReg FAReg F2Reg ()])
-> (Int, [AArch64 AbsReg FAbsReg F2Abs ()])
-> [AArch64 AReg FAReg F2Reg ()]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int
-> [AArch64 AbsReg FAbsReg F2Abs ()]
-> [AArch64 AReg FAReg F2Reg ()]
Aarch64.gallocFrame)((IntMap [Word64], (Int, [AArch64 AbsReg FAbsReg F2Abs ()]))
 -> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> (([Stmt], IntMap [Word64], WSt)
    -> (IntMap [Word64], (Int, [AArch64 AbsReg FAbsReg F2Abs ()])))
-> ([Stmt], IntMap [Word64], WSt)
-> (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\([Stmt]
x,IntMap [Word64]
aa,WSt
st) -> (IntMap [Word64]
aa,WSt -> [Stmt] -> (Int, [AArch64 AbsReg FAbsReg F2Abs ()])
irToAarch64 WSt
st [Stmt]
x))) (Either (Err a) ([Stmt], IntMap [Word64], WSt)
 -> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> (E a -> Either (Err a) ([Stmt], IntMap [Word64], WSt))
-> E a
-> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> E a -> Either (Err a) ([Stmt], IntMap [Word64], WSt)
forall a.
Int -> E a -> Either (Err a) ([Stmt], IntMap [Word64], WSt)
eir Int
i

ex86G :: Int -> E a -> Either (Err a) (IR.AsmData, [X86 X86Reg FX86Reg F2X86 ()])
ex86G :: forall a.
Int
-> E a
-> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
ex86G Int
i = Int
-> ((Int, [X86 AbsReg FAbsReg X2Abs ()])
    -> [X86 X86Reg FX86Reg F2X86 ()])
-> E a
-> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
forall {reg} {freg} {f2} {a}.
(E reg, E freg, Eq reg, Eq freg) =>
Int
-> ((Int, [X86 AbsReg FAbsReg X2Abs ()]) -> [X86 reg freg f2 ()])
-> E a
-> Either (Err a) (IntMap [Word64], [X86 reg freg f2 ()])
wallocE Int
i ((Int
 -> [X86 AbsReg FAbsReg X2Abs ()] -> [X86 X86Reg FX86Reg F2X86 ()])
-> (Int, [X86 AbsReg FAbsReg X2Abs ()])
-> [X86 X86Reg FX86Reg F2X86 ()]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int
-> [X86 AbsReg FAbsReg X2Abs ()] -> [X86 X86Reg FX86Reg F2X86 ()]
X86.gallocFrame)

eDumpX86 :: Int -> E a -> Either (Err a) (Doc ann)
eDumpX86 :: forall a ann. Int -> E a -> Either (Err a) (Doc ann)
eDumpX86 Int
i = ((IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()]) -> Doc ann)
-> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
-> Either (Err a) (Doc ann)
forall a b. (a -> b) -> Either (Err a) a -> Either (Err a) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()]) -> Doc ann
forall isn ann. Pretty isn => (IntMap [Word64], [isn]) -> Doc ann
prettyAsm (Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
 -> Either (Err a) (Doc ann))
-> (E a
    -> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()]))
-> E a
-> Either (Err a) (Doc ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> E a
-> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
forall a.
Int
-> E a
-> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg F2X86 ()])
ex86G Int
i

eDumpAarch64 :: Int -> E a -> Either (Err a) (Doc ann)
eDumpAarch64 :: forall a ann. Int -> E a -> Either (Err a) (Doc ann)
eDumpAarch64 Int
i = ((IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]) -> Doc ann)
-> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
-> Either (Err a) (Doc ann)
forall a b. (a -> b) -> Either (Err a) a -> Either (Err a) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]) -> Doc ann
forall isn ann. Pretty isn => (IntMap [Word64], [isn]) -> Doc ann
prettyAsm (Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
 -> Either (Err a) (Doc ann))
-> (E a
    -> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()]))
-> E a
-> Either (Err a) (Doc ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> E a
-> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
forall a.
Int
-> E a
-> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg F2Reg ()])
eAarch64 Int
i

walloc :: ((Int, [X86 AbsReg FAbsReg X2Abs ()]) -> [X86 reg freg f2 ()])
-> ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [X86 reg freg f2 ()])
walloc (Int, [X86 AbsReg FAbsReg X2Abs ()]) -> [X86 reg freg f2 ()]
f = (([Stmt], IntMap [Word64], WSt)
 -> (IntMap [Word64], [X86 reg freg f2 ()]))
-> Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt)
-> Either (Err AlexPosn) (IntMap [Word64], [X86 reg freg f2 ()])
forall a b.
(a -> b) -> Either (Err AlexPosn) a -> Either (Err AlexPosn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, [X86 AbsReg FAbsReg X2Abs ()]) -> [X86 reg freg f2 ()])
-> (IntMap [Word64], (Int, [X86 AbsReg FAbsReg X2Abs ()]))
-> (IntMap [Word64], [X86 reg freg f2 ()])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([X86 reg freg f2 ()] -> [X86 reg freg f2 ()]
forall reg freg f2.
(E reg, E freg, Eq reg, Eq freg) =>
[X86 reg freg f2 ()] -> [X86 reg freg f2 ()]
optX86([X86 reg freg f2 ()] -> [X86 reg freg f2 ()])
-> ((Int, [X86 AbsReg FAbsReg X2Abs ()]) -> [X86 reg freg f2 ()])
-> (Int, [X86 AbsReg FAbsReg X2Abs ()])
-> [X86 reg freg f2 ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[X86 reg freg f2 ()] -> [X86 reg freg f2 ()]
forall reg freg f2.
(E reg, E freg, Eq reg, Eq freg) =>
[X86 reg freg f2 ()] -> [X86 reg freg f2 ()]
optX86([X86 reg freg f2 ()] -> [X86 reg freg f2 ()])
-> ((Int, [X86 AbsReg FAbsReg X2Abs ()]) -> [X86 reg freg f2 ()])
-> (Int, [X86 AbsReg FAbsReg X2Abs ()])
-> [X86 reg freg f2 ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int, [X86 AbsReg FAbsReg X2Abs ()]) -> [X86 reg freg f2 ()]
f) ((IntMap [Word64], (Int, [X86 AbsReg FAbsReg X2Abs ()]))
 -> (IntMap [Word64], [X86 reg freg f2 ()]))
-> (([Stmt], IntMap [Word64], WSt)
    -> (IntMap [Word64], (Int, [X86 AbsReg FAbsReg X2Abs ()])))
-> ([Stmt], IntMap [Word64], WSt)
-> (IntMap [Word64], [X86 reg freg f2 ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\([Stmt]
x,IntMap [Word64]
aa,WSt
st) -> (IntMap [Word64]
aa,WSt -> [Stmt] -> (Int, [X86 AbsReg FAbsReg X2Abs ()])
irToX86 WSt
st [Stmt]
x))) (Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt)
 -> Either (Err AlexPosn) (IntMap [Word64], [X86 reg freg f2 ()]))
-> (ByteString
    -> Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt))
-> ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [X86 reg freg f2 ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt)
ir
wallocE :: Int
-> ((Int, [X86 AbsReg FAbsReg X2Abs ()]) -> [X86 reg freg f2 ()])
-> E a
-> Either (Err a) (IntMap [Word64], [X86 reg freg f2 ()])
wallocE Int
i (Int, [X86 AbsReg FAbsReg X2Abs ()]) -> [X86 reg freg f2 ()]
f = (([Stmt], IntMap [Word64], WSt)
 -> (IntMap [Word64], [X86 reg freg f2 ()]))
-> Either (Err a) ([Stmt], IntMap [Word64], WSt)
-> Either (Err a) (IntMap [Word64], [X86 reg freg f2 ()])
forall a b. (a -> b) -> Either (Err a) a -> Either (Err a) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, [X86 AbsReg FAbsReg X2Abs ()]) -> [X86 reg freg f2 ()])
-> (IntMap [Word64], (Int, [X86 AbsReg FAbsReg X2Abs ()]))
-> (IntMap [Word64], [X86 reg freg f2 ()])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([X86 reg freg f2 ()] -> [X86 reg freg f2 ()]
forall reg freg f2.
(E reg, E freg, Eq reg, Eq freg) =>
[X86 reg freg f2 ()] -> [X86 reg freg f2 ()]
optX86([X86 reg freg f2 ()] -> [X86 reg freg f2 ()])
-> ((Int, [X86 AbsReg FAbsReg X2Abs ()]) -> [X86 reg freg f2 ()])
-> (Int, [X86 AbsReg FAbsReg X2Abs ()])
-> [X86 reg freg f2 ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[X86 reg freg f2 ()] -> [X86 reg freg f2 ()]
forall reg freg f2.
(E reg, E freg, Eq reg, Eq freg) =>
[X86 reg freg f2 ()] -> [X86 reg freg f2 ()]
optX86([X86 reg freg f2 ()] -> [X86 reg freg f2 ()])
-> ((Int, [X86 AbsReg FAbsReg X2Abs ()]) -> [X86 reg freg f2 ()])
-> (Int, [X86 AbsReg FAbsReg X2Abs ()])
-> [X86 reg freg f2 ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int, [X86 AbsReg FAbsReg X2Abs ()]) -> [X86 reg freg f2 ()]
f) ((IntMap [Word64], (Int, [X86 AbsReg FAbsReg X2Abs ()]))
 -> (IntMap [Word64], [X86 reg freg f2 ()]))
-> (([Stmt], IntMap [Word64], WSt)
    -> (IntMap [Word64], (Int, [X86 AbsReg FAbsReg X2Abs ()])))
-> ([Stmt], IntMap [Word64], WSt)
-> (IntMap [Word64], [X86 reg freg f2 ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\([Stmt]
x,IntMap [Word64]
aa,WSt
st) -> (IntMap [Word64]
aa,WSt -> [Stmt] -> (Int, [X86 AbsReg FAbsReg X2Abs ()])
irToX86 WSt
st [Stmt]
x))) (Either (Err a) ([Stmt], IntMap [Word64], WSt)
 -> Either (Err a) (IntMap [Word64], [X86 reg freg f2 ()]))
-> (E a -> Either (Err a) ([Stmt], IntMap [Word64], WSt))
-> E a
-> Either (Err a) (IntMap [Word64], [X86 reg freg f2 ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> E a -> Either (Err a) ([Stmt], IntMap [Word64], WSt)
forall a.
Int -> E a -> Either (Err a) ([Stmt], IntMap [Word64], WSt)
eir Int
i

cmm :: BSL.ByteString -> Either (Err AlexPosn) ([CS Liveness], C.AsmData)
cmm :: ByteString
-> Either (Err AlexPosn) ([CS Liveness], IntMap [Word64])
cmm = (E (T ()) -> ([CS Liveness], IntMap [Word64]))
-> Either (Err AlexPosn) (E (T ()))
-> Either (Err AlexPosn) ([CS Liveness], IntMap [Word64])
forall a b.
(a -> b) -> Either (Err AlexPosn) a -> Either (Err AlexPosn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([CS ()], LSt, IntMap [Word64], IntMap Temp)
-> ([CS Liveness], IntMap [Word64])
forall {b} {b}. ([CS ()], b, b, IntMap Temp) -> ([CS Liveness], b)
f(([CS ()], LSt, IntMap [Word64], IntMap Temp)
 -> ([CS Liveness], IntMap [Word64]))
-> (E (T ()) -> ([CS ()], LSt, IntMap [Word64], IntMap Temp))
-> E (T ())
-> ([CS Liveness], IntMap [Word64])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.E (T ()) -> ([CS ()], LSt, IntMap [Word64], IntMap Temp)
C.writeC)(Either (Err AlexPosn) (E (T ()))
 -> Either (Err AlexPosn) ([CS Liveness], IntMap [Word64]))
-> (ByteString -> Either (Err AlexPosn) (E (T ())))
-> ByteString
-> Either (Err AlexPosn) ([CS Liveness], IntMap [Word64])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString -> Either (Err AlexPosn) (E (T ()))
opt where f :: ([CS ()], b, b, IntMap Temp) -> ([CS Liveness], b)
f ([CS ()]
cs,b
_,b
aa,IntMap Temp
t)=(IntMap Temp -> [CS ()] -> [CS Liveness]
frees IntMap Temp
t [CS ()]
cs,b
aa)

ec :: Int -> E a -> Either (Err a) ([CS Liveness], LSt, C.AsmData)
ec :: forall a.
Int -> E a -> Either (Err a) ([CS Liveness], LSt, IntMap [Word64])
ec Int
i = (E (T ()) -> ([CS Liveness], LSt, IntMap [Word64]))
-> Either (Err a) (E (T ()))
-> Either (Err a) ([CS Liveness], LSt, IntMap [Word64])
forall a b. (a -> b) -> Either (Err a) a -> Either (Err a) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((\([CS ()]
cs,LSt
u,IntMap [Word64]
aa,IntMap Temp
t) -> (IntMap Temp -> [CS ()] -> [CS Liveness]
frees IntMap Temp
t [CS ()]
cs,LSt
u,IntMap [Word64]
aa)) (([CS ()], LSt, IntMap [Word64], IntMap Temp)
 -> ([CS Liveness], LSt, IntMap [Word64]))
-> (E (T ()) -> ([CS ()], LSt, IntMap [Word64], IntMap Temp))
-> E (T ())
-> ([CS Liveness], LSt, IntMap [Word64])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E (T ()) -> ([CS ()], LSt, IntMap [Word64], IntMap Temp)
C.writeC) (Either (Err a) (E (T ()))
 -> Either (Err a) ([CS Liveness], LSt, IntMap [Word64]))
-> (E a -> Either (Err a) (E (T ())))
-> E a
-> Either (Err a) ([CS Liveness], LSt, IntMap [Word64])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> E a -> Either (Err a) (E (T ()))
forall a. Int -> E a -> Either (Err a) (E (T ()))
optE Int
i

ir :: BSL.ByteString -> Either (Err AlexPosn) ([Stmt], IR.AsmData, WSt)
ir :: ByteString -> Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt)
ir = (E (T ()) -> ([Stmt], IntMap [Word64], WSt))
-> Either (Err AlexPosn) (E (T ()))
-> Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt)
forall a b.
(a -> b) -> Either (Err AlexPosn) a -> Either (Err AlexPosn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([CS ()], LSt, IntMap [Word64], IntMap Temp)
-> ([Stmt], IntMap [Word64], WSt)
forall {b}. ([CS ()], LSt, b, IntMap Temp) -> ([Stmt], b, WSt)
f(([CS ()], LSt, IntMap [Word64], IntMap Temp)
 -> ([Stmt], IntMap [Word64], WSt))
-> (E (T ()) -> ([CS ()], LSt, IntMap [Word64], IntMap Temp))
-> E (T ())
-> ([Stmt], IntMap [Word64], WSt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.E (T ()) -> ([CS ()], LSt, IntMap [Word64], IntMap Temp)
C.writeC)(Either (Err AlexPosn) (E (T ()))
 -> Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt))
-> (ByteString -> Either (Err AlexPosn) (E (T ())))
-> ByteString
-> Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString -> Either (Err AlexPosn) (E (T ()))
opt where f :: ([CS ()], LSt, b, IntMap Temp) -> ([Stmt], b, WSt)
f ([CS ()]
cs,LSt
u,b
aa,IntMap Temp
t) = let ([Stmt]
s,WSt
u')=LSt -> [CS Liveness] -> ([Stmt], WSt)
forall a. LSt -> [CS a] -> ([Stmt], WSt)
cToIR LSt
u (IntMap Temp -> [CS ()] -> [CS Liveness]
frees IntMap Temp
t [CS ()]
cs) in ([Stmt] -> [Stmt]
pall ([Stmt] -> [Stmt]
optIR [Stmt]
s),b
aa,WSt
u')

eir :: Int -> E a -> Either (Err a) ([Stmt], IR.AsmData, WSt)
eir :: forall a.
Int -> E a -> Either (Err a) ([Stmt], IntMap [Word64], WSt)
eir Int
i = (E (T ()) -> ([Stmt], IntMap [Word64], WSt))
-> Either (Err a) (E (T ()))
-> Either (Err a) ([Stmt], IntMap [Word64], WSt)
forall a b. (a -> b) -> Either (Err a) a -> Either (Err a) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([CS ()], LSt, IntMap [Word64], IntMap Temp)
-> ([Stmt], IntMap [Word64], WSt)
forall {b}. ([CS ()], LSt, b, IntMap Temp) -> ([Stmt], b, WSt)
f(([CS ()], LSt, IntMap [Word64], IntMap Temp)
 -> ([Stmt], IntMap [Word64], WSt))
-> (E (T ()) -> ([CS ()], LSt, IntMap [Word64], IntMap Temp))
-> E (T ())
-> ([Stmt], IntMap [Word64], WSt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.E (T ()) -> ([CS ()], LSt, IntMap [Word64], IntMap Temp)
C.writeC)(Either (Err a) (E (T ()))
 -> Either (Err a) ([Stmt], IntMap [Word64], WSt))
-> (E a -> Either (Err a) (E (T ())))
-> E a
-> Either (Err a) ([Stmt], IntMap [Word64], WSt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> E a -> Either (Err a) (E (T ()))
forall a. Int -> E a -> Either (Err a) (E (T ()))
optE Int
i where f :: ([CS ()], LSt, b, IntMap Temp) -> ([Stmt], b, WSt)
f ([CS ()]
cs,LSt
u,b
aa,IntMap Temp
t) = let ([Stmt]
s,WSt
u')=LSt -> [CS Liveness] -> ([Stmt], WSt)
forall a. LSt -> [CS a] -> ([Stmt], WSt)
cToIR LSt
u (IntMap Temp -> [CS ()] -> [CS Liveness]
frees IntMap Temp
t [CS ()]
cs) in ([Stmt] -> [Stmt]
pall ([Stmt] -> [Stmt]
optIR [Stmt]
s),b
aa,WSt
u')

eDumpC :: Int -> E a -> Either (Err a) (Doc ann)
eDumpC :: forall a ann. Int -> E a -> Either (Err a) (Doc ann)
eDumpC Int
i = (([CS Liveness], LSt, IntMap [Word64]) -> Doc ann)
-> Either (Err a) ([CS Liveness], LSt, IntMap [Word64])
-> Either (Err a) (Doc ann)
forall a b. (a -> b) -> Either (Err a) a -> Either (Err a) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IntMap [Word64], [CS Liveness]) -> Doc ann
forall a ann. (IntMap [Word64], [CS a]) -> Doc ann
prettyCS((IntMap [Word64], [CS Liveness]) -> Doc ann)
-> (([CS Liveness], LSt, IntMap [Word64])
    -> (IntMap [Word64], [CS Liveness]))
-> ([CS Liveness], LSt, IntMap [Word64])
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([CS Liveness], LSt, IntMap [Word64])
-> (IntMap [Word64], [CS Liveness])
forall {b} {b} {a}. (b, b, a) -> (a, b)
𝜋)(Either (Err a) ([CS Liveness], LSt, IntMap [Word64])
 -> Either (Err a) (Doc ann))
-> (E a -> Either (Err a) ([CS Liveness], LSt, IntMap [Word64]))
-> E a
-> Either (Err a) (Doc ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> E a -> Either (Err a) ([CS Liveness], LSt, IntMap [Word64])
forall a.
Int -> E a -> Either (Err a) ([CS Liveness], LSt, IntMap [Word64])
ec Int
i where 𝜋 :: (b, b, a) -> (a, b)
𝜋 (b
a,b
_,a
c)=(a
c,b
a)

eDumpIR :: Int -> E a -> Either (Err a) (Doc ann)
eDumpIR :: forall a ann. Int -> E a -> Either (Err a) (Doc ann)
eDumpIR Int
i = (([Stmt], IntMap [Word64], WSt) -> Doc ann)
-> Either (Err a) ([Stmt], IntMap [Word64], WSt)
-> Either (Err a) (Doc ann)
forall a b. (a -> b) -> Either (Err a) a -> Either (Err a) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IntMap [Word64], [Stmt]) -> Doc ann
forall ann. (IntMap [Word64], [Stmt]) -> Doc ann
prettyIR((IntMap [Word64], [Stmt]) -> Doc ann)
-> (([Stmt], IntMap [Word64], WSt) -> (IntMap [Word64], [Stmt]))
-> ([Stmt], IntMap [Word64], WSt)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Stmt], IntMap [Word64], WSt) -> (IntMap [Word64], [Stmt])
forall {b} {a} {c}. (b, a, c) -> (a, b)
𝜋) (Either (Err a) ([Stmt], IntMap [Word64], WSt)
 -> Either (Err a) (Doc ann))
-> (E a -> Either (Err a) ([Stmt], IntMap [Word64], WSt))
-> E a
-> Either (Err a) (Doc ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> E a -> Either (Err a) ([Stmt], IntMap [Word64], WSt)
forall a.
Int -> E a -> Either (Err a) ([Stmt], IntMap [Word64], WSt)
eir Int
i where 𝜋 :: (b, a, c) -> (a, b)
𝜋 (b
a,a
b,c
_)=(a
b,b
a)

optE :: Int -> E a -> Either (Err a) (E (T ()))
optE :: forall a. Int -> E a -> Either (Err a) (E (T ()))
optE Int
i E a
e =
  (E (T ()) -> Int -> E (T ())) -> (E (T ()), Int) -> E (T ())
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry E (T ()) -> Int -> E (T ())
go ((E (T ()), Int) -> E (T ()))
-> Either (Err a) (E (T ()), Int) -> Either (Err a) (E (T ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> E a -> Either (Err a) (E (T ()), Int)
forall a. Int -> E a -> Either (Err a) (E (T ()), Int)
eInline Int
i E a
e where
  go :: E (T ()) -> Int -> E (T ())
go E (T ())
eϵ = State Int (E (T ())) -> Int -> E (T ())
forall s a. State s a -> s -> a
evalState (E (T ()) -> State Int (E (T ()))
forall {m :: * -> *}. MonadState Int m => E (T ()) -> m (E (T ()))
β'(E (T ()) -> State Int (E (T ())))
-> State Int (E (T ())) -> State Int (E (T ()))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<E (T ()) -> State Int (E (T ()))
forall {m :: * -> *}. MonadState Int m => E (T ()) -> m (E (T ()))
optA'(E (T ()) -> State Int (E (T ())))
-> State Int (E (T ())) -> State Int (E (T ()))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<E (T ()) -> State Int (E (T ()))
forall {m :: * -> *}. MonadState Int m => E (T ()) -> m (E (T ()))
β'(E (T ()) -> State Int (E (T ())))
-> State Int (E (T ())) -> State Int (E (T ()))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<E (T ()) -> State Int (E (T ()))
η(E (T ()) -> State Int (E (T ())))
-> State Int (E (T ())) -> State Int (E (T ()))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<E (T ()) -> State Int (E (T ()))
forall {m :: * -> *}. MonadState Int m => E (T ()) -> m (E (T ()))
optA' E (T ())
eϵ)
  β' :: E (T ()) -> m (E (T ()))
β' E (T ())
eϵ = (Int -> (E (T ()), Int)) -> m (E (T ()))
forall a. (Int -> (a, Int)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (Int -> E (T ()) -> (E (T ()), Int)
`β` E (T ())
eϵ)
  optA' :: E (T ()) -> m (E (T ()))
optA' E (T ())
eϵ = (Int -> (E (T ()), Int)) -> m (E (T ()))
forall a. (Int -> (a, Int)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\Int
k -> Int -> RM (E (T ())) -> (E (T ()), Int)
forall a. Int -> RM a -> (a, Int)
runM Int
k (E (T ()) -> RM (E (T ()))
optA E (T ())
eϵ))

opt :: BSL.ByteString -> Either (Err AlexPosn) (E (T ()))
opt :: ByteString -> Either (Err AlexPosn) (E (T ()))
opt ByteString
bsl =
    (E (T ()) -> Int -> E (T ())) -> (E (T ()), Int) -> E (T ())
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry E (T ()) -> Int -> E (T ())
go ((E (T ()), Int) -> E (T ()))
-> Either (Err AlexPosn) (E (T ()), Int)
-> Either (Err AlexPosn) (E (T ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either (Err AlexPosn) (E (T ()), Int)
parseInline ByteString
bsl where
    go :: E (T ()) -> Int -> E (T ())
go E (T ())
e = State Int (E (T ())) -> Int -> E (T ())
forall s a. State s a -> s -> a
evalState (E (T ()) -> State Int (E (T ()))
forall {m :: * -> *}. MonadState Int m => E (T ()) -> m (E (T ()))
β'(E (T ()) -> State Int (E (T ())))
-> State Int (E (T ())) -> State Int (E (T ()))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<E (T ()) -> State Int (E (T ()))
forall {m :: * -> *}. MonadState Int m => E (T ()) -> m (E (T ()))
optA'(E (T ()) -> State Int (E (T ())))
-> State Int (E (T ())) -> State Int (E (T ()))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<E (T ()) -> State Int (E (T ()))
forall {m :: * -> *}. MonadState Int m => E (T ()) -> m (E (T ()))
β'(E (T ()) -> State Int (E (T ())))
-> State Int (E (T ())) -> State Int (E (T ()))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<E (T ()) -> State Int (E (T ()))
η(E (T ()) -> State Int (E (T ())))
-> State Int (E (T ())) -> State Int (E (T ()))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<E (T ()) -> State Int (E (T ()))
forall {m :: * -> *}. MonadState Int m => E (T ()) -> m (E (T ()))
optA' E (T ())
e)
    β' :: E (T ()) -> m (E (T ()))
β' E (T ())
e = (Int -> (E (T ()), Int)) -> m (E (T ()))
forall a. (Int -> (a, Int)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (Int -> E (T ()) -> (E (T ()), Int)
`β` E (T ())
e)
    optA' :: E (T ()) -> m (E (T ()))
optA' E (T ())
e = (Int -> (E (T ()), Int)) -> m (E (T ()))
forall a. (Int -> (a, Int)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\Int
k -> Int -> RM (E (T ())) -> (E (T ()), Int)
forall a. Int -> RM a -> (a, Int)
runM Int
k (E (T ()) -> RM (E (T ()))
optA E (T ())
e))

eInline :: Int -> E a -> Either (Err a) (E (T ()), Int)
eInline :: forall a. Int -> E a -> Either (Err a) (E (T ()), Int)
eInline Int
m E a
e = (\(E (T ())
eϵ, Int
i) -> Int -> E (T ()) -> (E (T ()), Int)
inline Int
i E (T ())
eϵ) ((E (T ()), Int) -> (E (T ()), Int))
-> Either (Err a) (E (T ()), Int) -> Either (Err a) (E (T ()), Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((E (T ()), Int) -> Either (Err a) (E (T ()), Int)
forall b a. (E (T ()), b) -> Either (Err a) (E (T ()), b)
checkCtx ((E (T ()), Int) -> Either (Err a) (E (T ()), Int))
-> Either (Err a) (E (T ()), Int) -> Either (Err a) (E (T ()), Int)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either (TyE a) (E (T ()), Int) -> Either (Err a) (E (T ()), Int)
forall {a} {c}. Either (TyE a) c -> Either (Err a) c
liftErr (((E (T ()), [(Nm a, C)], Int) -> (E (T ()), Int))
-> Either (TyE a) (E (T ()), [(Nm a, C)], Int)
-> Either (TyE a) (E (T ()), Int)
forall a b. (a -> b) -> Either (TyE a) a -> Either (TyE a) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (E (T ()), [(Nm a, C)], Int) -> (E (T ()), Int)
forall {a} {b} {b}. (a, b, b) -> (a, b)
sel (Int -> E a -> Either (TyE a) (E (T ()), [(Nm a, C)], Int)
forall a. Int -> E a -> Either (TyE a) (E (T ()), [(Nm a, C)], Int)
tyClosed Int
m E a
e))) where sel :: (a, b, b) -> (a, b)
sel ~(a
x, b
_, b
z) = (a
x, b
z); liftErr :: Either (TyE a) c -> Either (Err a) c
liftErr = (TyE a -> Err a) -> Either (TyE a) c -> Either (Err a) c
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TyE a -> Err a
forall a. TyE a -> Err a
TyErr

checkM :: E (T ()) -> Either (Err a) (E (T ()))
checkM :: forall a. E (T ()) -> Either (Err a) (E (T ()))
checkM E (T ())
e = Either (Err a) (E (T ()))
-> (RE -> Either (Err a) (E (T ())))
-> Maybe RE
-> Either (Err a) (E (T ()))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (E (T ()) -> Either (Err a) (E (T ()))
forall a b. b -> Either a b
Right E (T ())
e) (Err a -> Either (Err a) (E (T ()))
forall a b. a -> Either a b
Left (Err a -> Either (Err a) (E (T ())))
-> (RE -> Err a) -> RE -> Either (Err a) (E (T ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE -> Err a
forall a. RE -> Err a
RErr) (Maybe RE -> Either (Err a) (E (T ())))
-> Maybe RE -> Either (Err a) (E (T ()))
forall a b. (a -> b) -> a -> b
$ E (T ()) -> Maybe RE
check E (T ())
e

checkCtx :: (E (T ()), b) -> Either (Err a) (E (T ()), b)
checkCtx :: forall b a. (E (T ()), b) -> Either (Err a) (E (T ()), b)
checkCtx (E (T ())
e, b
u) = (,b
u)(E (T ()) -> (E (T ()), b))
-> Either (Err a) (E (T ())) -> Either (Err a) (E (T ()), b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>E (T ()) -> Either (Err a) (E (T ()))
forall a. E (T ()) -> Either (Err a) (E (T ()))
checkM E (T ())
e

parseInline :: BSL.ByteString -> Either (Err AlexPosn) (E (T ()), Int)
parseInline :: ByteString -> Either (Err AlexPosn) (E (T ()), Int)
parseInline ByteString
bsl =
    (\(E (T ())
e, Int
i) -> Int -> E (T ()) -> (E (T ()), Int)
inline Int
i E (T ())
e) ((E (T ()), Int) -> (E (T ()), Int))
-> Either (Err AlexPosn) (E (T ()), Int)
-> Either (Err AlexPosn) (E (T ()), Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((E (T ()), Int) -> Either (Err AlexPosn) (E (T ()), Int)
forall b a. (E (T ()), b) -> Either (Err a) (E (T ()), b)
checkCtx ((E (T ()), Int) -> Either (Err AlexPosn) (E (T ()), Int))
-> Either (Err AlexPosn) (E (T ()), Int)
-> Either (Err AlexPosn) (E (T ()), Int)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> Either (Err AlexPosn) (E (T ()), Int)
tyParse ByteString
bsl)

tyConstrCtx :: AlexUserState -> BSL.ByteString -> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
tyConstrCtx :: AlexUserState
-> ByteString
-> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
tyConstrCtx AlexUserState
st ByteString
bsl =
    case AlexUserState -> ByteString -> Either ParseE (E AlexPosn, Int)
parseRenameCtx AlexUserState
st ByteString
bsl of
        Left ParseE
err       -> Err AlexPosn
-> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
forall a b. a -> Either a b
Left (Err AlexPosn
 -> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int))
-> Err AlexPosn
-> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
forall a b. (a -> b) -> a -> b
$ ParseE -> Err AlexPosn
forall a. ParseE -> Err a
PErr ParseE
err
        Right (E AlexPosn
ast, Int
m) -> (TyE AlexPosn -> Err AlexPosn)
-> Either (TyE AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
-> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TyE AlexPosn -> Err AlexPosn
forall a. TyE a -> Err a
TyErr (Either (TyE AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
 -> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int))
-> Either (TyE AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
-> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
forall a b. (a -> b) -> a -> b
$ Int
-> E AlexPosn
-> Either (TyE AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
forall a. Int -> E a -> Either (TyE a) (E (T ()), [(Nm a, C)], Int)
tyClosed Int
m E AlexPosn
ast

tyParseCtx :: AlexUserState -> BSL.ByteString -> Either (Err AlexPosn) (E (T ()), Int)
tyParseCtx :: AlexUserState
-> ByteString -> Either (Err AlexPosn) (E (T ()), Int)
tyParseCtx AlexUserState
st = ((E (T ()), [(Nm AlexPosn, C)], Int) -> (E (T ()), Int))
-> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
-> Either (Err AlexPosn) (E (T ()), Int)
forall a b.
(a -> b) -> Either (Err AlexPosn) a -> Either (Err AlexPosn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (E (T ()), [(Nm AlexPosn, C)], Int) -> (E (T ()), Int)
forall {a} {b} {b}. (a, b, b) -> (a, b)
sel (Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
 -> Either (Err AlexPosn) (E (T ()), Int))
-> (ByteString
    -> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int))
-> ByteString
-> Either (Err AlexPosn) (E (T ()), Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlexUserState
-> ByteString
-> Either (Err AlexPosn) (E (T ()), [(Nm AlexPosn, C)], Int)
tyConstrCtx AlexUserState
st where sel :: (a, b, b) -> (a, b)
sel ~(a
x, b
_, b
z) = (a
x, b
z)

tyParse :: BSL.ByteString -> Either (Err AlexPosn) (E (T ()), Int)
tyParse :: ByteString -> Either (Err AlexPosn) (E (T ()), Int)
tyParse = AlexUserState
-> ByteString -> Either (Err AlexPosn) (E (T ()), Int)
tyParseCtx AlexUserState
alexInitUserState