diff --git a/eoc.cabal b/eoc.cabal index 19ab010..b4d30e4 100644 --- a/eoc.cabal +++ b/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 diff --git a/lib/Bril.hs b/lib/Bril.hs index ecdb43a..53cf580 100644 --- a/lib/Bril.hs +++ b/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) diff --git a/tests/Main.hs b/tests/Main.hs index bdddf87..c106d55 100644 --- a/tests/Main.hs +++ b/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