enrico
/
eoc
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

More tests and some refactoring

This commit is contained in:
Enrico Lumetti 2024-10-05 17:02:03 +02:00
parent 5c7e330af1
commit 031b812c51
2 changed files with 22 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
lib/Bril.hs
View File

@ -6,7 +6,7 @@ module Bril (
import Data.Aeson (FromJSON, parseJSON, withObject, withText, (.:), (.:?), decode) import Data.Aeson (FromJSON, parseJSON, withObject, withText, (.:), (.:?), decode)
import Data.Aeson.Types (Parser, modifyFailure) import Data.Aeson.Types (Parser, modifyFailure)
import qualified Data.Aeson (Value) import qualified Data.Aeson (Value, Object, Key)
import Data.Aeson.KeyMap import Data.Aeson.KeyMap
import Data.Int (Int64) import Data.Int (Int64)
import qualified Data.Text as T import qualified Data.Text as T
@ -115,6 +115,11 @@ instrFromString s
| s == "nop" = Nop | s == "nop" = Nop
| otherwise = error "wrong instruction name" | otherwise = error "wrong instruction name"
optionalArrayField :: FromJSON a => Data.Aeson.Object -> Data.Aeson.Key -> Parser [a]
optionalArrayField v field =
((v .:? field) >>= (return . fromMaybe []))
instance FromJSON Program where instance FromJSON Program where
parseJSON = withObject "Program" $ \v -> Program parseJSON = withObject "Program" $ \v -> Program
<$> v .: "functions" <$> v .: "functions"
@ -122,8 +127,8 @@ instance FromJSON Program where
instance FromJSON Function where instance FromJSON Function where
parseJSON = withObject "Function" $ \v -> Function parseJSON = withObject "Function" $ \v -> Function
<$> v .: "name" <$> v .: "name"
<*> v .: "type" <*> v .:? "type"
<*> v .: "args" <*> v `optionalArrayField` "args"
<*> v .: "instrs" <*> v .: "instrs"
instance FromJSON Instruction where instance FromJSON Instruction where
@ -146,9 +151,9 @@ instance FromJSON Instruction where
<*> v .: "dest" <*> v .: "dest"
parseValueInstr op v = do parseValueInstr op v = do
dest <- (v .: "dest") :: Parser VarName dest <- (v .: "dest") :: Parser VarName
args <- ((v .:? "args") >>= (return . fromMaybe [])) :: Parser [VarName] args <- (v `optionalArrayField` "args") :: Parser [VarName]
labels <- ((v .:? "labels") >>= (return . fromMaybe [])) :: Parser [VarName] labels <- (v `optionalArrayField` "labels") :: Parser [VarName]
funcs <- ((v .:? "funcs") >>= (return . fromMaybe [])) :: Parser [VarName] funcs <- (v `optionalArrayField` "funcs") :: Parser [VarName]
let instr = instrFromString op let instr = instrFromString op
if not (checkArity instr args labels) if not (checkArity instr args labels)
then fail $ unexpectedArityError op args labels then fail $ unexpectedArityError op args labels
@ -160,9 +165,9 @@ instance FromJSON Instruction where
<*> return funcs <*> return funcs
<*> return labels <*> return labels
parseEffectInstr op v = do parseEffectInstr op v = do
args <- ((v .:? "args") >>= (return . fromMaybe [])) :: Parser [VarName] args <- (v `optionalArrayField` "args") :: Parser [VarName]
labels <- ((v .:? "labels") >>= (return . fromMaybe [])) :: Parser [VarName] labels <- (v `optionalArrayField` "labels") :: Parser [VarName]
funcs <- ((v .:? "funcs") >>= (return . fromMaybe [])) :: Parser [VarName] funcs <- (v `optionalArrayField` "funcs") :: Parser [VarName]
dest <- (v .:? "dest") :: Parser (Maybe VarName) dest <- (v .:? "dest") :: Parser (Maybe VarName)
if (op == "call") && ((length funcs) /= 1) if (op == "call") && ((length funcs) /= 1)
then fail $ "call op must have exactly one entry in \"funcs\"" then fail $ "call op must have exactly one entry in \"funcs\""

8
tests/Main.hs
View File

@ -72,6 +72,14 @@ testInstrs = TestCase $ do
(eitherDecode "{\"op\": \"call\", \"type\": \"bool\", \"dest\": \"z\", \"args\": [\"a\", \"b\"], \"funcs\": []}") (eitherDecode "{\"op\": \"call\", \"type\": \"bool\", \"dest\": \"z\", \"args\": [\"a\", \"b\"], \"funcs\": []}")
(Left "Error in $: call op must have exactly one entry in \"funcs\"" :: Either String B.Instruction) (Left "Error in $: call op must have exactly one entry in \"funcs\"" :: Either String B.Instruction)
assertEqual "parse jmp"
(eitherDecode "{\"op\": \"jmp\", \"labels\": [\"a\"]}")
(Right $ B.EffectInstr B.Jmp [] [] ["a"])
assertEqual "parse br"
(eitherDecode "{\"op\": \"br\", \"labels\": [\"a\", \"b\"], \"args\": [\"z\"]}")
(Right $ B.EffectInstr B.Br ["z"] [] ["a", "b"])
tests :: Test tests :: Test
tests = TestList [ tests = TestList [
TestLabel "bril parser: type" testTypes, TestLabel "bril parser: type" testTypes,