[hcoop/debian/mlton.git] / lib / mlton / basic / real.sml

(* Copyright (C) 1999-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh
 *    Jagannathan, and Stephen Weeks.
 *
 * MLton is released under a BSD-style license.
 * See the file MLton-LICENSE for details.
 *)

functor Real (Real: sig
                       include PERVASIVE_REAL
                       val one: real
                       val zero: real
                    end): REAL =
struct

type real = Real.real

structure In = In0

structure R = 
   OrderedRing (structure R = 
                   RingWithIdentity (structure R =
                                        Ring (type t = real
                                              open Real
                                              val layout = Layout.str o toString
                                              val equals = Real.==)
                                     open R Real)
                open R Real
                val {compare, ...} =
                   Relation.lessEqual {< = op <, equals = equals})

structure F = OrderedField (open R Real
                            fun inverse x = one / x)
open F Real
open Math

exception Input 
fun input i =
   case fromString (In.inputToSpace i) of
      SOME x => x
    | NONE => raise Input

local
   open Real
in
   val fromInt = fromInt
   val fromIntInf = fromLargeInt
   val toIntInf = toLargeInt IEEEReal.TO_NEAREST
end

structure Format =
   struct
      open StringCvt
      type t = realfmt

      val exact = EXACT
      val sci = SCI
      val fix = FIX
      val gen = GEN
   end

fun format (x, f) = Real.fmt f x

fun choose(n, k) =
   let
      val k = max (k, n - k)
   in
      prodFromTo {from = add1 k,
                  term = fn i => i,
                  to = n}
      / factorial (n - k)
   end

fun log (base, arg) = ln arg / ln base

val ln2 = ln two

fun log2 x = ln x / ln2

fun realPower(m, n) = exp(n * ln m)

val ceiling = ceil

structure Class =
   struct
      datatype t = datatype IEEEReal.float_class
   end

end

structure Real64 = Real (open Real64
                         val one: real = 1.0
                         val zero: real = 0.0)
structure Real = Real64
structure Real32 = Real (open Real32
                         val one: real = 1.0
                         val zero: real = 0.0)
Commit	Line	Data
7f918cf1 CE	1	(* Copyright (C) 1999-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh
	2	* Jagannathan, and Stephen Weeks.
	3	*
	4	* MLton is released under a BSD-style license.
	5	* See the file MLton-LICENSE for details.
	6	*)
	7
	8	functor Real (Real: sig
	9	include PERVASIVE_REAL
	10	val one: real
	11	val zero: real
	12	end): REAL =
	13	struct
	14
	15	type real = Real.real
	16
	17	structure In = In0
	18
	19	structure R =
	20	OrderedRing (structure R =
	21	RingWithIdentity (structure R =
	22	Ring (type t = real
	23	open Real
	24	val layout = Layout.str o toString
	25	val equals = Real.==)
	26	open R Real)
	27	open R Real
	28	val {compare, ...} =
	29	Relation.lessEqual {< = op <, equals = equals})
	30
	31	structure F = OrderedField (open R Real
	32	fun inverse x = one / x)
	33	open F Real
	34	open Math
	35
	36	exception Input
	37	fun input i =
	38	case fromString (In.inputToSpace i) of
	39	SOME x => x
	40	\| NONE => raise Input
	41
	42	local
	43	open Real
	44	in
	45	val fromInt = fromInt
	46	val fromIntInf = fromLargeInt
	47	val toIntInf = toLargeInt IEEEReal.TO_NEAREST
	48	end
	49
	50	structure Format =
	51	struct
	52	open StringCvt
	53	type t = realfmt
	54
	55	val exact = EXACT
	56	val sci = SCI
	57	val fix = FIX
	58	val gen = GEN
	59	end
	60
	61	fun format (x, f) = Real.fmt f x
	62
	63	fun choose(n, k) =
	64	let
65	val k = max (k, n - k)
66	in
67	prodFromTo {from = add1 k,
68	term = fn i => i,
69	to = n}
70	/ factorial (n - k)
71	end
72
73	fun log (base, arg) = ln arg / ln base
74
75	val ln2 = ln two
76
77	fun log2 x = ln x / ln2
78
79	fun realPower(m, n) = exp(n * ln m)
80
81	val ceiling = ceil
82
83	structure Class =
84	struct
85	datatype t = datatype IEEEReal.float_class
86	end
87
88	end
89
90	structure Real64 = Real (open Real64
91	val one: real = 1.0
92	val zero: real = 0.0)
93	structure Real = Real64
94	structure Real32 = Real (open Real32
95	val one: real = 1.0
96	val zero: real = 0.0)