futhark-data 1.0.1.1 → 1.0.2.0
raw patch · 4 files changed
+87/−8 lines, 4 filesdep +scientificPVP ok
version bump matches the API change (PVP)
Dependencies added: scientific
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- futhark-data.cabal +2/−1
- src/Futhark/Data/Parser.hs +64/−7
- tests/Tests.hs +17/−0
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for futhark-data +## 1.0.2.0 -- 2021-08-12++* Support underscores in numeric literals.+ ## 1.0.1.1 -- 2021-08-04 * Support the `f16` type.
futhark-data.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: futhark-data-version: 1.0.1.1+version: 1.0.2.0 synopsis: An implementation of the Futhark data format. description: The Futhark compiler and its tools uses a simple external@@ -34,6 +34,7 @@ , half >= 0.3 , megaparsec >=9.0.0 , mtl >=2.2.1+ , scientific >=0.3.6 , text >=1.2.2.2 , vector >=0.12 , vector-binary-instances >=0.2.2.0
src/Futhark/Data/Parser.hs view
@@ -15,20 +15,17 @@ where import Control.Monad.Except+import Data.Char (digitToInt, isDigit, isHexDigit) import Data.Functor+import qualified Data.Scientific as Sci import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Vector.Storable as SVec import Data.Void import Futhark.Data import Text.Megaparsec-import Text.Megaparsec.Char.Lexer- ( binary,- decimal,- float,- hexadecimal,- signed,- )+import Text.Megaparsec.Char.Lexer (signed)+import Prelude hiding (exponent) -- | Parse the name of a primitive type. Does *not* consume any -- trailing whitespace, nor does it permit any internal whitespace.@@ -49,6 +46,42 @@ "bool" $> Bool ] +allowUnderscores :: String -> (Char -> Bool) -> Parsec Void T.Text T.Text+allowUnderscores desc p =+ T.filter (/= '_')+ <$> ( (<>)+ <$> takeWhile1P (Just desc) p+ <*> takeWhileP (Just descOrUnderscore) pOrUnderscore+ )+ where+ descOrUnderscore = desc <> " or underscore"+ pOrUnderscore c = p c || c == '_'++-- Adapted from megaparsec.+decimal :: Num a => Parsec Void T.Text a+decimal =+ mkNum <$> allowUnderscores "digit" isDigit+ where+ mkNum = T.foldl' step 0+ step a c = a * 10 + fromIntegral (digitToInt c)++-- Adapted from megaparsec.+binary :: Num a => Parsec Void T.Text a+binary =+ mkNum <$> allowUnderscores "binary digit" isBinDigit+ where+ mkNum = T.foldl' step 0+ step a c = a * 2 + fromIntegral (digitToInt c)+ isBinDigit x = x == '0' || x == '1'++-- Adapted from megaparsec.+hexadecimal :: Num a => Parsec Void T.Text a+hexadecimal =+ mkNum <$> allowUnderscores "hexadecimal digit" isHexDigit+ where+ mkNum = T.foldl' step 0+ step a c = a * 16 + fromIntegral (digitToInt c)+ parseInteger :: Parsec Void T.Text Integer parseInteger = signed (pure ()) $@@ -79,6 +112,30 @@ where intV mk x suffix = suffix $> scalar mk (fromInteger x)++-- Adapted from megaparsec.+float :: RealFloat a => Parsec Void T.Text a+float = do+ c' <- decimal+ Sci.toRealFloat+ <$> ( ( do+ (c, e') <- dotDecimal c'+ e <- option e' $ try $ exponent e'+ pure $ Sci.scientific c e+ )+ <|> (Sci.scientific c' <$> exponent 0)+ )+ where+ exponent e' = do+ void $ choice ["e", "E"]+ (+ e') <$> signed (pure ()) decimal+ dotDecimal c' = do+ void "."+ mkNum <$> allowUnderscores "digit" isDigit+ where+ mkNum = T.foldl' step (c', 0)+ step (a, e') c =+ (a * 10 + fromIntegral (digitToInt c), e' - 1) parseFloatConst :: Parsec Void T.Text Value parseFloatConst =
tests/Tests.hs view
@@ -101,18 +101,28 @@ testGroup "Parser" [ test "1" $ scalar I32Value 1,+ negtest "_1", test "2i32" $ scalar I32Value 2, test "3i64" $ scalar I64Value 3,+ test "-2_3i32" $ scalar I32Value (-23),+ test "0b1_0_0_1" $ scalar I32Value 9,+ test "0x12_34" $ scalar I32Value 0x1234,+ test "3.1_4" $ scalar F64Value 3.14, test "1.0" $ scalar F64Value 1,+ negtest "_1.0", test "2f32" $ scalar F32Value 2, test "2f16" $ scalar F16Value 2,+ test "3.0f64" $ scalar F64Value 3.0, test "3.1f64" $ scalar F64Value 3.1,+ test "3.1_e-2f64" $ scalar F64Value 3.1e-2, test "f32.nan" $ scalar F32Value (0 / 0), test "f16.nan" $ scalar F16Value (0 / 0), test "f64.nan" $ scalar F64Value (0 / 0), test "f64.inf" $ scalar F64Value (1 / 0), test "-f64.inf" $ scalar F64Value (-1 / 0), test "true" $ scalar BoolValue True,+ test "false" $ scalar BoolValue False,+ negtest "tr_ue", testProperty "parse random data" $ \v -> (TestValue <$> parseMaybe (parseValue space) (valueText $ unTestValue v))@@ -122,6 +132,13 @@ test s x = testCase ("Parsing " <> show s) $ (TestValue <$> runParser (parseValue space <* eof) "" s) @?= Right (TestValue x)+ negtest s =+ testCase ("Parsing " <> show s) $+ either+ (const Nothing)+ Just+ (TestValue <$> runParser (parseValue space <* eof) "" s)+ @?= Nothing allTests :: TestTree allTests =