Commit 104aeb7d authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Merge branch 'master' of http://darcs.haskell.org//packages/base

parents ccb16c13 5f19f951
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE CPP, ScopedTypeVariables, PatternGuards #-}
{-# OPTIONS -Wall -fno-warn-unused-binds #-}
#ifndef __NHC__
{-# LANGUAGE DeriveDataTypeable #-}
......@@ -40,12 +40,13 @@ module Data.Fixed
) where
import Prelude -- necessary to get dependencies right
import Data.Char
import Data.List
#ifndef __NHC__
import Data.Typeable
import Data.Data
#endif
import GHC.Read
import Text.ParserCombinators.ReadPrec
import Text.Read.Lex
#ifndef __NHC__
default () -- avoid any defaulting shenanigans
......@@ -159,30 +160,20 @@ showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZe
maxnum = 10 ^ digits
fracNum = div (d * maxnum) res
readsFixed :: (HasResolution a) => ReadS (Fixed a)
readsFixed = readsSigned
where readsSigned ('-' : xs) = [ (negate x, rest)
| (x, rest) <- readsUnsigned xs ]
readsSigned xs = readsUnsigned xs
readsUnsigned xs = case span isDigit xs of
([], _) -> []
(is, xs') ->
let i = fromInteger (read is)
in case xs' of
'.' : xs'' ->
case span isDigit xs'' of
([], _) -> []
(js, xs''') ->
let j = fromInteger (read js)
l = genericLength js :: Integer
in [(i + (j / (10 ^ l)), xs''')]
_ -> [(i, xs')]
instance (HasResolution a) => Show (Fixed a) where
show = showFixed False
instance (HasResolution a) => Read (Fixed a) where
readsPrec _ = readsFixed
readPrec = readNumber convertFixed
readListPrec = readListPrecDefault
readList = readListDefault
convertFixed :: forall a . HasResolution a => Lexeme -> ReadPrec (Fixed a)
convertFixed (Number n)
| Just (i, f) <- numberToFixed r n =
return (fromInteger i + (fromInteger f / (10 ^ r)))
where r = resolution (undefined :: Fixed a)
convertFixed _ = pfail
data E0 = E0
#ifndef __NHC__
......
......@@ -509,7 +509,7 @@ mapAccumR f s (x:xs) = (s'', y:ys)
(s', ys) = mapAccumR f s xs
-- | The 'insert' function takes an element and a list and inserts the
-- element into the list at the last position where it is still less
-- element into the list at the first position where it is less
-- than or equal to the next element. In particular, if the list
-- is sorted before the call, the result will also be sorted.
-- It is a special case of 'insertBy', which allows the programmer to
......
......@@ -38,6 +38,7 @@ module GHC.Read
, list
, choose
, readListDefault, readListPrecDefault
, readNumber
-- Temporary
, readParen
......
......@@ -19,7 +19,7 @@ module Text.Read.Lex
-- lexing types
( Lexeme(..)
, numberToInteger, numberToRational, numberToRangedRational
, numberToInteger, numberToFixed, numberToRational, numberToRangedRational
-- lexer
, lex, expect
......@@ -82,6 +82,22 @@ numberToInteger (MkNumber base iPart) = Just (val (fromIntegral base) 0 iPart)
numberToInteger (MkDecimal iPart Nothing Nothing) = Just (val 10 0 iPart)
numberToInteger _ = Nothing
numberToFixed :: Integer -> Number -> Maybe (Integer, Integer)
numberToFixed _ (MkNumber base iPart) = Just (val (fromIntegral base) 0 iPart, 0)
numberToFixed _ (MkDecimal iPart Nothing Nothing) = Just (val 10 0 iPart, 0)
numberToFixed p (MkDecimal iPart (Just fPart) Nothing)
= let i = val 10 0 iPart
f = val 10 0 (integerTake p (fPart ++ repeat 0))
-- Sigh, we really want genericTake, but that's above us in
-- the hierarchy, so we define our own version here (actually
-- specialised to Integer)
integerTake :: Integer -> [a] -> [a]
integerTake n _ | n <= 0 = []
integerTake _ [] = []
integerTake n (x:xs) = x : integerTake (n-1) xs
in Just (i, f)
numberToFixed _ _ = 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
......
......@@ -20,6 +20,7 @@ test('data-fixed-show-read', normal, compile_and_run, [''])
test('showDouble', normal, compile_and_run, [''])
test('readDouble001', normal, compile_and_run, [''])
test('readInteger001', normal, compile_and_run, [''])
test('readFixed001', normal, compile_and_run, [''])
test('lex001', normal, compile_and_run, [''])
test('take001', extra_run_opts('1'), compile_and_run, [''])
test('genericNegative001', extra_run_opts('-1'), compile_and_run, [''])
......
import Data.Fixed
main :: IO ()
main = do f " (( ( 12.3456 ) ) ) "
f " (( ( 12.3 ) ) ) "
f " (( ( 12. ) ) ) "
f " (( ( 12 ) ) ) "
f " (( - ( 12.3456 ) ) ) "
f " (( ( -12.3456 ) ) ) "
f :: String -> IO ()
f str = print (reads str :: [(Centi, String)])
[(12.34," ")]
[(12.30," ")]
[]
[(12.00," ")]
[]
[(-12.34," ")]
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