diff --git a/lib/Bril.hs b/lib/Bril.hs index c4d4c4b..ad89ae8 100644 --- a/lib/Bril.hs +++ b/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 ]