bril lieral parsing

eoc.cabal

@@ -21,6 +21,7 @@ library eoc-lib
     hs-source-dirs: lib
     build-depends:
         base >=4.13 && <4.18,
+        text >= 2.0,
         aeson >= 2.2
     default-language: Haskell2010
   default-extensions: DeriveGeneric, OverloadedStrings
@@ -43,6 +44,7 @@ test-suite tests
         base >=4.13 && <4.18,
         HUnit >=1.6,
         eoc-lib,
+        text >= 2.0,
         aeson >= 2.2
     hs-source-dirs: tests
     default-language: Haskell2010

lib/Bril.hs

@@ -1,27 +1,68 @@
 module Bril (
-    Function (..), Type (..), FunctionArg (..), Program (..), Int, Bool,
+    Function (..), Type (..), Value (..), FunctionArg (..), Program (..),
+    parseValue,
     )where
 
-import Data.Aeson (FromJSON, parseJSON, withObject, withText, (.:), decode, Value)
+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 :: String,
+        functionName :: FuncName,
         returnType :: Maybe Type,
-        functionArgs :: [FunctionArg]
+        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 :: String,
+        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"
@@ -31,6 +72,23 @@ instance FromJSON Function where
         <$> 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
@@ -44,4 +102,21 @@ instance FromJSON Type where
              "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)

tests/Main.hs

@@ -1,18 +1,48 @@
 module Main where
 
 import qualified Bril as B
-import Data.Aeson (decode)
+import Data.Aeson (decode, toJSON, parseJSON, Result(..))
+import Data.Aeson.Types (parse)
+import Data.Text
 import Data.Maybe
+import Data.Function ((&))
 
 import Test.HUnit
 import qualified System.Exit as Exit
  
-test1 :: Test
-test1 = TestCase
-        (assertEqual "?" (decode "\"int\"" :: Maybe B.Type) (Just B.Int))
+testTypes :: Test
+testTypes = TestCase $ do
+    assertEqual "int type" (decode "\"int\"" :: Maybe B.Type) (Just B.Int)
+    assertEqual "bool type" (decode "\"bool\"" :: Maybe B.Type) (Just B.Bool)
+
+testLiterals :: Test
+testLiterals = TestCase $ do
+    assertEqual "true literal"
+        (parseLiteral B.Bool "true") (Success $ B.BoolValue True)
+    assertEqual "false literal"
+        (parseLiteral B.Bool "false") (Success $ B.BoolValue False)
+    assertEqual "wrong bool literal"
+        (parseLiteral B.Bool "xxx") (Error "invalid bool literal: xxx")
+
+    assertEqual "int literal"
+        (parseLiteral B.Int "1434") (Success $ B.IntValue 1434)
+    assertEqual "negative int literal"
+        (parseLiteral B.Int "-143443") (Success $ B.IntValue (- 143443))
+    assertEqual "wrong int literal"
+        (parseLiteral B.Int "123xz") (Error "invalid int literal: 123xz")
+    assertEqual "wrong int literal"
+        (parseLiteral B.Int "123.5") (Error "invalid int literal: 123.5")
+    assertEqual "wrong int literal"
+        (parseLiteral B.Int "123.5") (Error "invalid int literal: 123.5")
+
+    where
+        parseLiteral type_ x = (parse (B.parseValue type_) (toJSON (x::Text)))
  
 tests :: Test
-tests = TestList [TestLabel "test1" test1]
+tests = TestList [
+        TestLabel "bril parser: type" testTypes,
+        TestLabel "bril parser: literal" testLiterals
+    ]
  
 main :: IO ()
 main = do