{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings, RecordWildCards, MultiWayIf, ViewPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Language.Asm.Inline.QQ
( asm
, asmTy

, substitute
, unroll
, unrolls
) where

import qualified Data.Map as M
import Control.Applicative(ZipList(..))
import Control.Monad.Combinators.Expr as CE
import Control.Monad.Except
import Control.Monad.State.Strict
import Data.Bifunctor
import Data.Char
import Data.Either.Combinators
import Data.Foldable
import Data.Functor
import Data.List
import Data.String
import Data.Void
import Foreign.Ptr
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as ML

import Language.Asm.Inline.AsmCode

instance AsmCode AsmQQType AsmQQCode where
  codeToString :: AsmQQType -> AsmQQCode -> String
codeToString AsmQQType
ty AsmQQCode
code = case AsmQQType -> AsmQQCode -> Either String AsmQQCode
substituteArgs AsmQQType
ty AsmQQCode
code of
                              Left String
e -> forall a. HasCallStack => String -> a
error String
e
                              Right AsmQQCode
s -> AsmQQCode -> String
asmCode AsmQQCode
s
  toTypeQ :: AsmQQType -> Q Type
toTypeQ = AsmQQType -> Q Type
unreflectTy

asm :: QuasiQuoter
asm :: QuasiQuoter
asm = (String -> Q Exp) -> QuasiQuoter
expQQ String -> Q Exp
asmQE

asmQE :: String -> Q Exp
asmQE :: String -> Q Exp
asmQE String
p = [e| AsmQQCode p |]

newtype AsmQQCode = AsmQQCode { AsmQQCode -> String
asmCode :: String }

instance Semigroup AsmQQCode where
  AsmQQCode
c1 <> :: AsmQQCode -> AsmQQCode -> AsmQQCode
<> AsmQQCode
c2 = String -> AsmQQCode
AsmQQCode forall a b. (a -> b) -> a -> b
$ AsmQQCode -> String
asmCode AsmQQCode
c1 forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<> AsmQQCode -> String
asmCode AsmQQCode
c2

instance Monoid AsmQQCode where
  mempty :: AsmQQCode
mempty = String -> AsmQQCode
AsmQQCode String
""


parseExpr :: MonadError String m => String -> String -> m (Int -> Int)
parseExpr :: forall (m :: * -> *).
MonadError String m =>
String -> String -> m (Int -> Int)
parseExpr String
var String
inputStr = forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle String Void -> String
showParseError forall a b. (a -> b) -> a -> b
$ forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (ParsecT Void String Identity (Int -> Int)
expr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" String
inputStr
  where
    expr :: ParsecT Void String Identity (Int -> Int)
expr = forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser ParsecT Void String Identity (Int -> Int)
term forall {t}. [[Operator (ParsecT Void String Identity) (t -> Int)]]
table forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"expr"
    term :: ParsecT Void String Identity (Int -> Int)
term = forall {a}.
ParsecT Void String Identity a -> ParsecT Void String Identity a
parens ParsecT Void String Identity (Int -> Int)
expr
       forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}.
ParsecT Void String Identity a -> ParsecT Void String Identity a
lexeme (forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
ML.signed ParsecT Void String Identity ()
lexSpace (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"0x" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
ML.hexadecimal forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
ML.decimal) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a b. a -> b -> a
const)
       forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}.
ParsecT Void String Identity a -> ParsecT Void String Identity a
lexeme (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
var forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. a -> a
id)
    table :: [[Operator (ParsecT Void String Identity) (t -> Int)]]
table = [ [ forall {t} {t}.
Tokens String
-> (t -> t -> t)
-> Operator (ParsecT Void String Identity) (t -> t)
binary Tokens String
"*" forall a. Num a => a -> a -> a
(*) ]
            , [ forall {t} {t}.
Tokens String
-> (t -> t -> t)
-> Operator (ParsecT Void String Identity) (t -> t)
binary Tokens String
"+" forall a. Num a => a -> a -> a
(+)
              , forall {t} {t}.
Tokens String
-> (t -> t -> t)
-> Operator (ParsecT Void String Identity) (t -> t)
binary Tokens String
"-" (-)
              ]
            ]
    binary :: Tokens String
-> (t -> t -> t)
-> Operator (ParsecT Void String Identity) (t -> t)
binary Tokens String
name t -> t -> t
fun = forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
CE.InfixL forall a b. (a -> b) -> a -> b
$ Tokens String -> ParsecT Void String Identity (Tokens String)
symbol Tokens String
name forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (\t -> t
l t -> t
r t
n -> t -> t
l t
n t -> t -> t
`fun` t -> t
r t
n)
    symbol :: Tokens String -> ParsecT Void String Identity (Tokens String)
symbol = forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
ML.symbol ParsecT Void String Identity ()
lexSpace
    parens :: ParsecT Void String Identity a -> ParsecT Void String Identity a
parens = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens String -> ParsecT Void String Identity (Tokens String)
symbol Tokens String
"(") (Tokens String -> ParsecT Void String Identity (Tokens String)
symbol Tokens String
")")
    lexeme :: ParsecT Void String Identity a -> ParsecT Void String Identity a
lexeme = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
ML.lexeme ParsecT Void String Identity ()
lexSpace
    lexSpace :: ParsecT Void String Identity ()
lexSpace = forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
ML.space forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Alternative f => f a
empty

unroll :: String -> [Int] -> AsmQQCode -> AsmQQCode
unroll :: String -> [Int] -> AsmQQCode -> AsmQQCode
unroll String
var [Int]
ints AsmQQCode
code = case forall (f :: * -> *).
Applicative f =>
(String -> f String) -> AsmQQCode -> Either String (f AsmQQCode)
substitute String -> ZipList String
sub AsmQQCode
code of
                            Left String
err -> forall a. HasCallStack => String -> a
error String
err
                            Right ZipList AsmQQCode
codes -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. ZipList a -> [a]
getZipList ZipList AsmQQCode
codes
  where
    sub :: String -> ZipList String
sub String
str = case forall (m :: * -> *).
MonadError String m =>
String -> String -> m (Int -> Int)
parseExpr String
var String
str of
                   Right Int -> Int
fun -> forall a. [a] -> ZipList a
ZipList forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
fun forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
ints
                   Left String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
"{" forall a. Semigroup a => a -> a -> a
<> String
str forall a. Semigroup a => a -> a -> a
<> String
"}"

unrolls :: String -> [Int] -> [AsmQQCode] -> AsmQQCode
unrolls :: String -> [Int] -> [AsmQQCode] -> AsmQQCode
unrolls String
var [Int]
ints = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a b. (a -> b) -> a -> b
$ String -> [Int] -> AsmQQCode -> AsmQQCode
unroll String
var [Int]
ints

substitute :: Applicative f => (String -> f String) -> AsmQQCode -> Either String (f AsmQQCode)
substitute :: forall (f :: * -> *).
Applicative f =>
(String -> f String) -> AsmQQCode -> Either String (f AsmQQCode)
substitute String -> f String
subst AsmQQCode { String
asmCode :: String
asmCode :: AsmQQCode -> String
.. } = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> AsmQQCode
AsmQQCode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String (f String)
go String
asmCode
  where
    go :: String -> Either String (f String)
go (Char
'{' : String
rest)
      | (String
argStr, Char
'}' : String
rest') <- forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'}') String
rest
      , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
argStr = (forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
subst (String -> String
trim String
argStr) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String (f String)
go String
rest'
      | Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unable to parse argument: " forall a. Semigroup a => a -> a -> a
<> forall a. Int -> [a] -> [a]
take Int
20 String
rest forall a. Semigroup a => a -> a -> a
<> String
"..."
    go (Char
x : String
xs) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char
x forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String (f String)
go String
xs
    go [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure []

substituteArgs :: AsmQQType -> AsmQQCode -> Either String AsmQQCode
substituteArgs :: AsmQQType -> AsmQQCode -> Either String AsmQQCode
substituteArgs AsmQQType { [(AsmVarName, AsmVarType)]
rets :: AsmQQType -> [(AsmVarName, AsmVarType)]
args :: AsmQQType -> [(AsmVarName, AsmVarType)]
rets :: [(AsmVarName, AsmVarType)]
args :: [(AsmVarName, AsmVarType)]
.. } AsmQQCode
asmCode = do
  [(AsmVarName, RegName)]
argRegs <- [(AsmVarName, AsmVarType)] -> Either String [(AsmVarName, RegName)]
computeRegisters [(AsmVarName, AsmVarType)]
args
  [(AsmVarName, RegName)]
retRegs <- [(AsmVarName, AsmVarType)] -> Either String [(AsmVarName, RegName)]
computeRegisters [(AsmVarName, AsmVarType)]
rets
  StateT (Map AsmVarName RegName) (Either String) AsmQQCode
res <- forall (f :: * -> *).
Applicative f =>
(String -> f String) -> AsmQQCode -> Either String (f AsmQQCode)
substitute forall {m :: * -> *}.
(MonadState (Map AsmVarName RegName) m, MonadError String m) =>
String -> m String
subst AsmQQCode
asmCode
  forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT (Map AsmVarName RegName) (Either String) AsmQQCode
res forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ [(AsmVarName, RegName)]
retRegs forall a. Semigroup a => a -> a -> a
<> [(AsmVarName, RegName)]
argRegs
  where
    subst :: String -> m String
subst String
arg | String
"move" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
arg = String -> m String
moveReg String
arg
              | Bool
otherwise = do
        let var :: AsmVarName
var = String -> AsmVarName
AsmVarName String
arg
        Maybe RegName
maybeReg <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ \Map AsmVarName RegName
regMap -> forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AsmVarName
var Map AsmVarName RegName
regMap
        RegName String
reg <- forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither forall a b. (a -> b) -> a -> b
$ forall b a. b -> Maybe a -> Either b a
maybeToRight (String
"Unknown argument: `" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show AsmVarName
var forall a. Semigroup a => a -> a -> a
<> String
"`") Maybe RegName
maybeReg
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Char
'%' forall a. a -> [a] -> [a]
: String
reg

    moveReg :: String -> m String
moveReg (String -> [String]
words -> [String
"move", String
regName, String
reg]) = do
      String
oldReg <- String -> m String
subst String
regName
      let mov :: String
mov = String
"mov " forall a. Semigroup a => a -> a -> a
<> String
oldReg forall a. Semigroup a => a -> a -> a
<> String
", %" forall a. Semigroup a => a -> a -> a
<> String
reg
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (String -> AsmVarName
AsmVarName String
regName) (String -> RegName
RegName String
reg)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure String
mov
    moveReg String
s = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String
"Unable to parse move command `" forall a. Semigroup a => a -> a -> a
<> String
s forall a. Semigroup a => a -> a -> a
<> String
"`"

newtype RegName = RegName { RegName -> String
regName :: String } deriving (Int -> RegName -> String -> String
[RegName] -> String -> String
RegName -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RegName] -> String -> String
$cshowList :: [RegName] -> String -> String
show :: RegName -> String
$cshow :: RegName -> String
showsPrec :: Int -> RegName -> String -> String
$cshowsPrec :: Int -> RegName -> String -> String
Show, String -> RegName
forall a. (String -> a) -> IsString a
fromString :: String -> RegName
$cfromString :: String -> RegName
IsString)

computeRegisters :: [(AsmVarName, AsmVarType)] -> Either String [(AsmVarName, RegName)]
computeRegisters :: [(AsmVarName, AsmVarType)] -> Either String [(AsmVarName, RegName)]
computeRegisters [(AsmVarName, AsmVarType)]
vars = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([(AsmVarName, RegName)], Map VarTyCat Int)
-> (AsmVarName, AsmVarType)
-> Either String ([(AsmVarName, RegName)], Map VarTyCat Int)
handleType ([], forall a. Monoid a => a
mempty) [(AsmVarName, AsmVarType)]
vars
  where
    handleType :: ([(AsmVarName, RegName)], Map VarTyCat Int)
-> (AsmVarName, AsmVarType)
-> Either String ([(AsmVarName, RegName)], Map VarTyCat Int)
handleType ([(AsmVarName, RegName)]
regNames, Map VarTyCat Int
regCounts) (AsmVarName
name, AsmVarType
ty) = do
      [(AsmVarName, VarTyCat)]
cats <- AsmVarName -> AsmVarType -> Either String [(AsmVarName, VarTyCat)]
categorize AsmVarName
name AsmVarType
ty
      forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {a}.
([(a, RegName)], Map VarTyCat Int)
-> (a, VarTyCat)
-> Either String ([(a, RegName)], Map VarTyCat Int)
handleCats ([(AsmVarName, RegName)]
regNames, Map VarTyCat Int
regCounts) [(AsmVarName, VarTyCat)]
cats

    handleCats :: ([(a, RegName)], Map VarTyCat Int)
-> (a, VarTyCat)
-> Either String ([(a, RegName)], Map VarTyCat Int)
handleCats ([(a, RegName)]
regNames, Map VarTyCat Int
regCounts) (a
name, VarTyCat
cat) = do
      RegName
reg <- VarTyCat -> Int -> Either String RegName
argIdxToReg VarTyCat
cat Int
idx
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a
name, RegName
reg) forall a. a -> [a] -> [a]
: [(a, RegName)]
regNames, forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VarTyCat
cat (Int
idx forall a. Num a => a -> a -> a
+ Int
1) Map VarTyCat Int
regCounts)
      where
        idx :: Int
idx = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Int
0 VarTyCat
cat Map VarTyCat Int
regCounts

data VarTyCat = Integer | Other deriving (VarTyCat -> VarTyCat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarTyCat -> VarTyCat -> Bool
$c/= :: VarTyCat -> VarTyCat -> Bool
== :: VarTyCat -> VarTyCat -> Bool
$c== :: VarTyCat -> VarTyCat -> Bool
Eq, Eq VarTyCat
VarTyCat -> VarTyCat -> Bool
VarTyCat -> VarTyCat -> Ordering
VarTyCat -> VarTyCat -> VarTyCat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VarTyCat -> VarTyCat -> VarTyCat
$cmin :: VarTyCat -> VarTyCat -> VarTyCat
max :: VarTyCat -> VarTyCat -> VarTyCat
$cmax :: VarTyCat -> VarTyCat -> VarTyCat
>= :: VarTyCat -> VarTyCat -> Bool
$c>= :: VarTyCat -> VarTyCat -> Bool
> :: VarTyCat -> VarTyCat -> Bool
$c> :: VarTyCat -> VarTyCat -> Bool
<= :: VarTyCat -> VarTyCat -> Bool
$c<= :: VarTyCat -> VarTyCat -> Bool
< :: VarTyCat -> VarTyCat -> Bool
$c< :: VarTyCat -> VarTyCat -> Bool
compare :: VarTyCat -> VarTyCat -> Ordering
$ccompare :: VarTyCat -> VarTyCat -> Ordering
Ord, Int -> VarTyCat -> String -> String
[VarTyCat] -> String -> String
VarTyCat -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [VarTyCat] -> String -> String
$cshowList :: [VarTyCat] -> String -> String
show :: VarTyCat -> String
$cshow :: VarTyCat -> String
showsPrec :: Int -> VarTyCat -> String -> String
$cshowsPrec :: Int -> VarTyCat -> String -> String
Show, Int -> VarTyCat
VarTyCat -> Int
VarTyCat -> [VarTyCat]
VarTyCat -> VarTyCat
VarTyCat -> VarTyCat -> [VarTyCat]
VarTyCat -> VarTyCat -> VarTyCat -> [VarTyCat]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VarTyCat -> VarTyCat -> VarTyCat -> [VarTyCat]
$cenumFromThenTo :: VarTyCat -> VarTyCat -> VarTyCat -> [VarTyCat]
enumFromTo :: VarTyCat -> VarTyCat -> [VarTyCat]
$cenumFromTo :: VarTyCat -> VarTyCat -> [VarTyCat]
enumFromThen :: VarTyCat -> VarTyCat -> [VarTyCat]
$cenumFromThen :: VarTyCat -> VarTyCat -> [VarTyCat]
enumFrom :: VarTyCat -> [VarTyCat]
$cenumFrom :: VarTyCat -> [VarTyCat]
fromEnum :: VarTyCat -> Int
$cfromEnum :: VarTyCat -> Int
toEnum :: Int -> VarTyCat
$ctoEnum :: Int -> VarTyCat
pred :: VarTyCat -> VarTyCat
$cpred :: VarTyCat -> VarTyCat
succ :: VarTyCat -> VarTyCat
$csucc :: VarTyCat -> VarTyCat
Enum, VarTyCat
forall a. a -> a -> Bounded a
maxBound :: VarTyCat
$cmaxBound :: VarTyCat
minBound :: VarTyCat
$cminBound :: VarTyCat
Bounded)

categorize :: AsmVarName -> AsmVarType -> Either String [(AsmVarName, VarTyCat)]
categorize :: AsmVarName -> AsmVarType -> Either String [(AsmVarName, VarTyCat)]
categorize AsmVarName
name (AsmVarType String
ty)
  | String
ty forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall {a}. (Semigroup a, IsString a) => a -> [a]
integralFamily String
"Int"
            forall a. Semigroup a => a -> a -> a
<> forall {a}. (Semigroup a, IsString a) => a -> [a]
integralFamily String
"Word"
            forall a. Semigroup a => a -> a -> a
<> [String
"Ptr", String
"Unit"]) = forall (f :: * -> *) a. Applicative f => a -> f a
pure [(AsmVarName
name, VarTyCat
Integer)]
  | String
ty forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"Float", String
"Double"] = forall (f :: * -> *) a. Applicative f => a -> f a
pure [(AsmVarName
name, VarTyCat
Other)]
  where
    integralFamily :: a -> [a]
integralFamily a
base = [a
base, a
base forall a. Semigroup a => a -> a -> a
<> a
"8", a
base forall a. Semigroup a => a -> a -> a
<> a
"16", a
base forall a. Semigroup a => a -> a -> a
<> a
"32", a
base forall a. Semigroup a => a -> a -> a
<> a
"64"]
categorize AsmVarName
name (AsmVarType String
"ByteString") = forall (f :: * -> *) a. Applicative f => a -> f a
pure [(AsmVarName
name forall a. Semigroup a => a -> a -> a
<> AsmVarName
":ptr", VarTyCat
Integer), (AsmVarName
name forall a. Semigroup a => a -> a -> a
<> AsmVarName
":len", VarTyCat
Integer)]
categorize AsmVarName
_ (AsmVarType String
s) = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String
"Unknown register type for variable type `" forall a. Semigroup a => a -> a -> a
<> String
s forall a. Semigroup a => a -> a -> a
<> String
"`"

argIdxToReg :: VarTyCat -> Int -> Either String RegName
argIdxToReg :: VarTyCat -> Int -> Either String RegName
argIdxToReg VarTyCat
Integer Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure RegName
"rbx"
argIdxToReg VarTyCat
Integer Int
1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure RegName
"r14"
argIdxToReg VarTyCat
Integer Int
2 = forall (f :: * -> *) a. Applicative f => a -> f a
pure RegName
"rsi"
argIdxToReg VarTyCat
Integer Int
3 = forall (f :: * -> *) a. Applicative f => a -> f a
pure RegName
"rdi"
argIdxToReg VarTyCat
Integer Int
4 = forall (f :: * -> *) a. Applicative f => a -> f a
pure RegName
"r8"
argIdxToReg VarTyCat
Integer Int
5 = forall (f :: * -> *) a. Applicative f => a -> f a
pure RegName
"r9"
argIdxToReg VarTyCat
Other Int
n | Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
6 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> RegName
RegName forall a b. (a -> b) -> a -> b
$ String
"xmm" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Int
n forall a. Num a => a -> a -> a
+ Int
1)
argIdxToReg VarTyCat
_ Int
n = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String
"Unsupported register index: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n

trim :: String -> String
trim :: String -> String
trim = String -> String
pass forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pass
  where
    pass :: String -> String
pass = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ')

findSplitter :: String -> Either String (String, String)
findSplitter :: String -> Either String (String, String)
findSplitter String
p = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'|') String
p of
                      (String
vars, Char
'|' : String
body) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
vars, String
body)
                      (String, String)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"Unable to find variable section separator"

expQQ :: (String -> Q Exp) -> QuasiQuoter
expQQ :: (String -> Q Exp) -> QuasiQuoter
expQQ String -> Q Exp
qq = QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
qq, quotePat :: String -> Q Pat
quotePat = forall {b} {a}. b -> a
unsupported, quoteType :: String -> Q Type
quoteType = forall {b} {a}. b -> a
unsupported, quoteDec :: String -> Q [Dec]
quoteDec = forall {b} {a}. b -> a
unsupported }
  where
    unsupported :: b -> a
unsupported = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"Unsupported quasiquotation type"

asmTy :: QuasiQuoter
asmTy :: QuasiQuoter
asmTy = (String -> Q Exp) -> QuasiQuoter
expQQ String -> Q Exp
asmTyQE

asmTyQE :: String -> Q Exp
asmTyQE :: String -> Q Exp
asmTyQE String
str = case String -> Either String AsmQQType
parseAsmTyQQ String
str of
                   Left String
err -> forall a. HasCallStack => String -> a
error String
err
                   Right AsmQQType
parsed -> [e| parsed |]

newtype AsmVarName = AsmVarName { AsmVarName -> String
varName :: String } deriving (Int -> AsmVarName -> String -> String
[AsmVarName] -> String -> String
AsmVarName -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AsmVarName] -> String -> String
$cshowList :: [AsmVarName] -> String -> String
show :: AsmVarName -> String
$cshow :: AsmVarName -> String
showsPrec :: Int -> AsmVarName -> String -> String
$cshowsPrec :: Int -> AsmVarName -> String -> String
Show, AsmVarName -> AsmVarName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AsmVarName -> AsmVarName -> Bool
$c/= :: AsmVarName -> AsmVarName -> Bool
== :: AsmVarName -> AsmVarName -> Bool
$c== :: AsmVarName -> AsmVarName -> Bool
Eq, Eq AsmVarName
AsmVarName -> AsmVarName -> Bool
AsmVarName -> AsmVarName -> Ordering
AsmVarName -> AsmVarName -> AsmVarName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AsmVarName -> AsmVarName -> AsmVarName
$cmin :: AsmVarName -> AsmVarName -> AsmVarName
max :: AsmVarName -> AsmVarName -> AsmVarName
$cmax :: AsmVarName -> AsmVarName -> AsmVarName
>= :: AsmVarName -> AsmVarName -> Bool
$c>= :: AsmVarName -> AsmVarName -> Bool
> :: AsmVarName -> AsmVarName -> Bool
$c> :: AsmVarName -> AsmVarName -> Bool
<= :: AsmVarName -> AsmVarName -> Bool
$c<= :: AsmVarName -> AsmVarName -> Bool
< :: AsmVarName -> AsmVarName -> Bool
$c< :: AsmVarName -> AsmVarName -> Bool
compare :: AsmVarName -> AsmVarName -> Ordering
$ccompare :: AsmVarName -> AsmVarName -> Ordering
Ord, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => AsmVarName -> m Exp
forall (m :: * -> *). Quote m => AsmVarName -> Code m AsmVarName
liftTyped :: forall (m :: * -> *). Quote m => AsmVarName -> Code m AsmVarName
$cliftTyped :: forall (m :: * -> *). Quote m => AsmVarName -> Code m AsmVarName
lift :: forall (m :: * -> *). Quote m => AsmVarName -> m Exp
$clift :: forall (m :: * -> *). Quote m => AsmVarName -> m Exp
Lift, NonEmpty AsmVarName -> AsmVarName
AsmVarName -> AsmVarName -> AsmVarName
forall b. Integral b => b -> AsmVarName -> AsmVarName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> AsmVarName -> AsmVarName
$cstimes :: forall b. Integral b => b -> AsmVarName -> AsmVarName
sconcat :: NonEmpty AsmVarName -> AsmVarName
$csconcat :: NonEmpty AsmVarName -> AsmVarName
<> :: AsmVarName -> AsmVarName -> AsmVarName
$c<> :: AsmVarName -> AsmVarName -> AsmVarName
Semigroup, String -> AsmVarName
forall a. (String -> a) -> IsString a
fromString :: String -> AsmVarName
$cfromString :: String -> AsmVarName
IsString)
newtype AsmVarType = AsmVarType { AsmVarType -> String
varType :: String } deriving (Int -> AsmVarType -> String -> String
[AsmVarType] -> String -> String
AsmVarType -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AsmVarType] -> String -> String
$cshowList :: [AsmVarType] -> String -> String
show :: AsmVarType -> String
$cshow :: AsmVarType -> String
showsPrec :: Int -> AsmVarType -> String -> String
$cshowsPrec :: Int -> AsmVarType -> String -> String
Show, AsmVarType -> AsmVarType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AsmVarType -> AsmVarType -> Bool
$c/= :: AsmVarType -> AsmVarType -> Bool
== :: AsmVarType -> AsmVarType -> Bool
$c== :: AsmVarType -> AsmVarType -> Bool
Eq, Eq AsmVarType
AsmVarType -> AsmVarType -> Bool
AsmVarType -> AsmVarType -> Ordering
AsmVarType -> AsmVarType -> AsmVarType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AsmVarType -> AsmVarType -> AsmVarType
$cmin :: AsmVarType -> AsmVarType -> AsmVarType
max :: AsmVarType -> AsmVarType -> AsmVarType
$cmax :: AsmVarType -> AsmVarType -> AsmVarType
>= :: AsmVarType -> AsmVarType -> Bool
$c>= :: AsmVarType -> AsmVarType -> Bool
> :: AsmVarType -> AsmVarType -> Bool
$c> :: AsmVarType -> AsmVarType -> Bool
<= :: AsmVarType -> AsmVarType -> Bool
$c<= :: AsmVarType -> AsmVarType -> Bool
< :: AsmVarType -> AsmVarType -> Bool
$c< :: AsmVarType -> AsmVarType -> Bool
compare :: AsmVarType -> AsmVarType -> Ordering
$ccompare :: AsmVarType -> AsmVarType -> Ordering
Ord, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => AsmVarType -> m Exp
forall (m :: * -> *). Quote m => AsmVarType -> Code m AsmVarType
liftTyped :: forall (m :: * -> *). Quote m => AsmVarType -> Code m AsmVarType
$cliftTyped :: forall (m :: * -> *). Quote m => AsmVarType -> Code m AsmVarType
lift :: forall (m :: * -> *). Quote m => AsmVarType -> m Exp
$clift :: forall (m :: * -> *). Quote m => AsmVarType -> m Exp
Lift)

data AsmQQType = AsmQQType
 { AsmQQType -> [(AsmVarName, AsmVarType)]
args :: [(AsmVarName, AsmVarType)]
 , AsmQQType -> [(AsmVarName, AsmVarType)]
rets :: [(AsmVarName, AsmVarType)]
 } deriving (Int -> AsmQQType -> String -> String
[AsmQQType] -> String -> String
AsmQQType -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AsmQQType] -> String -> String
$cshowList :: [AsmQQType] -> String -> String
show :: AsmQQType -> String
$cshow :: AsmQQType -> String
showsPrec :: Int -> AsmQQType -> String -> String
$cshowsPrec :: Int -> AsmQQType -> String -> String
Show, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => AsmQQType -> m Exp
forall (m :: * -> *). Quote m => AsmQQType -> Code m AsmQQType
liftTyped :: forall (m :: * -> *). Quote m => AsmQQType -> Code m AsmQQType
$cliftTyped :: forall (m :: * -> *). Quote m => AsmQQType -> Code m AsmQQType
lift :: forall (m :: * -> *). Quote m => AsmQQType -> m Exp
$clift :: forall (m :: * -> *). Quote m => AsmQQType -> m Exp
Lift)

parseAsmTyQQ :: String -> Either String AsmQQType
parseAsmTyQQ :: String -> Either String AsmQQType
parseAsmTyQQ String
str = do
  (String
inputStr, String
outputStr) <- String -> Either String (String, String)
findSplitter String
str
  [(AsmVarName, AsmVarType)]
args <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle String Void -> String
showParseError forall a b. (a -> b) -> a -> b
$ forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (forall (m :: * -> *) e.
MonadParsec e String m =>
m [(AsmVarName, AsmVarType)]
parseInTypes forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" String
inputStr
  [(AsmVarName, AsmVarType)]
rets <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle String Void -> String
showParseError forall a b. (a -> b) -> a -> b
$ forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (forall (m :: * -> *) e.
MonadParsec e String m =>
m [(AsmVarName, AsmVarType)]
parseInTypes forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" String
outputStr
  forall (f :: * -> *) a. Applicative f => a -> f a
pure AsmQQType { [(AsmVarName, AsmVarType)]
rets :: [(AsmVarName, AsmVarType)]
args :: [(AsmVarName, AsmVarType)]
rets :: [(AsmVarName, AsmVarType)]
args :: [(AsmVarName, AsmVarType)]
.. }

showParseError :: ParseErrorBundle String Void -> String
showParseError :: ParseErrorBundle String Void -> String
showParseError = forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty

parseInTypes :: forall m e. MonadParsec e String m => m [(AsmVarName, AsmVarType)]
parseInTypes :: forall (m :: * -> *) e.
MonadParsec e String m =>
m [(AsmVarName, AsmVarType)]
parseInTypes = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (AsmVarName, AsmVarType)
parseType
  where
    parseType :: m (AsmVarName, AsmVarType)
parseType = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {a}. m a -> m a
lexeme forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"("
      String
name <- forall {a}. m a -> m a
lexeme forall a b. (a -> b) -> a -> b
$ m Char -> m String
parseWFirst forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"_"
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {a}. m a -> m a
lexeme forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
":"
      String
ty <- forall {a}. m a -> m a
lexeme forall a b. (a -> b) -> a -> b
$ m Char -> m String
parseWFirst forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/= Char
')')
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {a}. m a -> m a
lexeme forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
")"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> AsmVarName
AsmVarName String
name, String -> AsmVarType
AsmVarType String
ty)

    parseWFirst :: m Char -> m String
    parseWFirst :: m Char -> m String
parseWFirst m Char
p = do
      Char
firstLetter <- m Char
p
      String
rest <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (forall a. a -> Maybe a
Just String
"variable") Char -> Bool
isAlphaNum
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Char
firstLetter forall a. a -> [a] -> [a]
: String
rest

    lexeme :: m a -> m a
lexeme = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
ML.lexeme forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
ML.space forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Alternative f => f a
empty

unreflectTy :: AsmQQType -> Q Type
unreflectTy :: AsmQQType -> Q Type
unreflectTy AsmQQType { [(AsmVarName, AsmVarType)]
rets :: [(AsmVarName, AsmVarType)]
args :: [(AsmVarName, AsmVarType)]
rets :: AsmQQType -> [(AsmVarName, AsmVarType)]
args :: AsmQQType -> [(AsmVarName, AsmVarType)]
.. } = do
  Type
retTy <- [(AsmVarName, AsmVarType)] -> Q Type
unreflectRetTy [(AsmVarName, AsmVarType)]
rets
  Either String [Name]
maybeArgTyNames <- [(AsmVarName, AsmVarType)] -> Q (Either String [Name])
lookupTyNames [(AsmVarName, AsmVarType)]
args
  case Either String [Name]
maybeArgTyNames of
       Left String
err -> forall a. HasCallStack => String -> a
error String
err
       Right [Name]
argTyNames -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM forall {m :: * -> *}. Quote m => Name -> Type -> m Type
argFolder Type
retTy [Name]
argTyNames
  where
    argFolder :: Name -> Type -> m Type
argFolder Name
argName Type
funAcc | Name
argName forall a. Eq a => a -> a -> Bool
== ''Ptr = [t| Ptr () -> $(pure funAcc) |]
                             | Bool
otherwise = [t| $(pure $ ConT argName) -> $(pure funAcc) |]

unreflectRetTy :: [(AsmVarName, AsmVarType)] -> Q Type
unreflectRetTy :: [(AsmVarName, AsmVarType)] -> Q Type
unreflectRetTy [] = [t| () |]
unreflectRetTy [(AsmVarName, AsmVarType)]
rets = do
  Either String [Name]
maybeRetTyNames <- [(AsmVarName, AsmVarType)] -> Q (Either String [Name])
lookupTyNames [(AsmVarName, AsmVarType)]
rets
  case Either String [Name]
maybeRetTyNames of
       Left String
err -> forall a. HasCallStack => String -> a
error String
err
       Right [Name
tyName] -> if Name
tyName forall a. Eq a => a -> a -> Bool
== ''Ptr
                           then [t| Ptr () |]
                           else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Name -> Type
ConT Name
tyName
       Right [Name]
retNames -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Name -> Type
retFolder (Int -> Type
TupleT forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
retNames) [Name]
retNames
  where
    retFolder :: Type -> Name -> Type
retFolder Type
tupAcc Name
ret | Name
ret forall a. Eq a => a -> a -> Bool
== ''Ptr = Type
tupAcc Type -> Type -> Type
`AppT` (Name -> Type
ConT Name
ret Type -> Type -> Type
`AppT` Int -> Type
TupleT Int
0)
                         | Bool
otherwise = Type
tupAcc Type -> Type -> Type
`AppT` Name -> Type
ConT Name
ret

lookupTyNames :: [(AsmVarName, AsmVarType)] -> Q (Either String [Name])
lookupTyNames :: [(AsmVarName, AsmVarType)] -> Q (Either String [Name])
lookupTyNames = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {a}. Show a => (a, AsmVarType) -> Q (Either String Name)
f
  where
    f :: (a, AsmVarType) -> Q (Either String Name)
f (a
name, AsmVarType
ty) = forall b a. b -> Maybe a -> Either b a
maybeToRight (String
"Unable to lookup type " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show AsmVarType
ty forall a. Semigroup a => a -> a -> a
<> String
" for var " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
name) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q (Maybe Name)
lookupTypeName (AsmVarType -> String
varType AsmVarType
ty)