diff --git a/bril-sources/add.json b/bril-sources/add.json index ef860a8..f75b202 100644 --- a/bril-sources/add.json +++ b/bril-sources/add.json @@ -1,3 +1,4 @@ +{ "functions": [ { "instrs": [ diff --git a/eoc.cabal b/eoc.cabal index 661ead9..db1eaa2 100644 --- a/eoc.cabal +++ b/eoc.cabal @@ -24,7 +24,8 @@ library eoc-lib text >= 2.0, aeson >= 2.2, sorted-list ^>= 0.2, - bytestring >= 0.11 + bytestring ^>= 0.11, + scientific ^>= 0.3 default-language: Haskell2010 default-extensions: DeriveGeneric, OverloadedStrings diff --git a/lib/Bril.hs b/lib/Bril.hs index 20dd521..b0453f2 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, (.:), (.:?), 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 @@ -14,6 +14,7 @@ import qualified Data.Text as T import Data.Text.Read (Reader, signed, decimal) import Data.SortedList import Data.Maybe (fromMaybe, isJust) +import Data.Scientific (isInteger, toBoundedInteger) import qualified Data.ByteString.Lazy as LB @@ -207,15 +208,25 @@ parseValue Bool = "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 = - 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) - + withScientific "IntValue" $ \v -> + if (not (isInteger v)) + then fail $ "Invalid integer literal: " ++ (show v) + else do + let num = toBoundedInteger v :: Maybe Int64 + case num of + (Just n) -> return $ IntValue n + _ -> fail $ "Integer exceeds int64: " ++ (show v) + + parseBrilJSON text = (eitherDecode text :: Either String Program) diff --git a/tests/Main.hs b/tests/Main.hs index 7bd64f8..12a8ee3 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -18,25 +18,22 @@ 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") (Error "invalid bool literal: xxx") + (parseLiteral B.Bool ("xxx"::Text)) (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)) + (parseLiteral B.Int (1434 :: Int)) (Success $ B.IntValue 1434) assertEqual "wrong int literal" - (parseLiteral B.Int "123xz") (Error "invalid int literal: 123xz") + (parseLiteral B.Int (100000000000000000000 :: Integer)) + (Error "Integer exceeds int64: 1.0e20") 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") + (parseLiteral B.Int (123.5 :: Double)) (Error "Invalid integer literal: 123.5") where - parseLiteral type_ x = (parse (B.parseValue type_) (toJSON (x::Text))) + parseLiteral type_ x = (parse (B.parseValue type_) (toJSON x)) testInstrs :: Test testInstrs = TestCase $ do