Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
104aeb7d
Commit
104aeb7d
authored
Jan 08, 2013
by
Simon Peyton Jones
Browse files
Merge branch 'master' of
http://darcs.haskell.org//packages/base
parents
ccb16c13
5f19f951
Changes
7
Hide whitespace changes
Inline
Side-by-side
libraries/base/Data/Fixed.hs
View file @
104aeb7d
{-# 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__
...
...
libraries/base/Data/List.hs
View file @
104aeb7d
...
...
@@ -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
la
st position where it is
still
less
-- element into the list at the
fir
st 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
...
...
libraries/base/GHC/Read.lhs
View file @
104aeb7d
...
...
@@ -38,6 +38,7 @@ module GHC.Read
, list
, choose
, readListDefault, readListPrecDefault
, readNumber
-- Temporary
, readParen
...
...
libraries/base/Text/Read/Lex.hs
View file @
104aeb7d
...
...
@@ -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
...
...
libraries/base/tests/all.T
View file @
104aeb7d
...
...
@@ -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
,
[''])
...
...
libraries/base/tests/readFixed001.hs
0 → 100644
View file @
104aeb7d
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
)])
libraries/base/tests/readFixed001.stdout
0 → 100644
View file @
104aeb7d
[(12.34," ")]
[(12.30," ")]
[]
[(12.00," ")]
[]
[(-12.34," ")]
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment