JSON serialization

lib/Bril.hs

@@ -5,7 +5,7 @@ module Bril (
     parseBrilFromPath, parseBrilJSON,
     )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 qualified Data.Aeson (Value, Object, Key)
 import Data.Aeson.KeyMap
@@ -66,7 +66,7 @@ data Instruction =
 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)
+   deriving (Eq)
 
 data Arity =
     Arity Int Int Int -- min, max, labels arity
@@ -118,6 +118,28 @@ instrFromString s
     | s == "nop" = Nop
     | 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 v field =
     ((v .:? field) >>= (return . fromMaybe []))
@@ -222,3 +244,54 @@ parseBrilJSON text = (eitherDecode text :: Either String Program)
 parseBrilFromPath path = do
     contents <- LB.readFile path
     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 ]