lustrec / src / real.ml @ ef598ac3
History  View  Annotate  Download (1.43 KB)
1 
(* (a, b, c) means a * 10^b. c is the original string *) 

2 
type t = Q.t * int * string 
3  
4 
let pp fmt (c, e, s) = 
5 
Format.fprintf fmt "%s%s" 
6 
s 
7 
(if String.get s (1 + String.length s) = '.' then "0" else "") 
8  
9 
let pp_ada fmt (c, e, s) = 
10 
Format.fprintf fmt "%s.0*1.0e%i" (Q.to_string c) e 
11 

12 
let create m e s = Q.of_string m, e, s 
13  
14 
let create_q q s = q, 0, s 
15 

16 
(* 
17 
let to_num (c, e, s) = 
18 
let num_10 = Num.num_of_int 10 in 
19 
Num.(c // (num_10 **/ (num_of_int e))) 
20 
*) 
21 

22 
let rec to_q (c, e, s) = 
23 
if e = 0 then 
24 
c 
25 
else 
26 
if e > 0 then Q.div (to_q (c,e1,s)) (Q.of_int 10) 
27 
else (* if exp<0 then *) 
28 
Q.mul 
29 
(to_q (c,e+1,s)) 
30 
(Q.of_int 10) 
31  
32 
let to_num = to_q 
33 

34 
let to_string (_, _, s) = s 
35 

36 
let eq r1 r2 = 
37 
Q.equal (to_q r1) (to_q r2) 
38 

39 

40 
let num_binop op r1 r2 = 
41 
let n1 = to_num r1 and n2 = to_num r2 in 
42 
op n1 n2 
43 

44 
let arith_binop op r1 r2 = 
45 
let r = num_binop op r1 r2 in 
46 
create_q r (Q.to_string r) 
47 

48 
let add = arith_binop Q.add 
49 
let minus = arith_binop Q.sub 
50 
let times = arith_binop Q.mul 
51 
let div = arith_binop Q.div 
52  
53 
let uminus (c, e, s) = Q.neg c, e, "" ^ s 
54  
55 
let lt = num_binop (Q.(<)) 
56 
let le = num_binop (Q.(<=)) 
57 
let gt = num_binop (Q.(>)) 
58 
let ge = num_binop (Q.(>=)) 
59 
let diseq = num_binop (Q.(<>)) 
60 
let eq = num_binop (Q.(=)) 
61  
62 
let zero = Q.zero, 0, "0.0" 
63  
64 
let is_zero r = Q.equal (to_num r) Q.zero 
65 
let is_one r = Q.equal (to_num r) Q.one 