Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/PervEnv/Basis/ieee-real.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/PervEnv/Basis/ieee-real.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 89 - (view) (download)

1 : monnier 89 (* ieee-real.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 AT&T Bell Laboratories.
4 :     *)
5 :    
6 :     structure IEEEReal : IEEE_REAL =
7 :     struct
8 :    
9 :     (* this may cause portability problems to 64-bit systems *)
10 :     structure Int = Int31
11 :    
12 :     exception Unordered
13 :    
14 :     datatype real_order = LESS | EQUAL | GREATER | UNORDERED
15 :    
16 :     datatype nan_mode = QUIET | SIGNALLING
17 :    
18 :     datatype float_class
19 :     = NAN of nan_mode
20 :     | INF
21 :     | ZERO
22 :     | NORMAL
23 :     | SUBNORMAL
24 :    
25 :     datatype rounding_mode
26 :     = TO_NEAREST
27 :     | TO_NEGINF
28 :     | TO_POSINF
29 :     | TO_ZERO
30 :    
31 :     val ctlRoundingMode : int option -> int =
32 :     CInterface.c_function "SMLNJ-Math" "ctlRoundingMode"
33 :    
34 :     fun intToRM 0 = TO_NEAREST
35 :     | intToRM 1 = TO_ZERO
36 :     | intToRM 2 = TO_POSINF
37 :     | intToRM 3 = TO_NEGINF
38 :    
39 :     fun setRoundingMode' m = (ctlRoundingMode (SOME m); ())
40 :    
41 :     fun setRoundingMode TO_NEAREST = setRoundingMode' 0
42 :     | setRoundingMode TO_ZERO = setRoundingMode' 1
43 :     | setRoundingMode TO_POSINF = setRoundingMode' 2
44 :     | setRoundingMode TO_NEGINF = setRoundingMode' 3
45 :    
46 :     fun getRoundingMode () = intToRM (ctlRoundingMode NONE)
47 :    
48 :     type decimal_approx = {
49 :     kind : float_class,
50 :     sign : bool,
51 :     digits : int list,
52 :     exp : int
53 :     }
54 :    
55 :     fun toString {kind, sign, digits, exp} = let
56 :     fun fmtExp 0 = []
57 :     | fmtExp i = ["E", Int.toString i]
58 :     fun fmtDigits ([], tail) = tail
59 :     | fmtDigits (d::r, tail) = (Int.toString d) :: fmtDigits(r, tail)
60 :     in
61 :     case (sign, kind, digits)
62 :     of (true, ZERO, _) => "~0.0"
63 :     | (false, ZERO, _) => "0.0"
64 :     | (true, (NORMAL|SUBNORMAL), []) => "~0.0"
65 :     | (false, (NORMAL|SUBNORMAL), []) => "0.0"
66 :     | (true, (NORMAL|SUBNORMAL), _) =>
67 :     String.concat("~0." :: fmtDigits(digits, fmtExp exp))
68 :     | (false, (NORMAL|SUBNORMAL), _) =>
69 :     String.concat("0." :: fmtDigits(digits, fmtExp exp))
70 :     | (true, INF, _) => "~inf"
71 :     | (false, INF, _) => "inf"
72 :     | (_, NAN _, []) => "nan"
73 :     | (_, NAN _, _) => String.concat("nan(" :: fmtDigits(digits, [")"]))
74 :     (* end case *)
75 :     end
76 :    
77 :     (** TODO: implement fromString **)
78 :     fun fromString s = NONE
79 :    
80 :     end;
81 :    
82 :    
83 :     (*
84 :     * $Log: ieee-real.sml,v $
85 :     * Revision 1.1.1.1 1998/04/08 18:40:04 george
86 :     * Version 110.5
87 :     *
88 :     *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0