{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}

module LibRISCV.Internal.Decoder.Generator where

import Control.Monad (forM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bits ((.&.))
import Data.Char (toUpper)
import Data.FileEmbed (makeRelativeToProject)
import Data.List (nub)
import qualified Data.Map.Strict as M
import Data.Maybe (fromJust, isJust)
import Data.Word (Word32)
import Data.Yaml
import Language.Haskell.TH hiding (match)
import LibRISCV.Internal.Decoder.YamlParser

readAndParse :: (MonadIO m) => FilePath -> m [(String, InstructionFields)]
readAndParse :: forall (m :: * -> *).
MonadIO m =>
String -> m [(String, InstructionFields)]
readAndParse String
filePath = Map String InstructionFields -> [(String, InstructionFields)]
forall k a. Map k a -> [(k, a)]
M.toList (Map String InstructionFields -> [(String, InstructionFields)])
-> m (Map String InstructionFields)
-> m [(String, InstructionFields)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Map String InstructionFields)
-> m (Map String InstructionFields)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Map String InstructionFields)
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
decodeFileThrow String
filePath)

generateConsts :: [(String, InstructionFields)] -> String -> (InstructionFields -> String) -> Q [Dec]
generateConsts :: [(String, InstructionFields)]
-> String -> (InstructionFields -> String) -> Q [Dec]
generateConsts [(String, InstructionFields)]
entries String
suffix InstructionFields -> String
f = do
    [(String, InstructionFields)]
-> ((String, InstructionFields) -> Q Dec) -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(String, InstructionFields)]
entries (((String, InstructionFields) -> Q Dec) -> Q [Dec])
-> ((String, InstructionFields) -> Q Dec) -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ \(String
instructionName, InstructionFields
fields) -> do
        let
            nameD :: Name
nameD = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
instructionName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
suffix
            valE :: Integer
valE = String -> Integer
forall a. Read a => String -> a
read (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ InstructionFields -> String
f InstructionFields
fields
        Dec -> Q Dec
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$
            Pat -> Body -> [Dec] -> Dec
ValD
                (Name -> Pat
VarP Name
nameD)
                (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
valE)
                []

generateExtType :: [(String, InstructionFields)] -> Q [Dec]
generateExtType :: [(String, InstructionFields)] -> Q [Dec]
generateExtType [(String, InstructionFields)]
entries = do
    let
        byExts :: Map String [String]
byExts =
            ([String] -> [String] -> [String])
-> [(String, [String])] -> Map String [String]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
(<>)
                ([(String, [String])] -> Map String [String])
-> ([(String, InstructionFields)] -> [(String, [String])])
-> [(String, InstructionFields)]
-> Map String [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> (String, [String]))
-> [(String, String)] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
x, String
y) -> (String
x, [String
y]))
                ([(String, String)] -> [(String, [String])])
-> ([(String, InstructionFields)] -> [(String, String)])
-> [(String, InstructionFields)]
-> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, InstructionFields) -> [(String, String)])
-> [(String, InstructionFields)] -> [(String, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                    ( \(String
inst, InstructionFields
fs) ->
                        (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (,String
inst) (InstructionFields -> [String]
extension InstructionFields
fs)
                    )
                ([(String, InstructionFields)] -> Map String [String])
-> [(String, InstructionFields)] -> Map String [String]
forall a b. (a -> b) -> a -> b
$ [(String, InstructionFields)]
entries
        superType :: Dec
superType =
            Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Kind
-> [Con]
-> [DerivClause]
-> Dec
DataD
                []
                (String -> Name
mkName String
"InstructionType")
                []
                Maybe Kind
forall a. Maybe a
Nothing
                ( Name -> [BangType] -> Con
NormalC (String -> Name
mkName String
"InvalidInstruction") []
                    Con -> [Con] -> [Con]
forall a. a -> [a] -> [a]
: (String -> Con) -> [String] -> [Con]
forall a b. (a -> b) -> [a] -> [b]
map
                        ( \String
ex ->
                            Name -> [BangType] -> Con
NormalC
                                (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
ex)
                                [(SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness SourceStrictness
NoSourceStrictness, Name -> Kind
ConT (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
ex))]
                        )
                        (Map String [String] -> [String]
forall k a. Map k a -> [k]
M.keys Map String [String]
byExts)
                )
                [Maybe DerivStrategy -> Cxt -> DerivClause
DerivClause Maybe DerivStrategy
forall a. Maybe a
Nothing [Name -> Kind
ConT ''Eq, Name -> Kind
ConT ''Show]]
    [Dec]
extTypes <- [(String, [String])] -> ((String, [String]) -> Q Dec) -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map String [String] -> [(String, [String])]
forall k a. Map k a -> [(k, a)]
M.toList Map String [String]
byExts) (((String, [String]) -> Q Dec) -> Q [Dec])
-> ((String, [String]) -> Q Dec) -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ \(String
ext, [String]
instructions) -> do
        Dec -> Q Dec
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$
            Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Kind
-> [Con]
-> [DerivClause]
-> Dec
DataD
                []
                (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
ext)
                []
                Maybe Kind
forall a. Maybe a
Nothing
                ((String -> Con) -> [String] -> [Con]
forall a b. (a -> b) -> [a] -> [b]
map (\String
instr -> Name -> [BangType] -> Con
NormalC (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
instr) []) [String]
instructions)
                [Maybe DerivStrategy -> Cxt -> DerivClause
DerivClause Maybe DerivStrategy
forall a. Maybe a
Nothing [Name -> Kind
ConT ''Eq, Name -> Kind
ConT ''Show]]

    [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Dec]
extTypes [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
<> [Dec
superType]

generateExtDecodeFns :: [(String, InstructionFields)] -> Q [Dec]
generateExtDecodeFns :: [(String, InstructionFields)] -> Q [Dec]
generateExtDecodeFns [(String, InstructionFields)]
entries = do
    let
        byExts :: Map String [String]
byExts =
            ([String] -> [String] -> [String])
-> [(String, [String])] -> Map String [String]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
(<>)
                ([(String, [String])] -> Map String [String])
-> ([(String, InstructionFields)] -> [(String, [String])])
-> [(String, InstructionFields)]
-> Map String [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> (String, [String]))
-> [(String, String)] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
x, String
y) -> (String
x, [String
y]))
                ([(String, String)] -> [(String, [String])])
-> ([(String, InstructionFields)] -> [(String, String)])
-> [(String, InstructionFields)]
-> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, InstructionFields) -> [(String, String)])
-> [(String, InstructionFields)] -> [(String, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                    ( \(String
inst, InstructionFields
fs) ->
                        (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (,String
inst) (InstructionFields -> [String]
extension InstructionFields
fs)
                    )
                ([(String, InstructionFields)] -> Map String [String])
-> [(String, InstructionFields)] -> Map String [String]
forall a b. (a -> b) -> a -> b
$ [(String, InstructionFields)]
entries

    [Dec]
sigs <- [(String, [String])] -> ((String, [String]) -> Q Dec) -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map String [String] -> [(String, [String])]
forall k a. Map k a -> [(k, a)]
M.toList Map String [String]
byExts) (((String, [String]) -> Q Dec) -> Q [Dec])
-> ((String, [String]) -> Q Dec) -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ \(String
ex, [String]
_) ->
        Dec -> Q Dec
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$
            Name -> Kind -> Dec
SigD
                (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"decode_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
ex)
                ( Kind -> Kind -> Kind
AppT
                    ( Kind -> Kind -> Kind
AppT
                        Kind
ArrowT
                        (Name -> Kind
ConT ''Word32)
                    )
                    ( Kind -> Kind -> Kind
AppT
                        (Name -> Kind
ConT ''Maybe)
                        (Name -> Kind
ConT (Name -> Kind) -> Name -> Kind
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
ex)
                    )
                )
    [Dec]
defs <- [(String, [String])] -> ((String, [String]) -> Q Dec) -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map String [String] -> [(String, [String])]
forall k a. Map k a -> [(k, a)]
M.toList Map String [String]
byExts) (((String, [String]) -> Q Dec) -> Q [Dec])
-> ((String, [String]) -> Q Dec) -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ \(String
ex, [String]
instrs) ->
        Dec -> Q Dec
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$
            Name -> [Clause] -> Dec
FunD
                (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"decode_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
ex)
                [ [Pat] -> Body -> [Dec] -> Clause
Clause
                    [Name -> Pat
VarP (String -> Name
mkName String
"w")]
                    ( [(Guard, Exp)] -> Body
GuardedB ([(Guard, Exp)] -> Body) -> [(Guard, Exp)] -> Body
forall a b. (a -> b) -> a -> b
$
                        (String -> (Guard, Exp)) -> [String] -> [(Guard, Exp)]
forall a b. (a -> b) -> [a] -> [b]
map
                            ( \String
instr ->
                                ( Exp -> Guard
NormalG (Exp -> Guard) -> Exp -> Guard
forall a b. (a -> b) -> a -> b
$
                                    Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE
                                        ( Exp -> Maybe Exp
forall a. a -> Maybe a
Just
                                            ( Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE
                                                (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"w"))
                                                (Name -> Exp
VarE '(.&.))
                                                (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
instr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_mask"))
                                            )
                                        )
                                        (Name -> Exp
VarE '(==))
                                        (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
instr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_match"))
                                , Exp -> Exp -> Exp
AppE (Name -> Exp
ConE 'Just) (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
instr
                                )
                            )
                            [String]
instrs
                            [(Guard, Exp)] -> [(Guard, Exp)] -> [(Guard, Exp)]
forall a. Semigroup a => a -> a -> a
<> [(Exp -> Guard
NormalG (Name -> Exp
ConE 'True), Name -> Exp
ConE 'Nothing)]
                    )
                    []
                ]
    [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Dec]
sigs [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
<> [Dec]
defs

generateDecodeFn :: [(String, InstructionFields)] -> Q [Dec]
generateDecodeFn :: [(String, InstructionFields)] -> Q [Dec]
generateDecodeFn [(String, InstructionFields)]
entries = do
    let
        exts :: [String]
exts =
            (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper)
                ([String] -> [String])
-> ([(String, InstructionFields)] -> [String])
-> [(String, InstructionFields)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Eq a => [a] -> [a]
nub
                ([String] -> [String])
-> ([(String, InstructionFields)] -> [String])
-> [(String, InstructionFields)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, InstructionFields) -> [String])
-> [(String, InstructionFields)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (InstructionFields -> [String]
extension (InstructionFields -> [String])
-> ((String, InstructionFields) -> InstructionFields)
-> (String, InstructionFields)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, InstructionFields) -> InstructionFields
forall a b. (a, b) -> b
snd)
                ([(String, InstructionFields)] -> [String])
-> [(String, InstructionFields)] -> [String]
forall a b. (a -> b) -> a -> b
$ [(String, InstructionFields)]
entries
        sig :: Dec
sig =
            Name -> Kind -> Dec
SigD
                (String -> Name
mkName String
"decode")
                ( Kind -> Kind -> Kind
AppT
                    ( Kind -> Kind -> Kind
AppT
                        Kind
ArrowT
                        (Name -> Kind
ConT ''Word32)
                    )
                    (Name -> Kind
ConT (Name -> Kind) -> Name -> Kind
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"InstructionType")
                )
        def :: Dec
def =
            Name -> [Clause] -> Dec
FunD
                (String -> Name
mkName String
"decode")
                [ [Pat] -> Body -> [Dec] -> Clause
Clause
                    [Name -> Pat
VarP (Name -> Pat) -> Name -> Pat
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"w"]
                    ( [(Guard, Exp)] -> Body
GuardedB ([(Guard, Exp)] -> Body) -> [(Guard, Exp)] -> Body
forall a b. (a -> b) -> a -> b
$
                        (String -> (Guard, Exp)) -> [String] -> [(Guard, Exp)]
forall a b. (a -> b) -> [a] -> [b]
map
                            ( \String
ex ->
                                ( Exp -> Guard
NormalG (Exp -> Guard) -> Exp -> Guard
forall a b. (a -> b) -> a -> b
$
                                    Exp -> Exp -> Exp
AppE
                                        (Name -> Exp
VarE 'isJust)
                                        ( Exp -> Exp -> Exp
AppE
                                            (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"decode_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
ex)
                                            (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"w")
                                        )
                                , Exp -> Exp -> Exp
AppE
                                    (Name -> Exp
ConE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
ex)
                                    ( Exp -> Exp -> Exp
AppE
                                        (Name -> Exp
VarE 'fromJust)
                                        ( Exp -> Exp -> Exp
AppE
                                            (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"decode_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
ex)
                                            (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"w")
                                        )
                                    )
                                )
                            )
                            [String]
exts
                            [(Guard, Exp)] -> [(Guard, Exp)] -> [(Guard, Exp)]
forall a. Semigroup a => a -> a -> a
<> [(Exp -> Guard
NormalG (Name -> Exp
ConE 'True), Name -> Exp
ConE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"InvalidInstruction")]
                    )
                    []
                ]
    [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Dec
def, Dec
sig]

generateMasks :: [(String, InstructionFields)] -> Q [Dec]
generateMasks :: [(String, InstructionFields)] -> Q [Dec]
generateMasks [(String, InstructionFields)]
entries = [(String, InstructionFields)]
-> String -> (InstructionFields -> String) -> Q [Dec]
generateConsts [(String, InstructionFields)]
entries String
"mask" InstructionFields -> String
mask

generateMatches :: [(String, InstructionFields)] -> Q [Dec]
generateMatches :: [(String, InstructionFields)] -> Q [Dec]
generateMatches [(String, InstructionFields)]
entries = [(String, InstructionFields)]
-> String -> (InstructionFields -> String) -> Q [Dec]
generateConsts [(String, InstructionFields)]
entries String
"match" InstructionFields -> String
match

generateAll :: [[(String, InstructionFields)] -> Q [Dec]] -> FilePath -> Q [Dec]
generateAll :: [[(String, InstructionFields)] -> Q [Dec]] -> String -> Q [Dec]
generateAll [[(String, InstructionFields)] -> Q [Dec]]
seqs String
path = do
    [(String, InstructionFields)]
entries <- IO [(String, InstructionFields)] -> Q [(String, InstructionFields)]
forall a. IO a -> Q a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(String, InstructionFields)]
 -> Q [(String, InstructionFields)])
-> IO [(String, InstructionFields)]
-> Q [(String, InstructionFields)]
forall a b. (a -> b) -> a -> b
$ String -> IO [(String, InstructionFields)]
forall (m :: * -> *).
MonadIO m =>
String -> m [(String, InstructionFields)]
readAndParse String
path
    [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([(String, InstructionFields)] -> Q [Dec]) -> Q [Dec])
-> [[(String, InstructionFields)] -> Q [Dec]] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\[(String, InstructionFields)] -> Q [Dec]
f -> [(String, InstructionFields)] -> Q [Dec]
f [(String, InstructionFields)]
entries) [[(String, InstructionFields)] -> Q [Dec]]
seqs

generateDefaultDecoder :: Q [Dec]
generateDefaultDecoder :: Q [Dec]
generateDefaultDecoder =
    String -> Q String
makeRelativeToProject String
"data/instr_dict.yaml"
        Q String -> (String -> Q [Dec]) -> Q [Dec]
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [[(String, InstructionFields)] -> Q [Dec]] -> String -> Q [Dec]
generateAll
            [ [(String, InstructionFields)] -> Q [Dec]
generateMasks
            , [(String, InstructionFields)] -> Q [Dec]
generateMatches
            , [(String, InstructionFields)] -> Q [Dec]
generateExtType
            , [(String, InstructionFields)] -> Q [Dec]
generateExtDecodeFns
            , [(String, InstructionFields)] -> Q [Dec]
generateDecodeFn
            ]