module LibRISCV.Effects.Expressions.Generator (generateImmediates) where
import Data.Char (toLower)
import Language.Haskell.TH
binOps :: [String]
binOps :: [String]
binOps =
[ String
"Add"
, String
"Sub"
, String
"Eq"
, String
"Slt"
, String
"Sge"
, String
"Ult"
, String
"Uge"
, String
"And"
, String
"Or"
, String
"Xor"
, String
"LShl"
, String
"LShr"
, String
"AShr"
, String
"Mul"
, String
"UDiv"
, String
"SDiv"
, String
"URem"
, String
"SRem"
]
foldcase :: String -> String
foldcase :: String -> String
foldcase = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
genImm :: String -> Q Dec
genImm :: String -> Q Dec
genImm String
operator = do
let name :: Name
name = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String -> String
foldcase String
operator
let consName :: Name
consName = String -> Name
mkName String
operator
let immName :: Name
immName = String -> Name
mkName String
"FromImm"
Name
rval <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"rval"
Name
lval <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"lval"
let body :: Exp
body =
Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE (Name -> Exp
ConE Name
consName) (Exp -> Exp -> Exp
AppE (Name -> Exp
ConE Name
immName) (Name -> Exp
VarE Name
lval)))
(Exp -> Exp -> Exp
AppE (Name -> Exp
ConE Name
immName) (Name -> Exp
VarE Name
rval))
Dec -> Q Dec
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Clause] -> Dec
FunD Name
name [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
lval, Name -> Pat
VarP Name
rval] (Exp -> Body
NormalB Exp
body) []]
genImmRval :: String -> Q Dec
genImmRval :: String -> Q Dec
genImmRval String
operator = do
let name :: Name
name = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String -> String
foldcase String
operator String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Imm"
let onName :: Name
onName = String -> Name
mkName String
"on"
let consName :: Name
consName = String -> Name
mkName String
operator
let immName :: Name
immName = String -> Name
mkName String
"FromImm"
let body :: Exp
body = Exp -> Exp -> Exp
AppE (Exp -> Exp -> Exp
AppE (Name -> Exp
VarE Name
onName) (Name -> Exp
ConE Name
consName)) (Name -> Exp
ConE Name
immName)
Dec -> Q Dec
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Clause] -> Dec
FunD Name
name [[Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB Exp
body) []]
generateImmediates :: Q [Dec]
generateImmediates :: Q [Dec]
generateImmediates = do
[Dec]
l1 <- (String -> Q Dec) -> [String] -> 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 -> Q Dec
genImmRval [String]
binOps
[Dec]
l2 <- (String -> Q Dec) -> [String] -> 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 -> Q Dec
genImm [String]
binOps
[Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec]
l1 [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
++ [Dec]
l2)