123 lines
3.5 KiB
Haskell
123 lines
3.5 KiB
Haskell
module Bril (
|
|
Function (..), Type (..), Value (..), FunctionArg (..), Program (..),
|
|
parseValue,
|
|
)where
|
|
|
|
import Data.Aeson (FromJSON, parseJSON, withObject, withText, (.:), decode)
|
|
import Data.Aeson.Types (Parser, modifyFailure)
|
|
import qualified Data.Aeson (Value)
|
|
import Data.Aeson.KeyMap
|
|
import Data.Int (Int64)
|
|
import qualified Data.Text as T
|
|
import Data.Text.Read (Reader, signed, decimal)
|
|
|
|
|
|
data Program = Program { programFns :: [Function] }
|
|
deriving (Show, Eq)
|
|
|
|
type VarName = String
|
|
type FuncName = String
|
|
|
|
data Function = Function {
|
|
functionName :: FuncName,
|
|
returnType :: Maybe Type,
|
|
functionArgs :: [FunctionArg],
|
|
instructions :: [Instruction]
|
|
} deriving (Show, Eq)
|
|
|
|
data Type = Int | Bool
|
|
deriving (Show, Eq)
|
|
data Value = IntValue Int64 | BoolValue Bool
|
|
deriving (Eq, Show)
|
|
|
|
data FunctionArg = FunctionArg {
|
|
argName :: VarName,
|
|
argType :: Type
|
|
} deriving (Show, Eq)
|
|
|
|
data Instruction =
|
|
Label { name :: String }
|
|
| LiteralInstr {
|
|
value :: Value,
|
|
dest :: VarName
|
|
}
|
|
| ValueInstr {
|
|
op :: InstrOperation,
|
|
value :: Value,
|
|
args :: [VarName],
|
|
dest :: VarName,
|
|
funcs :: [FuncName],
|
|
labels :: [String]
|
|
}
|
|
| EffectInstr {
|
|
op :: InstrOperation,
|
|
value :: Value,
|
|
dest :: VarName,
|
|
funcs :: [FuncName],
|
|
labels :: [String]
|
|
}
|
|
deriving (Show, Eq)
|
|
|
|
data InstrOperation =
|
|
Add | Mul | Sub | Div | Eq | Lt | Gt | Le | Ge | Not | And | Or |
|
|
Jmp | Br | Call | Ret | Id | Print | Nop | Phi
|
|
deriving (Eq, Show)
|
|
|
|
instance FromJSON Program where
|
|
parseJSON = withObject "Program" $ \v -> Program
|
|
<$> v .: "functions"
|
|
|
|
instance FromJSON Function where
|
|
parseJSON = withObject "Function" $ \v -> Function
|
|
<$> v .: "name"
|
|
<*> v .: "type"
|
|
<*> v .: "args"
|
|
<*> v .: "instrs"
|
|
|
|
instance FromJSON Instruction where
|
|
parseJSON = withObject "Instruction" $ \v ->
|
|
if (Data.Aeson.KeyMap.member "label" v)
|
|
then Label <$> v .: "label"
|
|
else
|
|
do
|
|
op <- (v .: "op") :: Parser T.Text
|
|
type_ <- (v .: "type") :: Parser Type
|
|
case op of
|
|
"const" -> LiteralInstr
|
|
<$> ((v .: "value") >>= (parseValue type_))
|
|
<*> v .: "dest"
|
|
|
|
"add" -> undefined
|
|
_ -> fail "Wrong op for instruction"
|
|
|
|
instance FromJSON FunctionArg where
|
|
parseJSON = withObject "FunctionArg" $ \v -> FunctionArg
|
|
<$> v .: "name"
|
|
<*> v .: "type"
|
|
|
|
instance FromJSON Type where
|
|
parseJSON = withText "Type" $ \v ->
|
|
case v of
|
|
"int" -> return Int
|
|
"bool" -> return Bool
|
|
_ -> fail "wrong type"
|
|
|
|
parseValue :: Type -> Data.Aeson.Value -> Parser Value
|
|
parseValue Bool =
|
|
withText "BoolValue" $ \v ->
|
|
case v of
|
|
"true" -> return $ BoolValue True
|
|
"false" -> return $ BoolValue False
|
|
_ -> fail $ "invalid bool literal: " ++ (T.unpack v)
|
|
parseValue Int =
|
|
withText "IntValue" $ \v ->
|
|
case ((signed decimal :: Reader Int64) v) of
|
|
Left x -> fail $ "invalid int literal: " ++ x
|
|
Right (val, t) ->
|
|
if (T.null t)
|
|
then return $ IntValue val
|
|
else fail $ "invalid int literal: " ++ (T.unpack v)
|
|
|
|
|
|
parseBrilJSON text = (decode text :: Maybe Program)
|