1 (* Copyright (C
) 2011-2014,2017 Matthew Fluet
.
2 * Copyright (C
) 2003-2007 Henry Cejtin
, Matthew Fluet
, Suresh
3 * Jagannathan
, and Stephen Weeks
.
5 * MLton is released under a BSD
-style license
.
6 * See the file MLton
-LICENSE for details
.
9 functor Real (structure W
: WORD_EXTRA
13 val castToWord
: real -> W
.word
14 val castFromWord
: W
.word -> real
17 structure MLton
= Primitive
.MLton
22 datatype float_class
= datatype float_class
23 datatype rounding_mode
= datatype rounding_mode
31 val realSize
= Int32
.toInt realSize
32 val exponentBias
= Int32
.toInt exponentBias
33 val precision
= Int32
.toInt precision
34 val radix
= Int32
.toInt radix
37 val signBits
= Word.one
38 val exponentSignificandBits
= Word.- (Word.fromInt realSize
, signBits
)
39 val significandBits
= Word.- (Word.fromInt precision
, Word.one
)
40 val exponentBits
= Word.- (exponentSignificandBits
, significandBits
)
43 val mkMask
: Word.word -> W
.word =
44 fn b
=> W
.notb (W
.<< (W
.notb W
.zero
, b
))
47 W
.<< (mkMask signBits
, exponentSignificandBits
)
49 W
.<< (mkMask exponentBits
, significandBits
)
51 mkMask significandBits
54 val class
: real -> float_class
=
57 val w
= R
.castToWord r
59 if W
.andb (w
, exponentMask
) = exponentMask
60 then if W
.andb (w
, significandMask
) = W
.zero
63 else if W
.andb (w
, exponentMask
) = W
.zero
64 then if W
.andb (w
, significandMask
) = W
.zero
66 else IEEEReal
.SUBNORMAL
70 val toBits
: real -> {sign
: bool, exponent
: W
.word, significand
: W
.word} =
73 val w
= R
.castToWord r
75 W
.andb (w
, significandMask
)
77 W
.>> (W
.andb (w
, exponentMask
), significandBits
)
79 W
.andb (w
, signMask
) = signMask
83 significand
= significand
}
86 val fromBits
: {sign
: bool, exponent
: W
.word, significand
: W
.word} -> real =
87 fn {sign
, exponent
, significand
} =>
90 W
.orb (if sign
then W
.<< (W
.one
, exponentSignificandBits
) else W
.zero
,
91 W
.orb (W
.andb (W
.<< (exponent
, significandBits
), exponentMask
),
92 W
.andb (significand
, significandMask
)))
93 val r
= R
.castFromWord w
116 fun 'a make
{fromRealUnsafe
: 'a
-> real,
117 toRealUnsafe
: real -> 'a
,
118 other
: {precision
: Primitive
.Int32
.int}} =
119 if R
.precision
= #precision other
120 then (fn (_
: rounding_mode
) => fromRealUnsafe
,
122 else (fn (m
: rounding_mode
) => fn r
=>
123 IEEEReal
.withRoundingMode (m
, fn () => fromRealUnsafe r
),
126 val (fromReal32
,toReal32
) =
127 make
{fromRealUnsafe
= R
.fromReal32Unsafe
,
128 toRealUnsafe
= R
.toReal32Unsafe
,
129 other
= {precision
= Primitive
.Real32
.precision
}}
130 val (fromReal64
,toReal64
) =
131 make
{fromRealUnsafe
= R
.fromReal64Unsafe
,
132 toRealUnsafe
= R
.toReal64Unsafe
,
133 other
= {precision
= Primitive
.Real64
.precision
}}
137 LargeReal_ChooseRealN
138 (type 'a t
= real -> 'a
139 val fReal32
= toReal32
140 val fReal64
= toReal64
)
146 LargeReal_ChooseRealN
147 (type 'a t
= rounding_mode
-> 'a
-> real
148 val fReal32
= fromReal32
149 val fReal64
= fromReal64
)
154 val negInf
= R
.castFromWord (W
.orb (signMask
, exponentMask
))
155 val negOne
= R
.castFromWord (W
.orb (signMask
, W
.<< (W
.fromInt exponentBias
, significandBits
)))
156 val negZero
= R
.castFromWord signMask
157 val zero
= R
.castFromWord W
.zero
158 val minPos
= R
.castFromWord W
.one
159 val minNormalPos
= R
.castFromWord (W
.<< (W
.one
, significandBits
))
160 val half
= R
.castFromWord (W
.<< (W
.- (W
.fromInt exponentBias
, W
.one
), significandBits
))
161 val one
= R
.castFromWord (W
.<< (W
.fromInt exponentBias
, significandBits
))
162 val two
= R
.castFromWord (W
.<< (W
.+ (W
.fromInt exponentBias
, W
.one
), significandBits
))
163 val maxFinite
= R
.castFromWord (W
.- (exponentMask
, W
.one
))
164 val posInf
= R
.castFromWord exponentMask
166 val nan
= posInf
+ negInf
167 val posNan
= R
.castFromWord (W
.andb (R
.castToWord nan
, W
.notb signMask
))
168 val negNan
= R
.castFromWord (W
.orb (R
.castToWord nan
, signMask
))
176 val op != = not
o op ==
180 fun isNormal r
= class r
= NORMAL
183 if MLton
.Codegen
.isAMD64
orelse MLton
.Codegen
.isLLVM
orelse MLton
.Codegen
.isX86
187 case (class x
, class y
) of
190 |
(ZERO
, ZERO
) => true
196 else if isNan y
then x
202 else if isNan y
then x
205 fun sign (x
: real): int =
207 else if x
< zero
then ~
1
208 else if x
== zero
then 0
211 val signBit
= #sign
o toBits
213 fun sameSign (x
, y
) = signBit x
= signBit y
215 fun copySign (x
, y
) =
221 structure I
= IEEEReal
223 fun compareReal (x
, y
) =
225 else if x
> y
then I
.GREATER
226 else if x
== y
then I
.EQUAL
231 structure I
= IEEEReal
232 structure G
= General
235 case compareReal (x
, y
) of
237 | I
.GREATER
=> G
.GREATER
239 | I
.UNORDERED
=> raise IEEEReal
.Unordered
242 fun unordered (x
, y
) = isNan x
orelse isNan y
244 (* nextAfter for subnormal
and normal values works by converting
245 * the
real to a
word of equivalent size
and doing an increment
246 * or decrement on the
word. Because
of the way IEEE floating
247 * point numbers are represented
, word {de
,in}crement
248 * automatically does the right thing at the boundary between
249 * normals
and denormals
. Also
, convienently
,
250 * maxFinite
+1 = posInf
and minFinite
-1 = negInf
.
252 val nextAfter
: real * real -> real =
254 case (class r
, class t
) of
258 |
(ZERO
, ZERO
) => t (* want
"t", not
"r", to get the sign right
*)
259 |
(ZERO
, _
) => if t
> zero
then minPos
else ~minPos
263 else if (r
> t
) = (r
> zero
) then
264 R
.castFromWord (W
.- (R
.castToWord r
, W
.one
))
266 R
.castFromWord (W
.+ (R
.castToWord r
, W
.one
))
269 val one
= One
.make (fn () => ref (0 : C_Int
.t
))
273 INF
=> {exp
= 0, man
= x
}
274 | NAN
=> {exp
= 0, man
= nan
}
275 | ZERO
=> {exp
= 0, man
= x
}
276 | _
=> One
.use (one
, fn r
=>
278 val man
= R
.frexp (x
, r
)
280 {exp
= C_Int
.toInt (!r
), man
= man
}
284 fun fromManExp
{exp
, man
} =
285 (R
.ldexp (man
, C_Int
.fromInt exp
))
287 man
* (if Int.< (exp
, 0) then zero
else posInf
)
290 if MLton
.Codegen
.isX86
298 | _
=> fromManExp
{exp
= exp
, man
= man
}
301 val one
= One
.make (fn () => ref zero
)
305 INF
=> {frac
= if x
> zero
then zero
else ~zero
,
307 | NAN
=> {frac
= nan
, whole
= nan
}
311 One
.use (one
, fn int =>
312 (R
.modf (x
, int), !int))
313 (* Some platforms
' C libraries don
't get sign
of
317 if class y
= ZERO
andalso not (sameSign (x
, y
))
326 val realMod
= #frac
o split
330 else if isNan x
then raise Div
333 val realCeil
= R
.realCeil
334 val realFloor
= R
.realFloor
335 val realTrunc
= R
.realTrunc
337 (* Unfortunately
, libc round ties to zero instead
of even values
. *)
338 (* Fortunately
, if any rounding mode is supported
, it
's TO_NEAREST
. *)
339 val realRound
= fn r
=> IEEEReal
.withRoundingMode (TO_NEAREST
, fn () => R
.round r
)
346 | _
=> (case class y
of
350 | _
=> x
- realTrunc (x
/y
) * y
))
352 (* fromDecimal
, scan
, fromString
: decimal
-> binary conversions
*)
353 fun strtor (str
: NullString
.t
,
354 rounding_mode
: IEEEReal
.rounding_mode
) =
356 val rounding
: C_Int
.int =
357 case rounding_mode
of
363 Prim
.strtor (str
, rounding
)
366 fun fromDecimalWithRoundingMode
367 ({class
, digits
, exp
, sign
}: IEEEReal
.decimal_approx
,
368 rounding_mode
: IEEEReal
.rounding_mode
) =
374 then concat
["-", Int.toString (Int.~ exp
)]
375 else Int.toString exp
377 val str
= concat
[if sign
then "-" else "",
381 val n
= Int.+ (if sign
then 1 else 0,
382 Int.+ (4 (* "0." + "E" + "\000" *),
383 Int.+ (List.length digits
,
385 val a
= Array
.alloc n
386 fun upd (i
, c
) = (Array
.update (a
, i
, c
); Int.+ (i
, 1))
388 val i
= if sign
then upd (i
, #
"-") else i
389 val i
= upd (i
, #
"0")
390 val i
= upd (i
, #
".")
394 if Int.< (d
, 0) orelse Int.> (d
, 9)
396 else upd (i
, Char.chr (Int.+ (d
, Char.ord #
"0"))))
398 val i
= upd (i
, #
"E")
399 val i
= CharVector
.foldl (fn (c
, i
) => upd (i
, c
)) i exp
400 val _
= upd (i
, #
"\000")
401 val str
= Vector.unsafeFromArray a
402 val x
= strtor (NullString
.fromString str
, rounding_mode
)
408 INF
=> if sign
then negInf
else posInf
409 | NAN
=> if sign
then negNan
else posNan
411 | SUBNORMAL
=> doit ()
412 | ZERO
=> if sign
then negZero
else zero
)
416 fun fromDecimal da
= fromDecimalWithRoundingMode (da
, TO_NEAREST
)
418 fun scan reader state
=
419 case IEEEReal
.scan reader state
of
421 |
SOME (da
, state
) =>
422 SOME (valOf (fromDecimalWithRoundingMode
423 (da
, IEEEReal
.getRoundingMode ())),
426 val fromString
= StringCvt.scanString scan
428 (* toDecimal
, fmt
, toString
: binary
-> decimal conversions
. *)
429 datatype mode
= Fix | Gen | Sci
431 val one
= One
.make (fn () => ref (0: C_Int
.int))
433 fun gdtoa (x
: real, mode
: mode
, ndig
: int,
434 rounding_mode
: IEEEReal
.rounding_mode
) =
436 val mode
: C_Int
.int =
441 val ndig
: C_Int
.int = C_Int
.fromInt ndig
442 val rounding
: C_Int
.int =
443 case rounding_mode
of
449 One
.use (one
, fn decpt
=>
450 (Prim
.gdtoa (x
, mode
, ndig
, rounding
, decpt
),
451 C_Int
.toInt (!decpt
)))
455 fun toDecimal (x
: real): IEEEReal
.decimal_approx
=
461 | NAN
=> {class
= NAN
,
465 | ZERO
=> {class
= ZERO
,
471 val (cs
, exp
) = gdtoa (x
, Gen
, 0, TO_NEAREST
)
475 else loop (Int.- (i
, 1),
476 (Int.- (Char.ord (CUtil
.C_String
.sub (cs
, i
)),
479 val digits
= loop (Int.- (CUtil
.C_String
.length cs
, 1), [])
487 datatype realfmt
= datatype StringCvt.realfmt
490 fun fix (sign
: string, cs
: CUtil
.C_String
.t
, decpt
: int, ndig
: int): string =
492 val length
= CUtil
.C_String
.length cs
498 String.new (Int.~ decpt
, #
"0"),
499 CUtil
.C_String
.toString cs
,
500 String.new (Int.+ (Int.- (ndig
, length
),
509 String.tabulate (decpt
, fn i
=>
511 then CUtil
.C_String
.sub (cs
, i
)
515 then concat
[sign
, whole
]
522 val j
= Int.+ (i
, decpt
)
525 then CUtil
.C_String
.sub (cs
, j
)
529 concat
[sign
, whole
, ".", frac
]
533 fun sci (x
: real, ndig
: int): string =
535 val sign
= if x
< zero
then "~" else ""
537 gdtoa (x
, Sci
, Int.+ (1, ndig
), IEEEReal
.getRoundingMode ())
538 val length
= CUtil
.C_String
.length cs
539 val whole
= String.tabulate (1, fn _
=> CUtil
.C_String
.sub (cs
, 0))
550 then CUtil
.C_String
.sub (cs
, j
)
553 val exp
= Int.- (decpt
, 1)
558 then (Int.~ exp
, "~")
561 concat
[sign
, Int.toString exp
]
564 concat
[sign
, whole
, frac
, "E", exp
]
566 fun gen (x
: real, n
: int): string =
572 val ss
= Substring
.full (sci (x
, Int.- (n
, 1)))
574 fun isZero c
= c
= #
"0"
576 Substring
.string (Substring
.taker (not
o isE
) ss
)
577 val exp
= valOf (Int.fromString expS
)
580 (fn #
"." => "" | c
=> str c
)
581 (Substring
.string (Substring
.dropr isZero
582 (Substring
.takel (not
o isE
) ss
)))
583 val manSize
= String.size man
584 fun zeros i
= CharVector
.tabulate (i
, fn _
=> #
"0")
586 concat
[String.substring (man
, 0, i
),
587 ".", String.extract (man
, i
, NONE
)]
588 fun sci () = concat
[prefix
,
589 if manSize
= 1 then man
else dotAt
1,
596 if exp
>= (if manSize
= 1 then 3 else manSize
+ 3)
598 else if exp
>= manSize
- 1
599 then concat
[prefix
, man
, zeros (exp
- (manSize
- 1))]
601 then concat
[prefix
, dotAt (exp
+ 1)]
602 else if exp
>= (if manSize
= 1 then ~
2 else ~
3)
603 then concat
[prefix
, "0.", zeros (~exp
- 1), man
]
611 EXACT
=> IEEEReal
.toString
o toDecimal
618 if Primitive
.Controls
.safe
andalso Int.< (n
, 0)
624 val sign
= if x
< zero
then "~" else ""
626 gdtoa (x
, Fix
, n
, IEEEReal
.getRoundingMode ())
628 fix (sign
, cs
, decpt
, n
)
637 if Primitive
.Controls
.safe
andalso Int.< (n
, 1)
649 if Primitive
.Controls
.safe
andalso Int.< (n
, 0)
658 NAN
=> (* if signBit x
then "~nan" else *) "nan"
659 | INF
=> if x
> zero
then "inf" else "~inf"
664 val toString
= fmt (StringCvt.GEN NONE
)
666 (* Not all devices support all rounding modes
.
667 * However
, every device has ceil
/floor
/round
/trunc
.
669 fun safeConvert (m
, cvt
, x
) =
671 TO_POSINF
=> cvt (realCeil x
)
672 | TO_NEGINF
=> cvt (realFloor x
)
673 | TO_NEAREST
=> cvt (realRound x
)
674 | TO_ZERO
=> cvt (realTrunc x
)
677 fun 'a make
{fromIntUnsafe
: 'a
-> real,
678 toIntUnsafe
: real -> 'a
,
679 other
: {maxInt
': Word.word -> 'a
,
683 if Int.< (precision
, #precision
' other
) then
685 val trim
= Int.- (Int.- (#precision
' other
, precision
), 1)
686 val maxInt
' = (#maxInt
' other
) (Word.fromInt trim
)
687 val minInt
' = #minInt
' other
688 val maxInt
= fromIntUnsafe maxInt
'
689 val minInt
= fromIntUnsafe minInt
'
691 fn (m
: rounding_mode
) => fn x
=>
694 safeConvert (m
, toIntUnsafe
, x
)
701 raise Domain (* NaN
*)
705 val maxInt
' = (#maxInt
' other
) 0w0
706 val minInt
' = #minInt
' other
707 val maxInt
= fromIntUnsafe maxInt
'
708 val minInt
= fromIntUnsafe minInt
'
710 fn (m
: rounding_mode
) => fn x
=>
713 safeConvert (m
, toIntUnsafe
, x
)
715 if x
< maxInt
+ one
then
718 | TO_POSINF
=> raise Overflow
721 (* Depends on maxInt being odd
. *)
722 if x
- maxInt
>= half
then
730 if minInt
- one
< x
then
732 TO_NEGINF
=> raise Overflow
733 | TO_POSINF
=> minInt
'
736 (* Depends on minInt being even
. *)
737 if x
- minInt
< ~half
then
744 raise Domain (* NaN
*)
747 val (fromInt8
,toInt8
) =
748 make
{fromIntUnsafe
= R
.fromInt8Unsafe
,
749 toIntUnsafe
= R
.toInt8Unsafe
,
750 other
= {maxInt
' = fn w
=> Int8
.<< (Int8
.>> (Int8
.maxInt
', w
), w
),
751 minInt
' = Int8
.minInt
',
752 precision
' = Int8
.precision
'}}
753 val (fromInt16
,toInt16
) =
754 make
{fromIntUnsafe
= R
.fromInt16Unsafe
,
755 toIntUnsafe
= R
.toInt16Unsafe
,
756 other
= {maxInt
' = fn w
=> Int16
.<< (Int16
.>> (Int16
.maxInt
', w
), w
),
757 minInt
' = Int16
.minInt
',
758 precision
' = Int16
.precision
'}}
759 val (fromInt32
,toInt32
) =
760 make
{fromIntUnsafe
= R
.fromInt32Unsafe
,
761 toIntUnsafe
= R
.toInt32Unsafe
,
762 other
= {maxInt
' = fn w
=> Int32
.<< (Int32
.>> (Int32
.maxInt
', w
), w
),
763 minInt
' = Int32
.minInt
',
764 precision
' = Int32
.precision
'}}
765 val (fromInt64
,toInt64
) =
766 make
{fromIntUnsafe
= R
.fromInt64Unsafe
,
767 toIntUnsafe
= R
.toInt64Unsafe
,
768 other
= {maxInt
' = fn w
=> Int64
.<< (Int64
.>> (Int64
.maxInt
', w
), w
),
769 minInt
' = Int64
.minInt
',
770 precision
' = Int64
.precision
'}}
773 val fromIntInf
: IntInf
.int -> real =
778 then "-" ^
(IntInf
.toString (IntInf
.~ i
))
779 else IntInf
.toString i
780 val x
= strtor (NullString
.nullTerm str
,
781 IEEEReal
.getRoundingMode ())
786 val toIntInf
: rounding_mode
-> real -> LargeInt
.int =
789 INF
=> raise Overflow
790 | NAN
=> raise Domain
791 | ZERO
=> (0 : LargeInt
.int)
794 (* This round may turn x into an INF
, so we need to check the
799 TO_POSINF
=> realCeil x
800 | TO_NEGINF
=> realFloor x
801 | TO_NEAREST
=> realRound x
802 | TO_ZERO
=> realTrunc x
805 INF
=> raise Overflow
806 | _
=> valOf (IntInf
.fromString (fmt (StringCvt.FIX (SOME
0)) x
))
812 (type 'a t
= 'a
-> real
814 val fInt16
= fromInt16
815 val fInt32
= fromInt32
816 val fInt64
= fromInt64
817 val fIntInf
= fromIntInf
)
824 (type 'a t
= 'a
-> real
826 val fInt16
= fromInt16
827 val fInt32
= fromInt32
828 val fInt64
= fromInt64
829 val fIntInf
= fromIntInf
)
831 val fromLargeInt
= S
.f
836 (type 'a t
= rounding_mode
-> real -> 'a
841 val fIntInf
= toIntInf
)
848 (type 'a t
= rounding_mode
-> real -> 'a
853 val fIntInf
= toIntInf
)
858 val floor
= toInt TO_NEGINF
859 val ceil
= toInt TO_POSINF
860 val trunc
= toInt TO_ZERO
861 val round
= toInt TO_NEAREST
864 fun 'a make
{fromWordUnsafe
: 'a
-> real,
865 toWordUnsafe
: real -> 'a
,
866 other
: {maxWord
': Word.word -> 'a
,
870 if Int.<= (precision
, #wordSize other
)
872 val trim
= Int.- (#wordSize other
, precision
)
873 val maxWord
' = (#maxWord
' other
) (Word.fromInt trim
)
874 val maxWord
= fromWordUnsafe maxWord
'
875 val zeroWord
= #zeroWord other
877 fn (m
: rounding_mode
) => fn x
=>
879 INF
=> raise Overflow
880 | NAN
=> raise Domain
883 then safeConvert (m
, toWordUnsafe
, x
)
887 TO_NEGINF
=> raise Overflow
888 | TO_POSINF
=> zeroWord
889 | TO_ZERO
=> zeroWord
897 val maxWord
' = (#maxWord
' other
) 0w0
898 val maxWord
= fromWordUnsafe maxWord
'
899 val zeroWord
= #zeroWord other
901 fn (m
: rounding_mode
) => fn x
=>
903 INF
=> raise Overflow
904 | NAN
=> raise Domain
907 then safeConvert (m
, toWordUnsafe
, x
)
908 else if x
< maxWord
+ one
910 TO_NEGINF
=> maxWord
'
911 | TO_POSINF
=> raise Overflow
912 | TO_ZERO
=> maxWord
'
914 (* Depends on maxWord being odd
. *)
915 if x
- maxWord
>= half
921 TO_NEGINF
=> raise Overflow
922 | TO_POSINF
=> zeroWord
923 | TO_ZERO
=> zeroWord
931 val (fromWord8
,toWord8
) =
932 make
{fromWordUnsafe
= R
.fromWord8Unsafe
,
933 toWordUnsafe
= R
.toWord8Unsafe
,
934 other
= {maxWord
' = fn w
=> Word8.<< (Word8.>> (Word8.maxWord
', w
), w
),
935 wordSize
= Word8.wordSize
,
936 zeroWord
= Word8.zero
}}
937 val (fromWord16
,toWord16
) =
938 make
{fromWordUnsafe
= R
.fromWord16Unsafe
,
939 toWordUnsafe
= R
.toWord16Unsafe
,
940 other
= {maxWord
' = fn w
=> Word16
.<< (Word16
.>> (Word16
.maxWord
', w
), w
),
941 wordSize
= Word16
.wordSize
,
942 zeroWord
= Word16
.zero
}}
943 val (fromWord32
,toWord32
) =
944 make
{fromWordUnsafe
= R
.fromWord32Unsafe
,
945 toWordUnsafe
= R
.toWord32Unsafe
,
946 other
= {maxWord
' = fn w
=> Word32
.<< (Word32
.>> (Word32
.maxWord
', w
), w
),
947 wordSize
= Word32
.wordSize
,
948 zeroWord
= Word32
.zero
}}
949 val (fromWord64
,toWord64
) =
950 make
{fromWordUnsafe
= R
.fromWord64Unsafe
,
951 toWordUnsafe
= R
.toWord64Unsafe
,
952 other
= {maxWord
' = fn w
=> Word64
.<< (Word64
.>> (Word64
.maxWord
', w
), w
),
953 wordSize
= Word64
.wordSize
,
954 zeroWord
= Word64
.zero
}}
960 (type 'a t
= 'a
-> real
961 val fWord8
= fromWord8
962 val fWord16
= fromWord16
963 val fWord32
= fromWord32
964 val fWord64
= fromWord64
)
970 LargeWord_ChooseWordN
971 (type 'a t
= 'a
-> real
972 val fWord8
= fromWord8
973 val fWord16
= fromWord16
974 val fWord32
= fromWord32
975 val fWord64
= fromWord64
)
977 val fromLargeWord
= S
.f
982 (type 'a t
= rounding_mode
-> real -> 'a
984 val fWord16
= toWord16
985 val fWord32
= toWord32
986 val fWord64
= toWord64
)
992 LargeWord_ChooseWordN
993 (type 'a t
= rounding_mode
-> real -> 'a
995 val fWord16
= toWord16
996 val fWord32
= toWord32
997 val fWord64
= toWord64
)
999 val toLargeWord
= S
.f
1006 (* Patch functions to
handle out
-of-range args
. Many C math
1007 * libraries
do not
do what the SML Basis Spec requires
.
1012 if x
< ~one
orelse x
> one
1016 val acos
= patch acos
1017 val asin
= patch asin
1021 fun patch f x
= if x
< zero
then nan
else f x
1024 val log10
= patch log10
1027 (* The x86 doesn
't get exp right on infs
. *)
1029 if MLton
.Codegen
.isX86
1030 andalso let open MLton
.Platform
.Arch
in host
= X86
end
1033 INF
=> if x
> zero
then posInf
else zero
1037 (* The Cygwin math library doesn
't get pow right on some exceptional
1040 * The Linux math library doesn
't get
pow (x
, y
) right when x
< 0
1041 * and y is
large (but finite
).
1043 * So
, we define a pow function that gives the correct result on
1044 * exceptional cases
, and only calls the C pow
with x
> 0.
1046 fun isInt (x
: real): bool = x
== realFloor x
1048 (* isEven x assumes isInt x
. *)
1049 fun isEven (x
: real): bool = isInt (x
/ two
)
1051 fun isOddInt x
= isInt x
andalso not (isEven x
)
1053 fun isNeg x
= x
< zero
1060 else if x
< negOne
orelse x
> one
1061 then if isNeg y
then zero
else posInf
1062 else if negOne
< x
andalso x
< one
1063 then if isNeg y
then posInf
else zero
1064 else (* x
= 1 orelse x
= ~
1 *)
1079 else (* x
= posInf
*)
1080 if isNeg y
then zero
else posInf
1085 then copySign (posInf
, x
)
1094 then Prim
.Math
.pow (~ x
, y
)
1095 else negOne
* Prim
.Math
.pow (~ x
, y
)
1097 else Prim
.Math
.pow (x
, y
))
1103 | _
=> R
.Math
.cosh x
1109 | _
=> R
.Math
.sinh x
1113 INF
=> if x
> zero
then one
else negOne
1115 | _
=> R
.Math
.tanh x
1119 structure Real32
= Real (structure W
= Word32
1122 open Primitive
.Real32
1123 local open Primitive
.PackReal32
in
1124 val castToWord
= castToWord
1125 val castFromWord
= castFromWord
1128 structure Real64
= Real (structure W
= Word64
1131 open Primitive
.Real64
1132 local open Primitive
.PackReal64
in
1133 val castToWord
= castToWord
1134 val castFromWord
= castFromWord