{- | Which of the simulated architectures a source file is written for, and how
to guess it when the user did not say.
-}
module Wrench.Isa (
    Isa (..),
    allIsa,
    isaName,
    detectIsa,
    parsesAs,
) where

import Prelude (Read (..))
import Relude
import Text.Megaparsec (parse)
import Wrench.Isa.Acc32 (Acc32Isa)
import Wrench.Isa.F32a (F32aIsa)
import Wrench.Isa.M68k (M68kIsa)
import Wrench.Isa.RiscIv (RiscIvIsa)
import Wrench.Isa.VliwIv (VliwIvIsa)
import Wrench.Isa.Wasm32 (Wasm32Isa)
import Wrench.Isa.Wasm32.LocalNames (resolveLocalNames)
import Wrench.Translator.Parser (asmParser)
import Wrench.Translator.Parser.Types (MnemonicParser)
import Wrench.Translator.Types (Preprocessor, Ref, preprocess)

data Isa
    = Acc32
    | F32a
    | RiscIv
    | M68k
    | VliwIv
    | Wasm32
    deriving (Isa
Isa -> Isa -> Bounded Isa
forall a. a -> a -> Bounded a
$cminBound :: Isa
minBound :: Isa
$cmaxBound :: Isa
maxBound :: Isa
Bounded, Int -> Isa
Isa -> Int
Isa -> [Isa]
Isa -> Isa
Isa -> Isa -> [Isa]
Isa -> Isa -> Isa -> [Isa]
(Isa -> Isa)
-> (Isa -> Isa)
-> (Int -> Isa)
-> (Isa -> Int)
-> (Isa -> [Isa])
-> (Isa -> Isa -> [Isa])
-> (Isa -> Isa -> [Isa])
-> (Isa -> Isa -> Isa -> [Isa])
-> Enum Isa
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 :: Isa -> Isa
succ :: Isa -> Isa
$cpred :: Isa -> Isa
pred :: Isa -> Isa
$ctoEnum :: Int -> Isa
toEnum :: Int -> Isa
$cfromEnum :: Isa -> Int
fromEnum :: Isa -> Int
$cenumFrom :: Isa -> [Isa]
enumFrom :: Isa -> [Isa]
$cenumFromThen :: Isa -> Isa -> [Isa]
enumFromThen :: Isa -> Isa -> [Isa]
$cenumFromTo :: Isa -> Isa -> [Isa]
enumFromTo :: Isa -> Isa -> [Isa]
$cenumFromThenTo :: Isa -> Isa -> Isa -> [Isa]
enumFromThenTo :: Isa -> Isa -> Isa -> [Isa]
Enum, Isa -> Isa -> Bool
(Isa -> Isa -> Bool) -> (Isa -> Isa -> Bool) -> Eq Isa
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Isa -> Isa -> Bool
== :: Isa -> Isa -> Bool
$c/= :: Isa -> Isa -> Bool
/= :: Isa -> Isa -> Bool
Eq, Int -> Isa -> [Char] -> [Char]
[Isa] -> [Char] -> [Char]
Isa -> [Char]
(Int -> Isa -> [Char] -> [Char])
-> (Isa -> [Char]) -> ([Isa] -> [Char] -> [Char]) -> Show Isa
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Isa -> [Char] -> [Char]
showsPrec :: Int -> Isa -> [Char] -> [Char]
$cshow :: Isa -> [Char]
show :: Isa -> [Char]
$cshowList :: [Isa] -> [Char] -> [Char]
showList :: [Isa] -> [Char] -> [Char]
Show)

allIsa :: [Isa]
allIsa :: [Isa]
allIsa = [Isa
forall a. Bounded a => a
minBound .. Isa
forall a. Bounded a => a
maxBound]

-- | The name the @--isa@ option and the example directories use.
isaName :: Isa -> Text
isaName :: Isa -> Text
isaName Isa
Acc32 = Text
"acc32"
isaName Isa
F32a = Text
"f32a"
isaName Isa
RiscIv = Text
"risc-iv-32"
isaName Isa
M68k = Text
"m68k"
isaName Isa
VliwIv = Text
"vliw-iv"
isaName Isa
Wasm32 = Text
"wasm32"

instance Read Isa where
    readsPrec :: Int -> ReadS Isa
readsPrec Int
_ [Char]
"risc-iv" = [(Isa
RiscIv, [Char]
"")] -- historical spelling of risc-iv-32
    readsPrec Int
_ [Char]
s =
        [ (Isa
isa, [Char]
"")
        | Isa
isa <- [Isa]
allIsa
        , Text -> [Char]
forall a. ToString a => a -> [Char]
toString (Isa -> Text
isaName Isa
isa) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
s
        ]

-- * Detection

detectIsa :: Text -> Either Text Isa
detectIsa :: Text -> Either Text Isa
detectIsa Text
src = case (Isa -> Bool) -> [Isa] -> [Isa]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Isa -> Bool
parsesAs Text
src) [Isa]
allIsa of
    [Isa
isa] -> Isa -> Either Text Isa
forall a b. b -> Either a b
Right Isa
isa
    [] -> Text -> Either Text Isa
forall a b. a -> Either a b
Left Text
"no isa can parse the source"
    [Isa]
several -> Text -> Either Text Isa
forall a b. a -> Either a b
Left (Text -> Either Text Isa) -> Text -> Either Text Isa
forall a b. (a -> b) -> a -> b
$ Text
"source parses as " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Isa] -> Text
forall b a. (Show a, IsString b) => a -> b
show [Isa]
several

parsesAs :: Text -> Isa -> Bool
parsesAs :: Text -> Isa -> Bool
parsesAs Text
src Isa
isa = case Isa
isa of
    Isa
Acc32 -> forall isa'. MnemonicParser isa' => [Preprocessor] -> Bool
parses @(Acc32Isa Int32 (Ref Int32)) []
    Isa
F32a -> forall isa'. MnemonicParser isa' => [Preprocessor] -> Bool
parses @(F32aIsa Int32 (Ref Int32)) []
    Isa
RiscIv -> forall isa'. MnemonicParser isa' => [Preprocessor] -> Bool
parses @(RiscIvIsa Int32 (Ref Int32)) []
    Isa
M68k -> forall isa'. MnemonicParser isa' => [Preprocessor] -> Bool
parses @(M68kIsa Int32 (Ref Int32)) []
    Isa
VliwIv -> forall isa'. MnemonicParser isa' => [Preprocessor] -> Bool
parses @(VliwIvIsa Int32 (Ref Int32)) []
    Isa
Wasm32 -> forall isa'. MnemonicParser isa' => [Preprocessor] -> Bool
parses @(Wasm32Isa Int32 (Ref Int32)) [Preprocessor
resolveLocalNames]
    where
        parses :: forall isa'. (MnemonicParser isa') => [Preprocessor] -> Bool
        parses :: forall isa'. MnemonicParser isa' => [Preprocessor] -> Bool
parses [Preprocessor]
preprocessors =
            ((Int, Text) -> Bool)
-> ([Char] -> Bool) -> Either (Int, Text) [Char] -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> (Int, Text) -> Bool
forall a b. a -> b -> a
const Bool
True) (Either (ParseErrorBundle [Char] Void) [Section isa' Int32 Text]
-> Bool
forall a b. Either a b -> Bool
isRight (Either (ParseErrorBundle [Char] Void) [Section isa' Int32 Text]
 -> Bool)
-> ([Char]
    -> Either (ParseErrorBundle [Char] Void) [Section isa' Int32 Text])
-> [Char]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void [Char] [Section isa' Int32 Text]
-> [Char]
-> [Char]
-> Either (ParseErrorBundle [Char] Void) [Section isa' Int32 Text]
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
parse (forall isa w.
(IsWord w, MnemonicParser isa) =>
Parser [Section isa w Text]
asmParser @isa' @Int32) [Char]
"") (Either (Int, Text) [Char] -> Bool)
-> Either (Int, Text) [Char] -> Bool
forall a b. (a -> b) -> a -> b
$
                [Preprocessor] -> Preprocessor
preprocess [Preprocessor]
preprocessors (Text -> [Char]
forall a. ToString a => a -> [Char]
toString Text
src [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n")