Commit 533bcf04 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Avoid making huge Rational's when reading Double/Float; fixes #5688

parent 7e84795c
\begin{code}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude, StandaloneDeriving, PatternGuards #-}
{-# LANGUAGE CPP, NoImplicitPrelude, StandaloneDeriving, PatternGuards,
ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
......@@ -67,9 +68,10 @@ import Data.Maybe
import {-# SOURCE #-} GHC.Unicode ( isDigit )
import GHC.Num
import GHC.Real
import GHC.Float ()
import GHC.Float
import GHC.Show
import GHC.Base
import GHC.Err
import GHC.Arr
-- For defining instances for the generic deriving mechanism
import GHC.Generics (Arity(..), Associativity(..), Fixity(..))
......@@ -472,10 +474,13 @@ convertInt (L.Number n)
| Just i <- L.numberToInteger n = return (fromInteger i)
convertInt _ = pfail
convertFrac :: Fractional a => L.Lexeme -> ReadPrec a
convertFrac :: forall a . RealFloat a => L.Lexeme -> ReadPrec a
convertFrac (L.Ident "NaN") = return (0 / 0)
convertFrac (L.Ident "Infinity") = return (1 / 0)
convertFrac (L.Number n) = return (fromRational $ L.numberToRational n)
convertFrac (L.Number n) = let resRange = floatRange (undefined :: a)
in case L.numberToRangedRational resRange n of
Nothing -> return (1 / 0)
Just rat -> return $ fromRational rat
convertFrac _ = pfail
instance Read Int where
......
......@@ -19,7 +19,7 @@ module Text.Read.Lex
-- lexing types
( Lexeme(..) -- :: *; Show, Eq
, numberToInteger, numberToRational
, numberToInteger, numberToRational, numberToRangedRational
-- lexer
, lex -- :: ReadP Lexeme Skips leading spaces
......@@ -82,6 +82,40 @@ numberToInteger (MkNumber base iPart) = Just (val (fromIntegral base) 0 iPart)
numberToInteger (MkDecimal iPart Nothing Nothing) = Just (val 10 0 iPart)
numberToInteger _ = Nothing
-- This takes a floatRange, and if the Rational would be outside of
-- the floatRange then it may return Nothing. Not that it will not
-- /necessarily/ return Nothing, but it is good enough to fix the
-- space problems in #5688
-- Ways this is conservative:
-- * the floatRange is in base 2, but we pretend it is in base 10
-- * we pad the floateRange a bit, just in case it is very small
-- and we would otherwise hit an edge case
-- * We only worry about numbers that have an exponent. If they don't
-- have an exponent then the Rational won't be much larger than the
-- Number, so there is no problem
numberToRangedRational :: (Int, Int) -> Number
-> Maybe Rational -- Nothing = Inf
numberToRangedRational (neg, pos) n@(MkDecimal iPart mFPart (Just exp))
= let mFirstDigit = case dropWhile (0 ==) iPart of
iPart'@(_ : _) -> Just (length iPart')
[] -> case mFPart of
Nothing -> Nothing
Just fPart ->
case span (0 ==) fPart of
(_, []) -> Nothing
(zeroes, _) ->
Just (negate (length zeroes))
in case mFirstDigit of
Nothing -> Just 0
Just firstDigit ->
let firstDigit' = firstDigit + fromInteger exp
in if firstDigit' > (pos + 3)
then Nothing
else if firstDigit' < (neg - 3)
then Just 0
else Just (numberToRational n)
numberToRangedRational _ n = Just (numberToRational n)
numberToRational :: Number -> Rational
numberToRational (MkNumber base iPart) = val (fromIntegral base) 0 iPart % 1
numberToRational (MkDecimal iPart mFPart mExp)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment