-
Notifications
You must be signed in to change notification settings - Fork 8
/
decimal-mlton.sml
executable file
·124 lines (111 loc) · 3.87 KB
/
decimal-mlton.sml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
(* -*- mode: sml; mode: font-lock; tab-width: 4; insert-tabs-mode: nil; indent-tabs-mode: nil -*- *)
(*
* The following licensing terms and conditions apply and must be
* accepted in order to use the Reference Implementation:
*
* 1. This Reference Implementation is made available to all
* interested persons on the same terms as Ecma makes available its
* standards and technical reports, as set forth at
* http://www.ecma-international.org/publications/.
*
* 2. All liability and responsibility for any use of this Reference
* Implementation rests with the user, and not with any of the parties
* who contribute to, or who own or hold any copyright in, this Reference
* Implementation.
*
* 3. THIS REFERENCE IMPLEMENTATION IS PROVIDED BY THE COPYRIGHT
* HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
* LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
* BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
* OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
* IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
* End of Terms and Conditions
*
* Copyright (c) 2007 Adobe Systems Inc., The Mozilla Foundation, Opera
* Software ASA, and others.
*)
(* *)
structure DecimalNative = struct
open DecimalParams
val decop = _import "decop" : int * int * int * char array * char array * char array -> int;
fun rmToInt (rm:ROUNDING_MODE)
: int =
(case rm of
Ceiling => 0
| Floor => 1
| Up => 2
| Down => 3
| HalfUp => 4
| HalfDown => 5
| HalfEven => 6);
fun opToInt (dop:DECIMAL_OPERATOR)
: int =
(case dop of
Abs => 0
| Add => 1
| Compare => 2
| CompareTotal => 3
| Divide => 4
| DivideInteger => 5
| Exp => 6
| Ln => 7
| Log10 => 8
| Max => 9
| Min => 10
| Minus => 11
| Multiply => 12
| Normalize => 13
| Plus => 14
| Power => 15
| Quantize => 16
| Remainder => 17
| RemainderNear => 18
| Rescale => 19
| SameQuantum => 20
| SquareRoot => 21
| Subtract => 22
| ToIntegralValue => 23);
val DECIMAL128_String = 43; (* from decimal128.h *)
fun arrayToList a = Array.foldr (op ::) [] a;
fun takeUntil p [] = []
| takeUntil p (x::ls) = if (p x)
then []
else x::(takeUntil p ls);
fun stringToBuffer s =
Array.fromList ((String.explode s) @ [#"\000"])
fun bufferToString b =
String.implode (takeUntil (fn c => c = #"\000") (arrayToList b));
fun decErrorString n =
(case n of
1 => "bad precision number"
| 2 => "bad rounding mode"
| 3 => "bad operator code"
| 4 => "invalid syntax"
| 5 => "out of memory"
| 6 => "decNumber completely wedged"
| _ => "unknown error")
fun runOp (precision:int)
(mode:ROUNDING_MODE)
(operator:DECIMAL_OPERATOR)
(left:DEC)
(right:DEC option)
: DEC =
let
val buffer = Array.tabulate (DECIMAL128_String, fn _ => #"\000")
val Dec left = left
val right = (case right of
NONE => "0"
| SOME (Dec s) => s)
in
(case decop (precision, rmToInt mode, opToInt operator, stringToBuffer left, stringToBuffer right, buffer) of
0 => Dec (bufferToString buffer)
| n => raise DecimalException (decErrorString n))
end;
end;