{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE StrictData #-}
module Text.LLVM.Triple.Parse.ARM
( ArchName(..)
, EndianKind(..)
, parseEndianKind
, ISAKind(..)
, parseISAKind
, getCanonicalArchName
, parseARMArch
, ARMArch(..)
, armArchName
, parseArch
) where
import qualified Data.Char as Char
import Control.Monad (liftM2, when)
import qualified MonadLib as M
import qualified MonadLib.Monads as M
import qualified Data.List as List
import Text.LLVM.Triple.AST
import qualified Text.LLVM.Triple.Parse.LookupTable as Lookup
newtype ArchName = ArchName { ArchName -> String
getArchName :: String }
data EndianKind
= Little
| Big
deriving (EndianKind
EndianKind -> EndianKind -> Bounded EndianKind
forall a. a -> a -> Bounded a
$cminBound :: EndianKind
minBound :: EndianKind
$cmaxBound :: EndianKind
maxBound :: EndianKind
Bounded, Int -> EndianKind
EndianKind -> Int
EndianKind -> [EndianKind]
EndianKind -> EndianKind
EndianKind -> EndianKind -> [EndianKind]
EndianKind -> EndianKind -> EndianKind -> [EndianKind]
(EndianKind -> EndianKind)
-> (EndianKind -> EndianKind)
-> (Int -> EndianKind)
-> (EndianKind -> Int)
-> (EndianKind -> [EndianKind])
-> (EndianKind -> EndianKind -> [EndianKind])
-> (EndianKind -> EndianKind -> [EndianKind])
-> (EndianKind -> EndianKind -> EndianKind -> [EndianKind])
-> Enum EndianKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: EndianKind -> EndianKind
succ :: EndianKind -> EndianKind
$cpred :: EndianKind -> EndianKind
pred :: EndianKind -> EndianKind
$ctoEnum :: Int -> EndianKind
toEnum :: Int -> EndianKind
$cfromEnum :: EndianKind -> Int
fromEnum :: EndianKind -> Int
$cenumFrom :: EndianKind -> [EndianKind]
enumFrom :: EndianKind -> [EndianKind]
$cenumFromThen :: EndianKind -> EndianKind -> [EndianKind]
enumFromThen :: EndianKind -> EndianKind -> [EndianKind]
$cenumFromTo :: EndianKind -> EndianKind -> [EndianKind]
enumFromTo :: EndianKind -> EndianKind -> [EndianKind]
$cenumFromThenTo :: EndianKind -> EndianKind -> EndianKind -> [EndianKind]
enumFromThenTo :: EndianKind -> EndianKind -> EndianKind -> [EndianKind]
Enum, EndianKind -> EndianKind -> Bool
(EndianKind -> EndianKind -> Bool)
-> (EndianKind -> EndianKind -> Bool) -> Eq EndianKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EndianKind -> EndianKind -> Bool
== :: EndianKind -> EndianKind -> Bool
$c/= :: EndianKind -> EndianKind -> Bool
/= :: EndianKind -> EndianKind -> Bool
Eq, Eq EndianKind
Eq EndianKind =>
(EndianKind -> EndianKind -> Ordering)
-> (EndianKind -> EndianKind -> Bool)
-> (EndianKind -> EndianKind -> Bool)
-> (EndianKind -> EndianKind -> Bool)
-> (EndianKind -> EndianKind -> Bool)
-> (EndianKind -> EndianKind -> EndianKind)
-> (EndianKind -> EndianKind -> EndianKind)
-> Ord EndianKind
EndianKind -> EndianKind -> Bool
EndianKind -> EndianKind -> Ordering
EndianKind -> EndianKind -> EndianKind
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
$ccompare :: EndianKind -> EndianKind -> Ordering
compare :: EndianKind -> EndianKind -> Ordering
$c< :: EndianKind -> EndianKind -> Bool
< :: EndianKind -> EndianKind -> Bool
$c<= :: EndianKind -> EndianKind -> Bool
<= :: EndianKind -> EndianKind -> Bool
$c> :: EndianKind -> EndianKind -> Bool
> :: EndianKind -> EndianKind -> Bool
$c>= :: EndianKind -> EndianKind -> Bool
>= :: EndianKind -> EndianKind -> Bool
$cmax :: EndianKind -> EndianKind -> EndianKind
max :: EndianKind -> EndianKind -> EndianKind
$cmin :: EndianKind -> EndianKind -> EndianKind
min :: EndianKind -> EndianKind -> EndianKind
Ord)
parseEndianKind :: ArchName -> Maybe EndianKind
parseEndianKind :: ArchName -> Maybe EndianKind
parseEndianKind (ArchName String
arch) =
if | String -> Bool
hasPfx String
"armeb" Bool -> Bool -> Bool
|| String -> Bool
hasPfx String
"thumbeb" Bool -> Bool -> Bool
|| String -> Bool
hasPfx String
"aarch64_be" -> EndianKind -> Maybe EndianKind
forall a. a -> Maybe a
Just EndianKind
Big
| String -> Bool
hasPfx String
"arm" Bool -> Bool -> Bool
|| String -> Bool
hasPfx String
"thumb" ->
if String -> Bool
hasSfx String
"eb"
then EndianKind -> Maybe EndianKind
forall a. a -> Maybe a
Just EndianKind
Big
else EndianKind -> Maybe EndianKind
forall a. a -> Maybe a
Just EndianKind
Little
| String -> Bool
hasPfx String
"aarch64" Bool -> Bool -> Bool
|| String -> Bool
hasPfx String
"aarch64_32" -> EndianKind -> Maybe EndianKind
forall a. a -> Maybe a
Just EndianKind
Little
| Bool
otherwise -> Maybe EndianKind
forall a. Maybe a
Nothing
where
hasPfx :: String -> Bool
hasPfx = (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` String
arch)
hasSfx :: String -> Bool
hasSfx = (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` String
arch)
data ISAKind
= ISAArm
| ISAThumb
| ISAAArch64
deriving (ISAKind
ISAKind -> ISAKind -> Bounded ISAKind
forall a. a -> a -> Bounded a
$cminBound :: ISAKind
minBound :: ISAKind
$cmaxBound :: ISAKind
maxBound :: ISAKind
Bounded, Int -> ISAKind
ISAKind -> Int
ISAKind -> [ISAKind]
ISAKind -> ISAKind
ISAKind -> ISAKind -> [ISAKind]
ISAKind -> ISAKind -> ISAKind -> [ISAKind]
(ISAKind -> ISAKind)
-> (ISAKind -> ISAKind)
-> (Int -> ISAKind)
-> (ISAKind -> Int)
-> (ISAKind -> [ISAKind])
-> (ISAKind -> ISAKind -> [ISAKind])
-> (ISAKind -> ISAKind -> [ISAKind])
-> (ISAKind -> ISAKind -> ISAKind -> [ISAKind])
-> Enum ISAKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ISAKind -> ISAKind
succ :: ISAKind -> ISAKind
$cpred :: ISAKind -> ISAKind
pred :: ISAKind -> ISAKind
$ctoEnum :: Int -> ISAKind
toEnum :: Int -> ISAKind
$cfromEnum :: ISAKind -> Int
fromEnum :: ISAKind -> Int
$cenumFrom :: ISAKind -> [ISAKind]
enumFrom :: ISAKind -> [ISAKind]
$cenumFromThen :: ISAKind -> ISAKind -> [ISAKind]
enumFromThen :: ISAKind -> ISAKind -> [ISAKind]
$cenumFromTo :: ISAKind -> ISAKind -> [ISAKind]
enumFromTo :: ISAKind -> ISAKind -> [ISAKind]
$cenumFromThenTo :: ISAKind -> ISAKind -> ISAKind -> [ISAKind]
enumFromThenTo :: ISAKind -> ISAKind -> ISAKind -> [ISAKind]
Enum, ISAKind -> ISAKind -> Bool
(ISAKind -> ISAKind -> Bool)
-> (ISAKind -> ISAKind -> Bool) -> Eq ISAKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ISAKind -> ISAKind -> Bool
== :: ISAKind -> ISAKind -> Bool
$c/= :: ISAKind -> ISAKind -> Bool
/= :: ISAKind -> ISAKind -> Bool
Eq, Eq ISAKind
Eq ISAKind =>
(ISAKind -> ISAKind -> Ordering)
-> (ISAKind -> ISAKind -> Bool)
-> (ISAKind -> ISAKind -> Bool)
-> (ISAKind -> ISAKind -> Bool)
-> (ISAKind -> ISAKind -> Bool)
-> (ISAKind -> ISAKind -> ISAKind)
-> (ISAKind -> ISAKind -> ISAKind)
-> Ord ISAKind
ISAKind -> ISAKind -> Bool
ISAKind -> ISAKind -> Ordering
ISAKind -> ISAKind -> ISAKind
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
$ccompare :: ISAKind -> ISAKind -> Ordering
compare :: ISAKind -> ISAKind -> Ordering
$c< :: ISAKind -> ISAKind -> Bool
< :: ISAKind -> ISAKind -> Bool
$c<= :: ISAKind -> ISAKind -> Bool
<= :: ISAKind -> ISAKind -> Bool
$c> :: ISAKind -> ISAKind -> Bool
> :: ISAKind -> ISAKind -> Bool
$c>= :: ISAKind -> ISAKind -> Bool
>= :: ISAKind -> ISAKind -> Bool
$cmax :: ISAKind -> ISAKind -> ISAKind
max :: ISAKind -> ISAKind -> ISAKind
$cmin :: ISAKind -> ISAKind -> ISAKind
min :: ISAKind -> ISAKind -> ISAKind
Ord)
parseISAKind :: ArchName -> Maybe ISAKind
parseISAKind :: ArchName -> Maybe ISAKind
parseISAKind (ArchName String
arch) = String -> LookupTable ISAKind -> Maybe ISAKind
forall a. String -> LookupTable a -> Maybe a
Lookup.lookupByPrefix String
arch LookupTable ISAKind
table
where
table :: LookupTable ISAKind
table =
[(String, ISAKind)] -> LookupTable ISAKind
forall a. [(String, a)] -> LookupTable a
Lookup.makeTable
[ (String
"aarch64", ISAKind
ISAAArch64)
, (String
"arm64", ISAKind
ISAAArch64)
, (String
"thumb", ISAKind
ISAThumb)
, (String
"arm", ISAKind
ISAArm)
]
getArchSynonym :: ArchName -> ArchName
getArchSynonym :: ArchName -> ArchName
getArchSynonym (ArchName String
arch) =
String -> ArchName
ArchName (String -> ArchName) -> String -> ArchName
forall a b. (a -> b) -> a -> b
$
if | [String] -> Bool
cases [String
"v5"] -> String
"v5t"
| [String] -> Bool
cases [String
"v5e"] -> String
"v5te"
| [String] -> Bool
cases [String
"v6j"] -> String
"v6"
| [String] -> Bool
cases [String
"v6hl"] -> String
"v6k"
| [String] -> Bool
cases [String
"v6m", String
"v6sm", String
"v6s-m"] -> String
"v6-m"
| [String] -> Bool
cases [String
"v6z", String
"v6zk"] -> String
"v6kz"
| [String] -> Bool
cases [String
"v7", String
"v7a", String
"v7hl", String
"v7l"] -> String
"v7-a"
| [String] -> Bool
cases [String
"v7r"] -> String
"v7-r"
| [String] -> Bool
cases [String
"v7m"] -> String
"v7-m"
| [String] -> Bool
cases [String
"v7em"] -> String
"v7e-m"
| [String] -> Bool
cases [String
"v8", String
"v8a", String
"v8l", String
"aarch64", String
"arm64"] -> String
"v8-a"
| [String] -> Bool
cases [String
"v8.1a"] -> String
"v8.1-a"
| [String] -> Bool
cases [String
"v8.2a"] -> String
"v8.2-a"
| [String] -> Bool
cases [String
"v8.3a"] -> String
"v8.3-a"
| [String] -> Bool
cases [String
"v8.4a"] -> String
"v8.4-a"
| [String] -> Bool
cases [String
"v8.5a"] -> String
"v8.5-a"
| [String] -> Bool
cases [String
"v8.6a"] -> String
"v8.6-a"
| [String] -> Bool
cases [String
"v8.7a"] -> String
"v8.7-a"
| [String] -> Bool
cases [String
"v8.8a"] -> String
"v8.8-a"
| [String] -> Bool
cases [String
"v8r"] -> String
"v8-r"
| [String] -> Bool
cases [String
"v9", String
"v9a"] -> String
"v9-a"
| [String] -> Bool
cases [String
"v9.1a"] -> String
"v9.1-a"
| [String] -> Bool
cases [String
"v9.2a"] -> String
"v9.2-a"
| [String] -> Bool
cases [String
"v9.3a"] -> String
"v9.3-a"
| [String] -> Bool
cases [String
"v8m.base"] -> String
"v8-m.base"
| [String] -> Bool
cases [String
"v8m.main"] -> String
"v8-m.main"
| [String] -> Bool
cases [String
"v8.1m.main"] -> String
"v8.1-m.main"
| Bool
otherwise -> String
arch
where
cases :: [String] -> Bool
cases = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
arch)
data CanonicalArchNameState
= CanonicalArchNameState
{ CanonicalArchNameState -> Int
offset :: Int
, CanonicalArchNameState -> String
archStr :: String
}
getCanonicalArchName :: ArchName -> Maybe ArchName
getCanonicalArchName :: ArchName -> Maybe ArchName
getCanonicalArchName (ArchName String
arch) =
CanonicalArchNameState
-> State CanonicalArchNameState (Maybe ArchName) -> Maybe ArchName
forall {b} {c}. b -> State b c -> c
execState (Int -> String -> CanonicalArchNameState
CanonicalArchNameState Int
0 String
arch) (State CanonicalArchNameState (Maybe ArchName) -> Maybe ArchName)
-> State CanonicalArchNameState (Maybe ArchName) -> Maybe ArchName
forall a b. (a -> b) -> a -> b
$ do
State CanonicalArchNameState Bool
-> State CanonicalArchNameState (Maybe ArchName)
-> State CanonicalArchNameState (Maybe ArchName)
-> State CanonicalArchNameState (Maybe ArchName)
forall {m :: * -> *} {b}. Monad m => m Bool -> m b -> m b -> m b
ifM ((Bool -> Bool -> Bool)
-> State CanonicalArchNameState Bool
-> State CanonicalArchNameState Bool
-> State CanonicalArchNameState Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(&&) (String -> State CanonicalArchNameState Bool
forall {f :: * -> *}.
StateM f CanonicalArchNameState =>
String -> f Bool
startsWith String
"aarch64") (String -> State CanonicalArchNameState Bool
forall {f :: * -> *}.
StateM f CanonicalArchNameState =>
String -> f Bool
contains String
"eb")) (Maybe ArchName -> State CanonicalArchNameState (Maybe ArchName)
forall a. a -> State CanonicalArchNameState a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ArchName
forall a. Maybe a
Nothing) (State CanonicalArchNameState (Maybe ArchName)
-> State CanonicalArchNameState (Maybe ArchName))
-> State CanonicalArchNameState (Maybe ArchName)
-> State CanonicalArchNameState (Maybe ArchName)
forall a b. (a -> b) -> a -> b
$ do
State CanonicalArchNameState Bool
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
whenM (String -> State CanonicalArchNameState Bool
forall {f :: * -> *}.
StateM f CanonicalArchNameState =>
String -> f Bool
startsWith String
"arm64_32") (State CanonicalArchNameState ()
-> State CanonicalArchNameState ())
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall a b. (a -> b) -> a -> b
$
Int -> State CanonicalArchNameState ()
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
Int -> m ()
setOffset Int
8
State CanonicalArchNameState Bool
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
whenM (String -> State CanonicalArchNameState Bool
forall {f :: * -> *}.
StateM f CanonicalArchNameState =>
String -> f Bool
startsWith String
"arm64e") (State CanonicalArchNameState ()
-> State CanonicalArchNameState ())
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall a b. (a -> b) -> a -> b
$
Int -> State CanonicalArchNameState ()
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
Int -> m ()
setOffset Int
6
State CanonicalArchNameState Bool
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
whenM (String -> State CanonicalArchNameState Bool
forall {f :: * -> *}.
StateM f CanonicalArchNameState =>
String -> f Bool
startsWith String
"arm64") (State CanonicalArchNameState ()
-> State CanonicalArchNameState ())
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall a b. (a -> b) -> a -> b
$
Int -> State CanonicalArchNameState ()
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
Int -> m ()
setOffset Int
5
State CanonicalArchNameState Bool
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
whenM (String -> State CanonicalArchNameState Bool
forall {f :: * -> *}.
StateM f CanonicalArchNameState =>
String -> f Bool
startsWith String
"aarch64_32") (State CanonicalArchNameState ()
-> State CanonicalArchNameState ())
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall a b. (a -> b) -> a -> b
$
Int -> State CanonicalArchNameState ()
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
Int -> m ()
setOffset Int
10
State CanonicalArchNameState Bool
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
whenM (String -> State CanonicalArchNameState Bool
forall {f :: * -> *}.
StateM f CanonicalArchNameState =>
String -> f Bool
startsWith String
"arm") (State CanonicalArchNameState ()
-> State CanonicalArchNameState ())
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall a b. (a -> b) -> a -> b
$
Int -> State CanonicalArchNameState ()
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
Int -> m ()
setOffset Int
3
State CanonicalArchNameState Bool
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
whenM (String -> State CanonicalArchNameState Bool
forall {f :: * -> *}.
StateM f CanonicalArchNameState =>
String -> f Bool
startsWith String
"thumb") (State CanonicalArchNameState ()
-> State CanonicalArchNameState ())
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall a b. (a -> b) -> a -> b
$
Int -> State CanonicalArchNameState ()
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
Int -> m ()
setOffset Int
5
State CanonicalArchNameState Bool
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
whenM (String -> State CanonicalArchNameState Bool
forall {f :: * -> *}.
StateM f CanonicalArchNameState =>
String -> f Bool
startsWith String
"aarch64") (State CanonicalArchNameState ()
-> State CanonicalArchNameState ())
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall a b. (a -> b) -> a -> b
$ do
Int -> State CanonicalArchNameState ()
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
Int -> m ()
setOffset Int
7
State CanonicalArchNameState Bool
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
whenM ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"_be") (String -> Bool)
-> State CanonicalArchNameState String
-> State CanonicalArchNameState Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> State CanonicalArchNameState String
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
Int -> m String
archOffSubstr Int
3) (State CanonicalArchNameState ()
-> State CanonicalArchNameState ())
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall a b. (a -> b) -> a -> b
$
Int -> State CanonicalArchNameState ()
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
Int -> m ()
addOffset Int
3
Int
off <- CanonicalArchNameState -> Int
offset (CanonicalArchNameState -> Int)
-> State CanonicalArchNameState CanonicalArchNameState
-> State CanonicalArchNameState Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State CanonicalArchNameState CanonicalArchNameState
forall (m :: * -> *) i. StateM m i => m i
M.get
String
sub <- Int -> State CanonicalArchNameState String
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
Int -> m String
archOffSubstr Int
2
Bool
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
npos Bool -> Bool -> Bool
&& String
sub String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"eb") (State CanonicalArchNameState ()
-> State CanonicalArchNameState ())
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall a b. (a -> b) -> a -> b
$
Int -> State CanonicalArchNameState ()
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
Int -> m ()
addOffset Int
2
State CanonicalArchNameState Bool
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
whenM (String -> State CanonicalArchNameState Bool
forall {f :: * -> *}.
StateM f CanonicalArchNameState =>
String -> f Bool
endsWith String
"eb") (State CanonicalArchNameState ()
-> State CanonicalArchNameState ())
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall a b. (a -> b) -> a -> b
$ do
(String -> String) -> State CanonicalArchNameState ()
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
(String -> String) -> m ()
changeArch (\String
arch' -> Int -> Int -> String -> String
forall {a}. Int -> Int -> [a] -> [a]
substr Int
0 (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
arch' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
arch')
Int
off' <- CanonicalArchNameState -> Int
offset (CanonicalArchNameState -> Int)
-> State CanonicalArchNameState CanonicalArchNameState
-> State CanonicalArchNameState Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State CanonicalArchNameState CanonicalArchNameState
forall (m :: * -> *) i. StateM m i => m i
M.get
Bool
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
off' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
npos) (State CanonicalArchNameState ()
-> State CanonicalArchNameState ())
-> State CanonicalArchNameState ()
-> State CanonicalArchNameState ()
forall a b. (a -> b) -> a -> b
$
(String -> String) -> State CanonicalArchNameState ()
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
(String -> String) -> m ()
changeArch (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
off')
String
arch' <- CanonicalArchNameState -> String
archStr (CanonicalArchNameState -> String)
-> State CanonicalArchNameState CanonicalArchNameState
-> State CanonicalArchNameState String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State CanonicalArchNameState CanonicalArchNameState
forall (m :: * -> *) i. StateM m i => m i
M.get
if | String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
arch' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Maybe ArchName -> State CanonicalArchNameState (Maybe ArchName)
forall a. a -> State CanonicalArchNameState a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ArchName
forall a. Maybe a
Nothing
| Int
off' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
npos Bool -> Bool -> Bool
&& String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
arch' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 Bool -> Bool -> Bool
&&
(Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
arch' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"v" Bool -> Bool -> Bool
|| Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
Char.isDigit (Int -> Int -> String -> String
forall {a}. Int -> Int -> [a] -> [a]
substr Int
1 Int
1 String
arch'))) ->
Maybe ArchName -> State CanonicalArchNameState (Maybe ArchName)
forall a. a -> State CanonicalArchNameState a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ArchName
forall a. Maybe a
Nothing
| Int
off' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
npos Bool -> Bool -> Bool
&& String
"eb" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isInfixOf` String
arch' -> Maybe ArchName -> State CanonicalArchNameState (Maybe ArchName)
forall a. a -> State CanonicalArchNameState a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ArchName
forall a. Maybe a
Nothing
| Bool
otherwise -> Maybe ArchName -> State CanonicalArchNameState (Maybe ArchName)
forall a. a -> State CanonicalArchNameState a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArchName -> Maybe ArchName
forall a. a -> Maybe a
Just (String -> ArchName
ArchName String
arch'))
where
npos :: Int
npos = Int
0
ifM :: m Bool -> m b -> m b -> m b
ifM m Bool
b m b
thn m b
els = m Bool
b m Bool -> (Bool -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b' -> if Bool
b' then m b
thn else m b
els
whenM :: m Bool -> m () -> m ()
whenM m Bool
b m ()
k = m Bool -> m () -> m () -> m ()
forall {m :: * -> *} {b}. Monad m => m Bool -> m b -> m b -> m b
ifM m Bool
b m ()
k (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
startsWith :: String -> f Bool
startsWith String
pfx = (String
pfx String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf`) (String -> Bool)
-> (CanonicalArchNameState -> String)
-> CanonicalArchNameState
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanonicalArchNameState -> String
archStr (CanonicalArchNameState -> Bool)
-> f CanonicalArchNameState -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f CanonicalArchNameState
forall (m :: * -> *) i. StateM m i => m i
M.get
endsWith :: String -> f Bool
endsWith String
sfx = (String
sfx String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf`) (String -> Bool)
-> (CanonicalArchNameState -> String)
-> CanonicalArchNameState
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanonicalArchNameState -> String
archStr (CanonicalArchNameState -> Bool)
-> f CanonicalArchNameState -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f CanonicalArchNameState
forall (m :: * -> *) i. StateM m i => m i
M.get
contains :: String -> f Bool
contains String
ifx = (String
ifx String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isInfixOf`) (String -> Bool)
-> (CanonicalArchNameState -> String)
-> CanonicalArchNameState
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanonicalArchNameState -> String
archStr (CanonicalArchNameState -> Bool)
-> f CanonicalArchNameState -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f CanonicalArchNameState
forall (m :: * -> *) i. StateM m i => m i
M.get
substr :: Int -> Int -> [a] -> [a]
substr Int
start Int
sz = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
sz ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
start
archSubstr :: Int -> Int -> f String
archSubstr Int
begin Int
sz = Int -> Int -> String -> String
forall {a}. Int -> Int -> [a] -> [a]
substr Int
begin Int
sz (String -> String)
-> (CanonicalArchNameState -> String)
-> CanonicalArchNameState
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanonicalArchNameState -> String
archStr (CanonicalArchNameState -> String)
-> f CanonicalArchNameState -> f String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f CanonicalArchNameState
forall (m :: * -> *) i. StateM m i => m i
M.get
archOffSubstr :: Int -> m String
archOffSubstr Int
sz = do
Int
off <- CanonicalArchNameState -> Int
offset (CanonicalArchNameState -> Int)
-> m CanonicalArchNameState -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m CanonicalArchNameState
forall (m :: * -> *) i. StateM m i => m i
M.get
Int -> Int -> m String
forall {f :: * -> *}.
StateM f CanonicalArchNameState =>
Int -> Int -> f String
archSubstr Int
off Int
sz
changeOffset :: (Int -> Int) -> m ()
changeOffset Int -> Int
f = do
CanonicalArchNameState
s <- m CanonicalArchNameState
forall (m :: * -> *) i. StateM m i => m i
M.get
CanonicalArchNameState -> m ()
forall (m :: * -> *) i. StateM m i => i -> m ()
M.set (CanonicalArchNameState
s { offset = f (offset s) })
addOffset :: Int -> m ()
addOffset Int
n = (Int -> Int) -> m ()
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
(Int -> Int) -> m ()
changeOffset (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+)
setOffset :: Int -> m ()
setOffset Int
n = (Int -> Int) -> m ()
forall {m :: * -> *}.
StateM m CanonicalArchNameState =>
(Int -> Int) -> m ()
changeOffset (Int -> Int -> Int
forall a b. a -> b -> a
const Int
n)
changeArch :: (String -> String) -> m ()
changeArch String -> String
f = CanonicalArchNameState -> m ()
forall (m :: * -> *) i. StateM m i => i -> m ()
M.set (CanonicalArchNameState -> m ())
-> (CanonicalArchNameState -> CanonicalArchNameState)
-> CanonicalArchNameState
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\CanonicalArchNameState
s -> CanonicalArchNameState
s { archStr = f (archStr s) }) (CanonicalArchNameState -> m ())
-> m CanonicalArchNameState -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m CanonicalArchNameState
forall (m :: * -> *) i. StateM m i => m i
M.get
execState :: b -> State b c -> c
execState b
s = (c, b) -> c
forall a b. (a, b) -> a
fst ((c, b) -> c) -> (State b c -> (c, b)) -> State b c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> State b c -> (c, b)
forall i a. i -> State i a -> (a, i)
M.runState b
s
parseARMArch :: ArchName -> Arch
parseARMArch :: ArchName -> Arch
parseARMArch ArchName
archName =
let
isa :: Maybe ISAKind
isa = ArchName -> Maybe ISAKind
parseISAKind ArchName
archName
endian :: Maybe EndianKind
endian = ArchName -> Maybe EndianKind
parseEndianKind ArchName
archName
arch :: Arch
arch =
case Maybe EndianKind
endian of
Just EndianKind
Little ->
case Maybe ISAKind
isa of
Just ISAKind
ISAArm -> Arch
ARM
Just ISAKind
ISAThumb -> Arch
Thumb
Just ISAKind
ISAAArch64 -> Arch
AArch64
Maybe ISAKind
Nothing -> Arch
UnknownArch
Just EndianKind
Big ->
case Maybe ISAKind
isa of
Just ISAKind
ISAArm -> Arch
ARMEB
Just ISAKind
ISAThumb -> Arch
ThumbEB
Just ISAKind
ISAAArch64 -> Arch
AArch64_BE
Maybe ISAKind
Nothing -> Arch
UnknownArch
Maybe EndianKind
Nothing -> Arch
UnknownArch
mArchName :: Maybe ArchName
mArchName = ArchName -> Maybe ArchName
getCanonicalArchName ArchName
archName
in case Maybe ArchName
mArchName of
Maybe ArchName
Nothing -> Arch
UnknownArch
Just (ArchName String
archNm) ->
if | Maybe ISAKind
isa Maybe ISAKind -> Maybe ISAKind -> Bool
forall a. Eq a => a -> a -> Bool
== ISAKind -> Maybe ISAKind
forall a. a -> Maybe a
Just ISAKind
ISAThumb Bool -> Bool -> Bool
&&
(String
"v2" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` String
archNm Bool -> Bool -> Bool
|| String
"v3" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` String
archNm) -> Arch
UnknownArch
| Bool
otherwise -> Arch
arch
data ARMArch
= ARMArchInvalid
| ARMV2
| ARMV2A
| ARMV3
| ARMV3M
| ARMV4
| ARMV4T
| ARMV5T
| ARMV5TE
| ARMV5TEJ
| ARMV6
| ARMV6K
| ARMV6T2
| ARMV6KZ
| ARMV6M
| ARMV7A
| ARMV7VE
| ARMV7R
| ARMV7M
| ARMV7EM
| ARMV8A
| ARMV8_1A
| ARMV8_2A
| ARMV8_3A
| ARMV8_4A
| ARMV8_5A
| ARMV8_6A
| ARMV8_7A
| ARMV8_8A
| ARMV9A
| ARMV9_1A
| ARMV9_2A
| ARMV9_3A
| ARMV8R
| ARMV8MBaseline
| ARMV8MMainline
| ARMV8_1MMainline
| IWMMXT
| IWMMXT2
| XSCALE
| ARMV7S
| ARMV7K
deriving (ARMArch
ARMArch -> ARMArch -> Bounded ARMArch
forall a. a -> a -> Bounded a
$cminBound :: ARMArch
minBound :: ARMArch
$cmaxBound :: ARMArch
maxBound :: ARMArch
Bounded, Int -> ARMArch
ARMArch -> Int
ARMArch -> [ARMArch]
ARMArch -> ARMArch
ARMArch -> ARMArch -> [ARMArch]
ARMArch -> ARMArch -> ARMArch -> [ARMArch]
(ARMArch -> ARMArch)
-> (ARMArch -> ARMArch)
-> (Int -> ARMArch)
-> (ARMArch -> Int)
-> (ARMArch -> [ARMArch])
-> (ARMArch -> ARMArch -> [ARMArch])
-> (ARMArch -> ARMArch -> [ARMArch])
-> (ARMArch -> ARMArch -> ARMArch -> [ARMArch])
-> Enum ARMArch
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ARMArch -> ARMArch
succ :: ARMArch -> ARMArch
$cpred :: ARMArch -> ARMArch
pred :: ARMArch -> ARMArch
$ctoEnum :: Int -> ARMArch
toEnum :: Int -> ARMArch
$cfromEnum :: ARMArch -> Int
fromEnum :: ARMArch -> Int
$cenumFrom :: ARMArch -> [ARMArch]
enumFrom :: ARMArch -> [ARMArch]
$cenumFromThen :: ARMArch -> ARMArch -> [ARMArch]
enumFromThen :: ARMArch -> ARMArch -> [ARMArch]
$cenumFromTo :: ARMArch -> ARMArch -> [ARMArch]
enumFromTo :: ARMArch -> ARMArch -> [ARMArch]
$cenumFromThenTo :: ARMArch -> ARMArch -> ARMArch -> [ARMArch]
enumFromThenTo :: ARMArch -> ARMArch -> ARMArch -> [ARMArch]
Enum, ARMArch -> ARMArch -> Bool
(ARMArch -> ARMArch -> Bool)
-> (ARMArch -> ARMArch -> Bool) -> Eq ARMArch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ARMArch -> ARMArch -> Bool
== :: ARMArch -> ARMArch -> Bool
$c/= :: ARMArch -> ARMArch -> Bool
/= :: ARMArch -> ARMArch -> Bool
Eq, Eq ARMArch
Eq ARMArch =>
(ARMArch -> ARMArch -> Ordering)
-> (ARMArch -> ARMArch -> Bool)
-> (ARMArch -> ARMArch -> Bool)
-> (ARMArch -> ARMArch -> Bool)
-> (ARMArch -> ARMArch -> Bool)
-> (ARMArch -> ARMArch -> ARMArch)
-> (ARMArch -> ARMArch -> ARMArch)
-> Ord ARMArch
ARMArch -> ARMArch -> Bool
ARMArch -> ARMArch -> Ordering
ARMArch -> ARMArch -> ARMArch
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
$ccompare :: ARMArch -> ARMArch -> Ordering
compare :: ARMArch -> ARMArch -> Ordering
$c< :: ARMArch -> ARMArch -> Bool
< :: ARMArch -> ARMArch -> Bool
$c<= :: ARMArch -> ARMArch -> Bool
<= :: ARMArch -> ARMArch -> Bool
$c> :: ARMArch -> ARMArch -> Bool
> :: ARMArch -> ARMArch -> Bool
$c>= :: ARMArch -> ARMArch -> Bool
>= :: ARMArch -> ARMArch -> Bool
$cmax :: ARMArch -> ARMArch -> ARMArch
max :: ARMArch -> ARMArch -> ARMArch
$cmin :: ARMArch -> ARMArch -> ARMArch
min :: ARMArch -> ARMArch -> ARMArch
Ord)
armArchName :: ARMArch -> String
armArchName :: ARMArch -> String
armArchName =
\case
ARMArch
ARMArchInvalid -> String
"invalid"
ARMArch
ARMV2 -> String
"armv2"
ARMArch
ARMV2A -> String
"armv2a"
ARMArch
ARMV3 -> String
"armv3"
ARMArch
ARMV3M -> String
"armv3m"
ARMArch
ARMV4 -> String
"armv4"
ARMArch
ARMV4T -> String
"armv4t"
ARMArch
ARMV5T -> String
"armv5t"
ARMArch
ARMV5TE -> String
"armv5te"
ARMArch
ARMV5TEJ -> String
"armv5tej"
ARMArch
ARMV6 -> String
"armv6"
ARMArch
ARMV6K -> String
"armv6k"
ARMArch
ARMV6T2 -> String
"armv6t2"
ARMArch
ARMV6KZ -> String
"armv6kz"
ARMArch
ARMV6M -> String
"armv6-m"
ARMArch
ARMV7A -> String
"armv7-a"
ARMArch
ARMV7VE -> String
"armv7ve"
ARMArch
ARMV7R -> String
"armv7-r"
ARMArch
ARMV7M -> String
"armv7-m"
ARMArch
ARMV7EM -> String
"armv7e-m"
ARMArch
ARMV8A -> String
"armv8-a"
ARMArch
ARMV8_1A -> String
"armv8.1-a"
ARMArch
ARMV8_2A -> String
"armv8.2-a"
ARMArch
ARMV8_3A -> String
"armv8.3-a"
ARMArch
ARMV8_4A -> String
"armv8.4-a"
ARMArch
ARMV8_5A -> String
"armv8.5-a"
ARMArch
ARMV8_6A -> String
"armv8.6-a"
ARMArch
ARMV8_7A -> String
"armv8.7-a"
ARMArch
ARMV8_8A -> String
"armv8.8-a"
ARMArch
ARMV9A -> String
"armv9-a"
ARMArch
ARMV9_1A -> String
"armv9.1-a"
ARMArch
ARMV9_2A -> String
"armv9.2-a"
ARMArch
ARMV9_3A -> String
"armv9.3-a"
ARMArch
ARMV8R -> String
"armv8-r"
ARMArch
ARMV8MBaseline -> String
"armv8-m.base"
ARMArch
ARMV8MMainline -> String
"armv8-m.main"
ARMArch
ARMV8_1MMainline -> String
"armv8.1-m.main"
ARMArch
IWMMXT -> String
"iwmmxt"
ARMArch
IWMMXT2 -> String
"iwmmxt2"
ARMArch
XSCALE -> String
"xscale"
ARMArch
ARMV7S -> String
"armv7s"
ARMArch
ARMV7K -> String
"armv7k"
parseArch :: ArchName -> ARMArch
parseArch :: ArchName -> ARMArch
parseArch ArchName
arch =
let ArchName String
syn = ArchName -> ArchName
getArchSynonym ArchName
arch
table :: LookupTable ARMArch
table = (ARMArch -> String) -> LookupTable ARMArch
forall a. (Bounded a, Enum a) => (a -> String) -> LookupTable a
Lookup.enumTable ARMArch -> String
armArchName
in LookupTable ARMArch -> ARMArch -> String -> ARMArch
forall a. LookupTable a -> a -> String -> a
Lookup.lookupBySuffixWithDefault LookupTable ARMArch
table ARMArch
ARMArchInvalid String
syn