enrico
/
eoc
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

JSON serialization

This commit is contained in:
Enrico Lumetti 2024-10-06 12:43:08 +02:00
parent b635fde2c5
commit 08049e9955
1 changed files with 75 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
lib/Bril.hs
View File

@ -5,7 +5,7 @@ module Bril (
parseBrilFromPath, parseBrilJSON, parseBrilFromPath, parseBrilJSON,
)where )where
import Data.Aeson (FromJSON, parseJSON, withObject, withText, withBool, withScientific, (.:), (.:?), eitherDecode) import Data.Aeson (FromJSON, ToJSON, parseJSON, toJSON, object, withObject, withText, withBool, withScientific, (.:), (.:?), (.=), (.?=), eitherDecode)
import Data.Aeson.Types (Parser, modifyFailure) import Data.Aeson.Types (Parser, modifyFailure)
import qualified Data.Aeson (Value, Object, Key) import qualified Data.Aeson (Value, Object, Key)
import Data.Aeson.KeyMap import Data.Aeson.KeyMap
@ -66,7 +66,7 @@ data Instruction =
data InstrOperation = data InstrOperation =
Add | Mul | Sub | Div | Eq | Lt | Gt | Le | Ge | Not | And | Or | Add | Mul | Sub | Div | Eq | Lt | Gt | Le | Ge | Not | And | Or |
Jmp | Br | Call | Ret | Id | Print | Nop | Phi Jmp | Br | Call | Ret | Id | Print | Nop | Phi
deriving (Eq, Show) deriving (Eq)
data Arity = data Arity =
Arity Int Int Int -- min, max, labels arity Arity Int Int Int -- min, max, labels arity
@ -118,6 +118,28 @@ instrFromString s
| s == "nop" = Nop | s == "nop" = Nop
| otherwise = error "wrong instruction name" | otherwise = error "wrong instruction name"
instance Show InstrOperation where
show op = case op of
Nop -> "add"
Add -> "sub"
Sub -> "mul"
Mul -> "eq"
Eq -> "lt"
Lt -> "gt"
Gt -> "le"
Le -> "ge"
Ge -> "not"
Not -> "and"
And -> "or"
Or -> "jmp"
Jmp -> "br"
Br -> "ret"
Ret -> "call"
Call -> "print"
Print -> "id"
Id -> "nop"
optionalArrayField :: FromJSON a => Data.Aeson.Object -> Data.Aeson.Key -> Parser [a] optionalArrayField :: FromJSON a => Data.Aeson.Object -> Data.Aeson.Key -> Parser [a]
optionalArrayField v field = optionalArrayField v field =
((v .:? field) >>= (return . fromMaybe [])) ((v .:? field) >>= (return . fromMaybe []))
@ -222,3 +244,54 @@ parseBrilJSON text = (eitherDecode text :: Either String Program)
parseBrilFromPath path = do parseBrilFromPath path = do
contents <- LB.readFile path contents <- LB.readFile path
return $ parseBrilJSON contents return $ parseBrilJSON contents
instance ToJSON Type where
toJSON Bool = toJSON ("bool" :: T.Text)
toJSON Int = toJSON ("int" :: T.Text)
instance ToJSON FunctionArg where
toJSON (FunctionArg argName argType) = object [
"name" .= argName,
"type" .= argType
]
instance ToJSON Value where
toJSON (IntValue val) = toJSON val
toJSON (BoolValue val) = toJSON val
instance ToJSON Instruction where
toJSON (Label name) = object [ "label" .= name ]
toJSON (LiteralInstr value dest) = object [
"op" .= ("const" :: T.Text),
"dest" .= dest,
"type" .= case value of
(IntValue _) -> Int
(BoolValue _) -> Bool,
"value" .= value
]
toJSON (EffectInstr op args funcs labels) = object [
"op" .= (show op),
"args" .= args,
"funcs" .= funcs,
"labels" .= labels
]
toJSON (ValueInstr op type_ dest args funcs labels) = object [
"op" .= (show op),
"dest" .= dest,
"type" .= type_,
"args" .= args,
"funcs" .= funcs,
"labels" .= labels
]
instance ToJSON Function where
toJSON (Function name type_ args instrs) = object $ [
"name" .= name,
"args" .= args,
"instrs" .= instrs
] ++ case type_ of
Nothing -> []
(Just t) -> ["type" .= t]
instance ToJSON Program where
toJSON (Program functions) = object [ "functions" .= functions ]