lib/Bril.hs

@@ -5,7 +5,7 @@ module Bril (
     parseBrilFromPath, parseBrilJSON,
     )where
 
-import Data.Aeson (FromJSON, ToJSON, parseJSON, toJSON, object, withObject, withText, withBool, withScientific, (.:), (.:?), (.=), (.?=), eitherDecode)
+import Data.Aeson (FromJSON, parseJSON, withObject, withText, 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)
+   deriving (Eq, Show)
 
 data Arity =
     Arity Int Int Int -- min, max, labels arity
@@ -74,11 +74,11 @@ data Arity =
    deriving (Eq, Show)
 
 valueOps = toSortedList ([
-        "add", "mul", "sub", "div", "eq", "lt", "gt", "le", "ge", "not", "and", "or", "id"
+        "add", "mul", "sub", "div", "eq", "lt", "gt", "le", "ge", "not", "and", "or"
     ] :: [T.Text])
 
 effectOps = toSortedList ([
-        "nop", "call", "jmp", "br", "print", "ret"
+        "nop", "call", "jmp", "br", "print", "lt", "gt", "le", "ge", "not", "and", "or"
     ] :: [T.Text])
 
 arity instr
@@ -118,28 +118,6 @@ 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 []))
@@ -225,8 +203,19 @@ instance FromJSON Type where
 
 parseValue :: Type -> Data.Aeson.Value -> Parser Value
 parseValue Bool =
-    withBool "BoolValue" (return . BoolValue)
-
+    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)
 parseValue Int =
     withScientific "IntValue" $ \v ->
         if (not (isInteger v))
@@ -244,54 +233,3 @@ 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 ]

tests/Main.hs

@@ -20,9 +20,11 @@ testTypes = TestCase $ do
 testLiterals :: Test
 testLiterals = TestCase $ do
     assertEqual "true literal"
-        (parseLiteral B.Bool True) (Success $ B.BoolValue True)
+        (parseLiteral B.Bool ("true"::Text)) (Success $ B.BoolValue True)
     assertEqual "false literal"
-        (parseLiteral B.Bool False) (Success $ B.BoolValue False)
+        (parseLiteral B.Bool ("false"::Text)) (Success $ B.BoolValue False)
+    assertEqual "wrong bool literal"
+        (parseLiteral B.Bool ("xxx"::Text)) (Error "invalid bool literal: xxx")
 
     assertEqual "int literal"
         (parseLiteral B.Int (1434 :: Int)) (Success $ B.IntValue 1434)
@@ -77,10 +79,6 @@ testInstrs = TestCase $ do
         (eitherDecode "{\"op\": \"br\", \"labels\": [\"a\", \"b\"], \"args\": [\"z\"]}")
         (Right $ B.EffectInstr B.Br ["z"] [] ["a", "b"])
 
-    assertEqual "parse id"
-        (eitherDecode "{\"op\": \"id\", \"dest\": \"a\", \"type\": \"bool\", \"args\": [\"b\"]}")
-        (Right $ B.ValueInstr B.Id B.Bool "a" ["b"] [] [])
-
 testProgramFromFiles :: Test
 testProgramFromFiles = TestCase $ do
     res <- try $ (B.parseBrilFromPath "bril-sources/add.json") :: IO (Either IOError (Either String B.Program))