cannam@127: (*
cannam@127:  * Copyright (c) 1997-1999 Massachusetts Institute of Technology
cannam@127:  * Copyright (c) 2003, 2007-14 Matteo Frigo
cannam@127:  * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
cannam@127:  *
cannam@127:  * This program is free software; you can redistribute it and/or modify
cannam@127:  * it under the terms of the GNU General Public License as published by
cannam@127:  * the Free Software Foundation; either version 2 of the License, or
cannam@127:  * (at your option) any later version.
cannam@127:  *
cannam@127:  * This program is distributed in the hope that it will be useful,
cannam@127:  * but WITHOUT ANY WARRANTY; without even the implied warranty of
cannam@127:  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cannam@127:  * GNU General Public License for more details.
cannam@127:  *
cannam@127:  * You should have received a copy of the GNU General Public License
cannam@127:  * along with this program; if not, write to the Free Software
cannam@127:  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
cannam@127:  *
cannam@127:  *)
cannam@127: 
cannam@127: (* The generator keeps track of numeric constants in symbolic
cannam@127:    expressions using the abstract number type, defined in this file.
cannam@127: 
cannam@127:    Our implementation of the number type uses arbitrary-precision
cannam@127:    arithmetic from the built-in Num package in order to maintain an
cannam@127:    accurate representation of constants.  This allows us to output
cannam@127:    constants with many decimal places in the generated C code,
cannam@127:    ensuring that we will take advantage of the full precision
cannam@127:    available on current and future machines.
cannam@127: 
cannam@127:    Note that we have to write our own routine to compute roots of
cannam@127:    unity, since the Num package only supplies simple arithmetic.  The
cannam@127:    arbitrary-precision operations in Num look like the normal
cannam@127:    operations except that they have an appended slash (e.g. +/ -/ */
cannam@127:    // etcetera). *)
cannam@127: 
cannam@127: open Num
cannam@127: 
cannam@127: type number = N of num
cannam@127: 
cannam@127: let makeNum n = N n
cannam@127: 
cannam@127: (* decimal digits of precision to maintain internally, and to print out: *)
cannam@127: let precision = 50
cannam@127: let print_precision = 45
cannam@127: 
cannam@127: let inveps = (Int 10) **/ (Int precision)
cannam@127: let epsilon = (Int 1) // inveps
cannam@127: 
cannam@127: let pinveps = (Int 10) **/ (Int print_precision)
cannam@127: let pepsilon = (Int 1) // pinveps
cannam@127: 
cannam@127: let round x = epsilon */ (round_num (x */ inveps))
cannam@127: 
cannam@127: let of_int n = N (Int n)
cannam@127: let zero = of_int 0
cannam@127: let one = of_int 1
cannam@127: let two = of_int 2
cannam@127: let mone = of_int (-1)
cannam@127: 
cannam@127: (* comparison predicate for real numbers *)
cannam@127: let equal (N x) (N y) = (* use both relative and absolute error *)
cannam@127:   let absdiff = abs_num (x -/ y) in
cannam@127:   absdiff <=/ pepsilon ||
cannam@127:   absdiff <=/ pepsilon */ (abs_num x +/ abs_num y)
cannam@127: 
cannam@127: let is_zero = equal zero
cannam@127: let is_one = equal one
cannam@127: let is_mone = equal mone
cannam@127: let is_two = equal two
cannam@127: 
cannam@127: 
cannam@127: (* Note that, in the following computations, it is important to round
cannam@127:    to precision epsilon after each operation.  Otherwise, since the
cannam@127:    Num package uses exact rational arithmetic, the number of digits
cannam@127:    quickly blows up. *)
cannam@127: let mul (N a) (N b) = makeNum (round (a */ b)) 
cannam@127: let div (N a) (N b) = makeNum (round (a // b))
cannam@127: let add (N a) (N b) = makeNum (round (a +/ b)) 
cannam@127: let sub (N a) (N b) = makeNum (round (a -/ b))
cannam@127: 
cannam@127: let negative (N a) = (a </ (Int 0))
cannam@127: let negate (N a) = makeNum (minus_num a)
cannam@127: 
cannam@127: let greater a b = negative (sub b a)
cannam@127: 
cannam@127: let epsilonsq = epsilon */ epsilon
cannam@127: let epsilonsq2 =  (Int 100) */ epsilonsq
cannam@127: 
cannam@127: let sqr a = a */ a
cannam@127: let almost_equal (N a) (N b) = (sqr (a -/ b)) <=/ epsilonsq2
cannam@127: 
cannam@127: (* find square root by Newton's method *)
cannam@127: let sqrt a =
cannam@127:   let rec sqrt_iter guess =
cannam@127:     let newguess = div (add guess (div a guess)) two in
cannam@127:     if (almost_equal newguess guess) then newguess
cannam@127:     else sqrt_iter newguess
cannam@127:   in sqrt_iter (div a two)
cannam@127: 
cannam@127: let csub (xr, xi) (yr, yi) = (round (xr -/ yr), round (xi -/ yi))
cannam@127: let cdiv (xr, xi) r = (round (xr // r), round (xi // r))
cannam@127: let cmul (xr, xi) (yr, yi) = (round (xr */ yr -/ xi */ yi),
cannam@127:                               round (xr */ yi +/ xi */ yr))
cannam@127: let csqr (xr, xi) = (round (xr */ xr -/ xi */ xi), round ((Int 2) */ xr */ xi))
cannam@127: let cabssq (xr, xi) = xr */ xr +/ xi */ xi
cannam@127: let cconj (xr, xi) = (xr, minus_num xi)
cannam@127: let cinv x = cdiv (cconj x) (cabssq x)
cannam@127: 
cannam@127: let almost_equal_cnum (xr, xi) (yr, yi) =
cannam@127:     (cabssq (xr -/ yr,xi -/ yi)) <=/ epsilonsq2
cannam@127: 
cannam@127: (* Put a complex number to an integer power by repeated squaring: *)
cannam@127: let rec ipow_cnum x n =
cannam@127:     if (n == 0) then
cannam@127:       (Int 1, Int 0)
cannam@127:     else if (n < 0) then
cannam@127:       cinv (ipow_cnum x (- n))
cannam@127:     else if (n mod 2 == 0) then
cannam@127:       ipow_cnum (csqr x) (n / 2)
cannam@127:     else
cannam@127:       cmul x (ipow_cnum x (n - 1))
cannam@127: 
cannam@127: let twopi = 6.28318530717958647692528676655900576839433879875021164194989
cannam@127: 
cannam@127: (* Find the nth (complex) primitive root of unity by Newton's method: *)
cannam@127: let primitive_root_of_unity n =
cannam@127:     let rec root_iter guess =
cannam@127:         let newguess = csub guess (cdiv (csub guess
cannam@127:                                          (ipow_cnum guess (1 - n)))
cannam@127:                                    (Int n)) in
cannam@127:             if (almost_equal_cnum guess newguess) then newguess
cannam@127:             else root_iter newguess
cannam@127:     in let float_to_num f = (Int (truncate (f *. 1.0e9))) // (Int 1000000000)
cannam@127:     in root_iter (float_to_num (cos (twopi /. (float n))),
cannam@127: 		  float_to_num (sin (twopi /. (float n)))) 
cannam@127: 
cannam@127: let cexp n i =
cannam@127:     if ((i mod n) == 0) then
cannam@127:       (one,zero)
cannam@127:     else
cannam@127:       let (n2,i2) = Util.lowest_terms n i
cannam@127:       in let (c,s) = ipow_cnum (primitive_root_of_unity n2) i2
cannam@127:       in (makeNum c, makeNum s)
cannam@127: 
cannam@127: let to_konst (N n) =
cannam@127:   let f = float_of_num n in
cannam@127:   let f' = if f < 0.0 then f *. (-1.0) else f in
cannam@127:   let f2 = if (f' >= 1.0) then (f' -. (float (truncate f'))) else f'
cannam@127:   in let q = string_of_int (truncate(f2 *. 1.0E9))
cannam@127:   in let r = "0000000000" ^ q
cannam@127:   in let l = String.length r 
cannam@127:   in let prefix = if (f < 0.0) then "KN" else "KP" in
cannam@127:   if (f' >= 1.0) then
cannam@127:     (prefix ^ (string_of_int (truncate f')) ^ "_" ^ 
cannam@127:      (String.sub r (l - 9) 9))
cannam@127:   else
cannam@127:     (prefix ^ (String.sub r (l - 9) 9))
cannam@127: 
cannam@127: let to_string (N n) = approx_num_fix print_precision n
cannam@127: 
cannam@127: let to_float (N n) = float_of_num n
cannam@127: