{-# 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 a) | 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 a
err)  = ParseE a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ParseE a -> Doc ann
pretty ParseE a
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 AlexPosn) (E AlexPosn, Int)
rwP AlexUserState
st = ((Int, E AlexPosn) -> (E AlexPosn, Int))
-> Either (ParseE AlexPosn) (Int, E AlexPosn)
-> Either (ParseE AlexPosn) (E AlexPosn, Int)
forall a b.
(a -> b)
-> Either (ParseE AlexPosn) a -> Either (ParseE AlexPosn) 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 AlexPosn) (Int, E AlexPosn)
 -> Either (ParseE AlexPosn) (E AlexPosn, Int))
-> (ByteString -> Either (ParseE AlexPosn) (Int, E AlexPosn))
-> ByteString
-> Either (ParseE AlexPosn) (E AlexPosn, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlexUserState
-> ByteString -> Either (ParseE AlexPosn) (Int, E AlexPosn)
parseWithMaxCtx AlexUserState
st

parseRenameCtx :: AlexUserState -> BSL.ByteString -> Either (ParseE AlexPosn) (E AlexPosn, Int)
parseRenameCtx :: AlexUserState
-> ByteString -> Either (ParseE AlexPosn) (E AlexPosn, Int)
parseRenameCtx AlexUserState
st = ((Int, E AlexPosn) -> (E AlexPosn, Int))
-> Either (ParseE AlexPosn) (Int, E AlexPosn)
-> Either (ParseE AlexPosn) (E AlexPosn, Int)
forall a b.
(a -> b)
-> Either (ParseE AlexPosn) a -> Either (ParseE AlexPosn) 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 AlexPosn) (Int, E AlexPosn)
 -> Either (ParseE AlexPosn) (E AlexPosn, Int))
-> (ByteString -> Either (ParseE AlexPosn) (Int, E AlexPosn))
-> ByteString
-> Either (ParseE AlexPosn) (E AlexPosn, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlexUserState
-> ByteString -> Either (ParseE AlexPosn) (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 AlexPosn) (E AlexPosn, Int)
parseRename :: ByteString -> Either (ParseE AlexPosn) (E AlexPosn, Int)
parseRename = AlexUserState
-> ByteString -> Either (ParseE AlexPosn) (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 ()])
 -> IO (ByteString, FunPtr b, Maybe (Ptr Word64)))
-> (Int
    -> E a
    -> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg ()]))
-> 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 ()])
-> IO (ByteString, FunPtr b, Maybe (Ptr Word64))
forall a b.
CCtx
-> (IntMap [Word64], [X86 X86Reg FX86Reg a])
-> IO (ByteString, FunPtr b, Maybe (Ptr Word64))
assembleCtx Int
-> E a -> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
forall a.
Int
-> E a -> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
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 ()])
 -> IO (ByteString, FunPtr b, Maybe (Ptr Word64)))
-> (Int
    -> E a
    -> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> 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 ()])
-> IO (ByteString, FunPtr b, Maybe (Ptr Word64))
forall b.
(CCtx, MCtx)
-> (IntMap [Word64], [AArch64 AReg FAReg ()])
-> IO (ByteString, FunPtr b, Maybe (Ptr Word64))
Aarch64.assembleCtx Int
-> E a -> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg ()])
forall a.
Int
-> E a -> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg ()])
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 ()])
 -> IO (ByteString, FunPtr a, Maybe (Ptr Word64)))
-> (ByteString
    -> Either
         (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg ()]))
-> 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 ()])
-> IO (ByteString, FunPtr a, Maybe (Ptr Word64))
forall a b.
CCtx
-> (IntMap [Word64], [X86 X86Reg FX86Reg a])
-> IO (ByteString, FunPtr b, Maybe (Ptr Word64))
assembleCtx ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
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 ()])
 -> IO (ByteString, FunPtr a, Maybe (Ptr Word64)))
-> (ByteString
    -> Either
         (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> (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 ()])
-> IO (ByteString, FunPtr a, Maybe (Ptr Word64))
forall b.
(CCtx, MCtx)
-> (IntMap [Word64], [AArch64 AReg FAReg ()])
-> IO (ByteString, FunPtr b, Maybe (Ptr Word64))
Aarch64.assembleCtx ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg ()])
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 ()])
    -> IO ([ByteString], FunPtr a, Maybe (Ptr Word64)))
-> (IntMap [Word64], [X86 X86Reg FX86Reg ()])
-> IO (FunPtr a, Maybe (Ptr Word64))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IntMap [Word64], [X86 X86Reg FX86Reg ()])
-> IO ([ByteString], FunPtr a, Maybe (Ptr Word64))
forall a b.
(IntMap [Word64], [X86 X86Reg FX86Reg a])
-> IO ([ByteString], FunPtr b, Maybe (Ptr Word64))
allFp ((IntMap [Word64], [X86 X86Reg FX86Reg ()])
 -> IO (FunPtr a, Maybe (Ptr Word64)))
-> (ByteString -> IO (IntMap [Word64], [X86 X86Reg FX86Reg ()]))
-> 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 ()]))
-> ((IntMap [Word64], [X86 X86Reg FX86Reg ()])
    -> IO (IntMap [Word64], [X86 X86Reg FX86Reg ()]))
-> Either (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
-> IO (IntMap [Word64], [X86 X86Reg FX86Reg ()])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Err AlexPosn -> IO (IntMap [Word64], [X86 X86Reg FX86Reg ()])
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IntMap [Word64], [X86 X86Reg FX86Reg ()])
-> IO (IntMap [Word64], [X86 X86Reg FX86Reg ()])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
 -> IO (IntMap [Word64], [X86 X86Reg FX86Reg ()]))
-> (ByteString
    -> Either
         (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg ()]))
-> ByteString
-> IO (IntMap [Word64], [X86 X86Reg FX86Reg ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
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 ()])
    -> IO ([ByteString], FunPtr a, Maybe (Ptr Word64)))
-> (IntMap [Word64], [AArch64 AReg FAReg ()])
-> IO (FunPtr a, Maybe (Ptr Word64))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IntMap [Word64], [AArch64 AReg FAReg ()])
-> IO ([ByteString], FunPtr a, Maybe (Ptr Word64))
forall b.
(IntMap [Word64], [AArch64 AReg FAReg ()])
-> IO ([ByteString], FunPtr b, Maybe (Ptr Word64))
Aarch64.allFp ((IntMap [Word64], [AArch64 AReg FAReg ()])
 -> IO (FunPtr a, Maybe (Ptr Word64)))
-> (ByteString -> IO (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> 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 ()]))
-> ((IntMap [Word64], [AArch64 AReg FAReg ()])
    -> IO (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> Either (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg ()])
-> IO (IntMap [Word64], [AArch64 AReg FAReg ()])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Err AlexPosn -> IO (IntMap [Word64], [AArch64 AReg FAReg ()])
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IntMap [Word64], [AArch64 AReg FAReg ()])
-> IO (IntMap [Word64], [AArch64 AReg FAReg ()])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg ()])
 -> IO (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> (ByteString
    -> Either
         (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> ByteString
-> IO (IntMap [Word64], [AArch64 AReg FAReg ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg ()])
aarch64

bytes :: BSL.ByteString -> Either (Err AlexPosn) BS.ByteString
bytes :: ByteString -> Either (Err AlexPosn) ByteString
bytes = ((IntMap [Word64], [X86 X86Reg FX86Reg ()]) -> ByteString)
-> Either (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
-> 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 ()]) -> ByteString
forall a. (IntMap [Word64], [X86 X86Reg FX86Reg a]) -> ByteString
assemble (Either (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
 -> Either (Err AlexPosn) ByteString)
-> (ByteString
    -> Either
         (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg ()]))
-> ByteString
-> Either (Err AlexPosn) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
x86G

as :: T.Text -> BSL.ByteString -> Doc ann
as :: forall ann. Text -> ByteString -> Doc ann
as Text
f = (IntMap [Word64], [AArch64 AReg FAReg ()]) -> Doc ann
forall {t :: * -> *} {isn} {a}.
(Foldable t, Functor t, Pretty isn) =>
(IntMap (t Word64), [isn]) -> Doc a
prolegomena((IntMap [Word64], [AArch64 AReg FAReg ()]) -> Doc ann)
-> (ByteString -> (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> ByteString
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Err AlexPosn -> (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> ((IntMap [Word64], [AArch64 AReg FAReg ()])
    -> (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> Either (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg ()])
-> (IntMap [Word64], [AArch64 AReg FAReg ()])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Err AlexPosn -> (IntMap [Word64], [AArch64 AReg FAReg ()])
forall a e. (HasCallStack, Exception e) => e -> a
throw (([AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg ()])
-> (IntMap [Word64], [AArch64 AReg FAReg ()])
-> (IntMap [Word64], [AArch64 AReg FAReg ()])
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 ()] -> [AArch64 AReg FAReg ()]
forall {reg} {freg}.
Eq reg =>
[AArch64 reg freg ()] -> [AArch64 reg freg ()]
aso)(Either (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg ()])
 -> (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> (ByteString
    -> Either
         (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> ByteString
-> (IntMap [Word64], [AArch64 AReg FAReg ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg ()])
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 ()] -> [AArch64 reg freg ()]
aso (MovRCf () reg
r0 CFunc
f:Blr () reg
r1:[AArch64 reg freg ()]
asms) | reg
r0 reg -> reg -> Bool
forall a. Eq a => a -> a -> Bool
== reg
r1 = () -> CFunc -> AArch64 reg freg ()
forall reg freg a. a -> CFunc -> AArch64 reg freg a
Bl () CFunc
fAArch64 reg freg ()
-> [AArch64 reg freg ()] -> [AArch64 reg freg ()]
forall a. a -> [a] -> [a]
:[AArch64 reg freg ()] -> [AArch64 reg freg ()]
aso [AArch64 reg freg ()]
asms
aso (AArch64 reg freg ()
asm:[AArch64 reg freg ()]
asms) = AArch64 reg freg ()
asmAArch64 reg freg ()
-> [AArch64 reg freg ()] -> [AArch64 reg freg ()]
forall a. a -> [a] -> [a]
:[AArch64 reg freg ()] -> [AArch64 reg freg ()]
aso [AArch64 reg freg ()]
asms; aso [] = []

aarch64 :: BSL.ByteString -> Either (Err AlexPosn) (IR.AsmData, [AArch64 AReg FAReg ()])
aarch64 :: ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg ()])
aarch64 = (([Stmt], IntMap [Word64], WSt)
 -> (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt)
-> Either (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg ()])
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 ()]) -> [AArch64 AReg FAReg ()])
-> (IntMap [Word64], (Int, [AArch64 AbsReg FAbsReg ()]))
-> (IntMap [Word64], [AArch64 AReg FAReg ()])
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 ()] -> [AArch64 AReg FAReg ()]
forall reg freg.
(Eq reg, Eq freg) =>
[AArch64 reg freg ()] -> [AArch64 reg freg ()]
Aarch64.opt ([AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg ()])
-> ((Int, [AArch64 AbsReg FAbsReg ()]) -> [AArch64 AReg FAReg ()])
-> (Int, [AArch64 AbsReg FAbsReg ()])
-> [AArch64 AReg FAReg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg ()]
forall reg freg.
(Eq reg, Eq freg) =>
[AArch64 reg freg ()] -> [AArch64 reg freg ()]
Aarch64.opt ([AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg ()])
-> ((Int, [AArch64 AbsReg FAbsReg ()]) -> [AArch64 AReg FAReg ()])
-> (Int, [AArch64 AbsReg FAbsReg ()])
-> [AArch64 AReg FAReg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [AArch64 AbsReg FAbsReg ()] -> [AArch64 AReg FAReg ()])
-> (Int, [AArch64 AbsReg FAbsReg ()]) -> [AArch64 AReg FAReg ()]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> [AArch64 AbsReg FAbsReg ()] -> [AArch64 AReg FAReg ()]
Aarch64.gallocFrame)((IntMap [Word64], (Int, [AArch64 AbsReg FAbsReg ()]))
 -> (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> (([Stmt], IntMap [Word64], WSt)
    -> (IntMap [Word64], (Int, [AArch64 AbsReg FAbsReg ()])))
-> ([Stmt], IntMap [Word64], WSt)
-> (IntMap [Word64], [AArch64 AReg FAReg ()])
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 ()])
irToAarch64 WSt
st [Stmt]
x))) (Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt)
 -> Either
      (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> (ByteString
    -> Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt))
-> ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [AArch64 AReg FAReg ()])
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 ()])
x86G :: ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
x86G = ((Int, [X86 AbsReg FAbsReg ()]) -> [X86 X86Reg FX86Reg ()])
-> ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
forall {reg} {freg}.
(E reg, E freg, Eq reg, Eq freg) =>
((Int, [X86 AbsReg FAbsReg ()]) -> [X86 reg freg ()])
-> ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [X86 reg freg ()])
walloc ((Int -> [X86 AbsReg FAbsReg ()] -> [X86 X86Reg FX86Reg ()])
-> (Int, [X86 AbsReg FAbsReg ()]) -> [X86 X86Reg FX86Reg ()]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> [X86 AbsReg FAbsReg ()] -> [X86 X86Reg FX86Reg ()]
X86.gallocFrame)

eAarch64 :: Int -> E a -> Either (Err a) (IR.AsmData, [AArch64 AReg FAReg ()])
eAarch64 :: forall a.
Int
-> E a -> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg ()])
eAarch64 Int
i = (([Stmt], IntMap [Word64], WSt)
 -> (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> Either (Err a) ([Stmt], IntMap [Word64], WSt)
-> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg ()])
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 ()]) -> [AArch64 AReg FAReg ()])
-> (IntMap [Word64], (Int, [AArch64 AbsReg FAbsReg ()]))
-> (IntMap [Word64], [AArch64 AReg FAReg ()])
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 ()] -> [AArch64 AReg FAReg ()]
forall reg freg.
(Eq reg, Eq freg) =>
[AArch64 reg freg ()] -> [AArch64 reg freg ()]
Aarch64.opt ([AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg ()])
-> ((Int, [AArch64 AbsReg FAbsReg ()]) -> [AArch64 AReg FAReg ()])
-> (Int, [AArch64 AbsReg FAbsReg ()])
-> [AArch64 AReg FAReg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg ()]
forall reg freg.
(Eq reg, Eq freg) =>
[AArch64 reg freg ()] -> [AArch64 reg freg ()]
Aarch64.opt ([AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg ()])
-> ((Int, [AArch64 AbsReg FAbsReg ()]) -> [AArch64 AReg FAReg ()])
-> (Int, [AArch64 AbsReg FAbsReg ()])
-> [AArch64 AReg FAReg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [AArch64 AbsReg FAbsReg ()] -> [AArch64 AReg FAReg ()])
-> (Int, [AArch64 AbsReg FAbsReg ()]) -> [AArch64 AReg FAReg ()]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> [AArch64 AbsReg FAbsReg ()] -> [AArch64 AReg FAReg ()]
Aarch64.gallocFrame)((IntMap [Word64], (Int, [AArch64 AbsReg FAbsReg ()]))
 -> (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> (([Stmt], IntMap [Word64], WSt)
    -> (IntMap [Word64], (Int, [AArch64 AbsReg FAbsReg ()])))
-> ([Stmt], IntMap [Word64], WSt)
-> (IntMap [Word64], [AArch64 AReg FAReg ()])
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 ()])
irToAarch64 WSt
st [Stmt]
x))) (Either (Err a) ([Stmt], IntMap [Word64], WSt)
 -> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> (E a -> Either (Err a) ([Stmt], IntMap [Word64], WSt))
-> E a
-> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg ()])
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 ()])
ex86G :: forall a.
Int
-> E a -> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
ex86G Int
i = Int
-> ((Int, [X86 AbsReg FAbsReg ()]) -> [X86 X86Reg FX86Reg ()])
-> E a
-> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
forall {reg} {freg} {a}.
(E reg, E freg, Eq reg, Eq freg) =>
Int
-> ((Int, [X86 AbsReg FAbsReg ()]) -> [X86 reg freg ()])
-> E a
-> Either (Err a) (IntMap [Word64], [X86 reg freg ()])
wallocE Int
i ((Int -> [X86 AbsReg FAbsReg ()] -> [X86 X86Reg FX86Reg ()])
-> (Int, [X86 AbsReg FAbsReg ()]) -> [X86 X86Reg FX86Reg ()]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> [X86 AbsReg FAbsReg ()] -> [X86 X86Reg FX86Reg ()]
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 ()]) -> Doc ann)
-> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
-> 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 ()]) -> Doc ann
forall isn ann. Pretty isn => (IntMap [Word64], [isn]) -> Doc ann
prettyAsm (Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
 -> Either (Err a) (Doc ann))
-> (E a
    -> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg ()]))
-> 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 ()])
forall a.
Int
-> E a -> Either (Err a) (IntMap [Word64], [X86 X86Reg FX86Reg ()])
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 ()]) -> Doc ann)
-> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg ()])
-> 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 ()]) -> Doc ann
forall isn ann. Pretty isn => (IntMap [Word64], [isn]) -> Doc ann
prettyAsm (Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg ()])
 -> Either (Err a) (Doc ann))
-> (E a
    -> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg ()]))
-> 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 ()])
forall a.
Int
-> E a -> Either (Err a) (IntMap [Word64], [AArch64 AReg FAReg ()])
eAarch64 Int
i

walloc :: ((Int, [X86 AbsReg FAbsReg ()]) -> [X86 reg freg ()])
-> ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [X86 reg freg ()])
walloc (Int, [X86 AbsReg FAbsReg ()]) -> [X86 reg freg ()]
f = (([Stmt], IntMap [Word64], WSt)
 -> (IntMap [Word64], [X86 reg freg ()]))
-> Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt)
-> Either (Err AlexPosn) (IntMap [Word64], [X86 reg freg ()])
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 ()]) -> [X86 reg freg ()])
-> (IntMap [Word64], (Int, [X86 AbsReg FAbsReg ()]))
-> (IntMap [Word64], [X86 reg freg ()])
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 ()] -> [X86 reg freg ()]
forall reg freg.
(E reg, E freg, Eq reg, Eq freg) =>
[X86 reg freg ()] -> [X86 reg freg ()]
optX86([X86 reg freg ()] -> [X86 reg freg ()])
-> ((Int, [X86 AbsReg FAbsReg ()]) -> [X86 reg freg ()])
-> (Int, [X86 AbsReg FAbsReg ()])
-> [X86 reg freg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[X86 reg freg ()] -> [X86 reg freg ()]
forall reg freg.
(E reg, E freg, Eq reg, Eq freg) =>
[X86 reg freg ()] -> [X86 reg freg ()]
optX86([X86 reg freg ()] -> [X86 reg freg ()])
-> ((Int, [X86 AbsReg FAbsReg ()]) -> [X86 reg freg ()])
-> (Int, [X86 AbsReg FAbsReg ()])
-> [X86 reg freg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int, [X86 AbsReg FAbsReg ()]) -> [X86 reg freg ()]
f) ((IntMap [Word64], (Int, [X86 AbsReg FAbsReg ()]))
 -> (IntMap [Word64], [X86 reg freg ()]))
-> (([Stmt], IntMap [Word64], WSt)
    -> (IntMap [Word64], (Int, [X86 AbsReg FAbsReg ()])))
-> ([Stmt], IntMap [Word64], WSt)
-> (IntMap [Word64], [X86 reg freg ()])
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 ()])
irToX86 WSt
st [Stmt]
x))) (Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt)
 -> Either (Err AlexPosn) (IntMap [Word64], [X86 reg freg ()]))
-> (ByteString
    -> Either (Err AlexPosn) ([Stmt], IntMap [Word64], WSt))
-> ByteString
-> Either (Err AlexPosn) (IntMap [Word64], [X86 reg freg ()])
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 ()]) -> [X86 reg freg ()])
-> E a
-> Either (Err a) (IntMap [Word64], [X86 reg freg ()])
wallocE Int
i (Int, [X86 AbsReg FAbsReg ()]) -> [X86 reg freg ()]
f = (([Stmt], IntMap [Word64], WSt)
 -> (IntMap [Word64], [X86 reg freg ()]))
-> Either (Err a) ([Stmt], IntMap [Word64], WSt)
-> Either (Err a) (IntMap [Word64], [X86 reg freg ()])
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 ()]) -> [X86 reg freg ()])
-> (IntMap [Word64], (Int, [X86 AbsReg FAbsReg ()]))
-> (IntMap [Word64], [X86 reg freg ()])
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 ()] -> [X86 reg freg ()]
forall reg freg.
(E reg, E freg, Eq reg, Eq freg) =>
[X86 reg freg ()] -> [X86 reg freg ()]
optX86([X86 reg freg ()] -> [X86 reg freg ()])
-> ((Int, [X86 AbsReg FAbsReg ()]) -> [X86 reg freg ()])
-> (Int, [X86 AbsReg FAbsReg ()])
-> [X86 reg freg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[X86 reg freg ()] -> [X86 reg freg ()]
forall reg freg.
(E reg, E freg, Eq reg, Eq freg) =>
[X86 reg freg ()] -> [X86 reg freg ()]
optX86([X86 reg freg ()] -> [X86 reg freg ()])
-> ((Int, [X86 AbsReg FAbsReg ()]) -> [X86 reg freg ()])
-> (Int, [X86 AbsReg FAbsReg ()])
-> [X86 reg freg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int, [X86 AbsReg FAbsReg ()]) -> [X86 reg freg ()]
f) ((IntMap [Word64], (Int, [X86 AbsReg FAbsReg ()]))
 -> (IntMap [Word64], [X86 reg freg ()]))
-> (([Stmt], IntMap [Word64], WSt)
    -> (IntMap [Word64], (Int, [X86 AbsReg FAbsReg ()])))
-> ([Stmt], IntMap [Word64], WSt)
-> (IntMap [Word64], [X86 reg freg ()])
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 ()])
irToX86 WSt
st [Stmt]
x))) (Either (Err a) ([Stmt], IntMap [Word64], WSt)
 -> Either (Err a) (IntMap [Word64], [X86 reg freg ()]))
-> (E a -> Either (Err a) ([Stmt], IntMap [Word64], WSt))
-> E a
-> Either (Err a) (IntMap [Word64], [X86 reg freg ()])
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 AlexPosn) (E AlexPosn, Int)
parseRenameCtx AlexUserState
st ByteString
bsl of
        Left ParseE AlexPosn
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 AlexPosn -> Err AlexPosn
forall a. ParseE a -> Err a
PErr ParseE AlexPosn
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