creal-0.7/0002755000246300002640000000000010330104265013560 5ustar filliatrdemons00000000000000creal-0.7/creal.mli0000644000246300002640000000641710330104265015357 0ustar filliatrdemons00000000000000(* * Exact real arithmetic (Constructive reals). * Copyright (C) 2000 Jean-Christophe FILLIATRE * * This software is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License version 2, as published by the Free Software Foundation. * * This software is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * See the GNU Library General Public License version 2 for more details * (enclosed in the file LGPL). *) (*i $Id: creal.mli,v 1.22 2005/10/26 09:25:06 filliatr Exp $ i*) (*s {\bf Constructive reals} are implemented by the following abstract datatype [t]. If [x] is a constructive real, then the function call [approx x n] returns an approximation of [x] up to $4^{-n}$, as an arbitrary precision integer $x_n$ such that $|4^n\cdot x - x_n| < 1$. *) open Gmp type t val approx : t -> int -> Z.t val msd : t -> int (*s Basic operations. *) val add : t -> t -> t val neg : t -> t val sub : t -> t -> t val abs : t -> t val mul : t -> t -> t val inv : t -> t val div : t -> t -> t val pow_int : t -> int -> t val root : int -> t -> t val sqrt : t -> t (*s Transcendental functions. [log ~base:x y] is $\log_x(y)$. *) val ln : t -> t val log : base:t -> t -> t val exp : t -> t val pow : t -> t -> t (*s Trigonometric functions. *) val sin : t -> t val cos : t -> t val tan : t -> t val arcsin : t -> t val arccos : t -> t val arctan : t -> t (*s [arctan_reciproqual n] is $\arctan(1/n)$, but is more efficient than using [arctan]. *) val arctan_reciproqual : int -> t (*s Hyperbolic functions. *) val sinh : t -> t val cosh : t -> t val tanh : t -> t val arcsinh : t -> t val arccosh : t -> t val arctanh : t -> t (*s Some constants. *) val zero : t val one : t val two : t val pi : t val half_pi : t val e : t (*s Comparisons. [cmp] is absolute comparison: it may not terminate and only returns [-1] or [+1]. [rel_cmp] is relative comparison, up to $4^{-k}$, and it returns [-1], [0] or [+1]. *) val cmp : t -> t -> int val rel_cmp : int -> t -> t -> int val min : t -> t -> t val max : t -> t -> t (*s Coercions. [to_q] and [to_float] expect a precision. [to_float x n] returns the best floating point representation of the rational $\ap{x}{n} / 4^n$. [of_string] expects a base as second argument. *) val of_int : int -> t val of_z : Z.t -> t val of_q : Q.t -> t val of_float : float -> t val of_string : ?radix:int -> string -> t val to_float : t -> int -> float val to_q : t -> int -> Q.t (*s Coercion to type [string]. Given a decimal precision [p], [to_string x p] returns a decimal approximation [d] of [x] with either [p] digits such that $|d - x| < 10^{-p}$, or [p+1] digits such that $|d - x| < 10^{-p-1}$. [to_beautiful_string] returns the same decimal number but with digits packed 5 by 5. *) val to_string : t -> int -> string val to_beautiful_string : t -> int -> string (*s Format pretty-printer. *) val print : Format.formatter -> t -> unit val set_print_precision : int -> unit (*s Infix notations. *) module Infixes : sig val ( +! ) : t -> t -> t val ( -! ) : t -> t -> t val ( *! ) : t -> t -> t val ( /! ) : t -> t -> t end creal-0.7/creal.ml0000644000246300002640000005605410330104265015210 0ustar filliatrdemons00000000000000(* * Exact real arithmetic (Constructive reals). * Copyright (C) 2000 Jean-Christophe FILLIATRE * * This software is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License version 2, as published by the Free Software Foundation. * * This software is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * See the GNU Library General Public License version 2 for more details * (enclosed in the file LGPL). *) (*i $Id: creal.ml,v 1.36 2005/10/27 07:57:02 filliatr Exp $ i*) (*i*) open Gmp (*i*) (*s This module implements constructive reals (exact real numbers), following the algorithms given in Valérie Ménissier-Morain's thesis (\small\verb!http://www-calfor.lip6.fr/~vmm/!). In the following, pages refer to this document. *) (*s {\bf Representation.} A constructive real is represented by an approximation function (field [approximate]). If $x$ is a real number, its approximation function applied to an integer $n$ (in type [int]) returns an integer $\ap{x}{n}$ (in type [Z.t]) such that $|4^n\cdot x - \ap{x}{n}| < 1$. For efficiency, we add a field [cache] to keep the best approximation computed so far. (Notice that it is safe to use type [int] for the number of digits, since an integer with a number of digits exceeding the capacity of machine integers would exceed the memory capacity.) The field [msd] is a cache for the most significant digit (see section~\ref{msd} below). *) type t = { mutable cache : (int * Z.t) option; mutable msd : int option; approximate : int -> Z.t } let create f = { cache = None; msd = None; approximate = f } (*s Computing the approximation of [x] to precision [n] is easy: either we have already computed a better approximation and the result is just a ``shift'' of that value (Property 6 page 46), or we compute [x.approximate n] and we cache its result before returning it. *) let fdiv_Bexp z n = if n == 0 then z else if n > 0 then Z.fdiv_q_2exp z (n + n) else Z.mul2exp z (-(n + n)) (*i let max_prec = ref 0 let _ = at_exit (fun () -> Printf.printf "max_prec=%d\n" !max_prec) i*) let approx x n = let compute () = let z = x.approximate n in x.cache <- Some (n,z); z in match x.cache with | None -> compute () | Some (m,a) -> if n <= m then fdiv_Bexp a (m - n) else compute () (*s Some useful constants in [Z.t] and [Q.t]. *) let z_zero = Z.from_int 0 let z_one = Z.from_int 1 let z_two = Z.from_int 2 let z_three = Z.from_int 3 let z_four = Z.from_int 4 let q_half = Q.from_ints 1 2 let q_zero = Q.from_ints 0 1 let q_one = Q.from_ints 1 1 let q_two = Q.from_ints 2 1 let q_four = Q.from_ints 4 1 (*s Utility functions over [Z.t] and [Q.t]. *) let z_gt x y = Z.cmp x y > 0 let z_le x y = Z.cmp x y <= 0 let z_between lb x up = z_le lb x && z_le x up let z_even x = (Z.cmp (Z.cdiv_r_ui x 2) z_zero) == 0 let q_max q1 q2 = if Q.cmp q1 q2 >= 0 then q1 else q2 let q_abs q = if Q.sgn q < 0 then Q.neg q else q (*s Roundings. Floor, ceil and Gau\ss\ rounding over [Q.t]. The Gau\ss\ rounding of $x$, written $\gauss{x}$, is the (only) integer such that $\gauss{x} - \half \le x < \gauss{x} + \half$. *) let q_floor q = Z.fdiv_q (Q.get_num q) (Q.get_den q) let q_ceil q = Z.cdiv_q (Q.get_num q) (Q.get_den q) let gauss_round q = let q' = Q.add q q_half in Z.fdiv_q (Q.get_num q') (Q.get_den q') let gauss_round_z_over_4 z = Z.fdiv_q_2exp (Z.add_ui z 2) 2 (*s Addition (Algorithm 2 page 50). We have $\ap{(x+y)}{n} = \lfloor(\ap{x}{n+1}+\ap{y}{n+1})/4\rceil$. We do not try to cache a value for [x+y] given the cached values for [x] and [y], if any, since it may require some computation (some shifts). Moreover, this is exactly what will be done by the first call to [approx] on [x+y] if the precision asked is less than $min(x,y)-2$. *) let add x y = create (function n -> let sn = succ n in gauss_round_z_over_4 (Z.add (approx x sn) (approx y sn))) let (+!) = add (*s Negation is immediate and subtraction is the composition of addition and negation (Algorithm 3 page 51). The cached value for [x] is immediatly cached in [-x] (at no cost). *) let cache_neg = function | None -> None | Some (n,a) -> Some (n, Z.neg a) let neg x = { cache = cache_neg x.cache; msd = x.msd; approximate = function n -> Z.neg (approx x n) } let sub x y = x +! (neg y) let (-!) = sub (*s Absolute value. *) let abs x = create (function n -> Z.abs (approx x n)) (*s Most significant digit ([msd], Definition 9 page 47). \label{msd} It is defined by $$\msd{x} = \min\ \{n\in Z ~|~ |x_n|>1 \}$$ Note that it does not terminate in 0. *) let compute_msd x = let rec look_up n = (* $|\ap{x}{n-1}| \le 1$ *) let xn = Z.abs (approx x n) in if z_gt xn z_one then n else look_up (succ n) and look_down n = (* $|\ap{x}{n+1}| > 1$ *) let xn = Z.abs (approx x n) in if z_gt xn z_one then look_down (pred n) else succ n in let x0 = Z.abs (approx x 0) in if z_gt x0 z_one then look_down (-1) else look_up 1 let msd x = match x.msd with | None -> let m = compute_msd x in x.msd <- Some m; m | Some m -> m (*s Version of [msd] with a maximal bound on the iteration process (used in function [mul] to avoid non-termination when multiplicating by 0). *) let msd_with_max m x = let rec look_up n = if n >= m then n else let xn = Z.abs (approx x n) in if z_gt xn z_one then n else look_up (succ n) and look_down n = let xn = Z.abs (approx x n) in if z_gt xn z_one then look_down (pred n) else succ n in let x0 = Z.abs (approx x 0) in if z_gt x0 z_one then look_down (-1) else look_up 1 (*s [mul_Bexp] and [div_Bexp] respectively multiplies and divides an integer by $B^n$ (works whatever the sign of [n] is). The result is a rational. *) let mul_Bexp z n = if n == 0 then Q.from_z z else if n > 0 then Q.from_z (Z.mul2exp z (n + n)) else Q.from_zs z (Z.mul2exp z (-(n + n))) let bexp n = mul_Bexp z_one n let div_Bexp z n = if n == 0 then Q.from_z z else if n > 0 then Q.from_zs z (Z.mul2exp z_one (n + n)) else Q.from_z (Z.mul2exp z (-(n + n))) (*s Multiplication (Algorithm 4 page 51). *) let mul x y = create (function n -> let d = (n + 2) / 2 in let msd' = msd_with_max (n + 3 - d) in let px = max (n - (msd' y) + 3) d and py = max (n - (msd' x) + 3) d in let xpx = approx x px and ypy = approx y py in let z = gauss_round (div_Bexp (Z.add_ui (Z.abs (Z.mul xpx ypy)) 1) (px + py - n)) in if Z.sgn xpx = Z.sgn ypy then z else Z.neg z) let ( *! ) = mul (*s Inverse (Algorithm 5 page 53) and division. *) let inv x = create (function n -> let msdx = msd x in if n <= -msdx then z_zero else let k = n + 2 * msdx + 1 in let xk = approx x k in let q = Q.div (bexp (k + n)) (Q.from_z xk) in if z_gt xk z_one then q_ceil q else q_floor q) let div x y = x *! (inv y) let (/!) = div (*s Square root (Algorithm 6 page 56). *) let sqrt x = create (function n -> let x2n = approx x (n + n) in if Z.sgn x2n < 0 then invalid_arg "Creal.sqrt"; Z.sqrt x2n) (*s Coercions from integers and rationals (Algorithm 1 page 49) and coercion to rationals. *) let fmul_Bexp q n = if n == 0 then q_floor q else if n > 0 then Z.fdiv_q (Z.mul2exp (Q.get_num q) (n + n)) (Q.get_den q) else q_floor (Q.div q (Q.from_z (Z.mul2exp z_one (-(n + n))))) let of_z z = { cache = Some (0,z); msd = None; approximate = function n -> fmul_Bexp (Q.from_z z) n } let of_q q = create (fmul_Bexp q) let to_q x n = let xn = approx x n in Q.div (Q.from_z xn) (bexp n) let of_int n = of_z (Z.from_int n) let zero = of_int 0 let one = of_int 1 let two = of_int 2 let four = of_int 4 (*s Power of a real to a small integer. *) let rec pow_int x n = if n == 0 then one else if n < 0 then inv (pow_int x (-n)) else let y = pow_int (mul x x) (n / 2) in if n mod 2 == 0 then y else mul y x let rec pow_z x n = let c = Z.cmp_si n 0 in if c == 0 then one else if c < 0 then inv (pow_z x (Z.neg n)) else let y = pow_z (mul x x) (Z.fdiv_q_2exp n 1) in if Z.cmp_si (Z.dmod_ui n 2) 0 == 0 then y else mul y x (*s Alternate power series. The following function [alternate_powerserie_] computes $B^p S$ where $S$ is the partial sum of an alternate power serie such that the remainder is less than $B^{-p}$, that is $S = \sum_{i=0}^{i=n}(-1)^ia_i$ with $a_{n+1} < B^{-p}$. The alternate power serie is given by its first term $a_0$ and a function [next] such that $a_{n+1} = \textit{next} ~ n ~ a_n$. *) let alternate_powerserie_ a0 next p = let eps = bexp (-p) in let rec sum s n an = (* [s] is already the sum up to $a_n$ *) let asn = next n an in if Q.cmp (q_abs asn) eps < 0 then s else sum (if n mod 2 == 0 then Q.sub s asn else Q.add s asn) (n + 1) asn in Q.div (sum a0 0 a0) eps (*s A specialized function to compute $atan(1/m)$ where [m] is a small integer. *) let arctan_reciproqual m = let m_inverse = Q.from_ints 1 m in let m_inverse_square = Q.mul m_inverse m_inverse in create (fun n -> let eps = bexp (-n) in let rec sum s sign k p = (* [s] is already the sum up to $a_k$ *) let p' = Q.mul p m_inverse_square in let t = Q.mul p' (Q.from_ints 1 (k + 2)) in if Q.cmp t eps < 0 then s else sum (if sign then Q.add s t else Q.sub s t) (not sign) (k + 2) p' in fmul_Bexp (sum m_inverse false 1 m_inverse) n) (*s $\pi$ is defined using [arctan], with the well-known formula (Algorithm 13 page 68) $$\frac{\pi}{4} = 12 \arctan\left(\frac{1}{18}\right) + 8 \arctan\left(\frac{1}{57}\right) - 5 \arctan\left(\frac{1}{239}\right)$$ *) let pi = (of_int 48 *! arctan_reciproqual 18) +! (of_int 32 *! arctan_reciproqual 57) -! (of_int 20 *! arctan_reciproqual 239) (*i let pi = (of_int 16 *! arctan_reciproqual 5) -! (of_int 4 *! arctan_reciproqual 239) i*) let half_pi = pi /! two (*s Arctangent (Algorithm 12 page 64). *) let arctan_ x = let square_x = Q.mul x x in let next n an = Q.mul (Q.mul an square_x) (Q.from_ints (2 * n + 1) (2 * n + 3)) in alternate_powerserie_ x next let arctan_def x = create (function n -> let k = max 0 (n + 1) in let xk = approx x k in if Z.cmp_si xk 0 == 0 then z_zero else let q = Q.from_zs xk (Z.pow_ui_ui 4 k) in q_floor (Q.add (Q.div (Q.add (arctan_ q (n + 1)) q_one) q_four) (Q.div (bexp (n + k)) (Q.add (bexp (2 * n + 2)) (Q.from_z (Z.add (Z.mul xk xk) xk)))))) (*s The above definition of [arctan] converges very slowly when $|x|\ge 1$. The convergence is accelerated using the following identities: \begin{displaymath} \begin{array}{lll} \arctan(x) & = -\pi/2 - \arctan(1/x) & \mbox{ when }x<-1 \\ & = -\pi/4 - \arctan((1-x^2)/(2x))/2 & \mbox{ when }x\approx-1 \\ & = +\pi/4 - \arctan((1-x^2)/(2x))/2 & \mbox{ when }x\approx1 \\ & = +\pi/2 - \arctan(1/x) & \mbox{ when }x>1 \end{array} \end{displaymath} We use the approximation of $x$ at order 1 to discriminate between the cases. *) let arctan x = let x1 = approx x 1 in if Z.cmp_si x1 (-5) < 0 then (* $x < -1$ *) neg (half_pi +! arctan_def (inv x)) else if Z.cmp_si x1 (-3) <= 0 then (* $x$ close to $-1$ *) neg (half_pi +! arctan_def ((one -! x *! x) /! (two *! x))) /! two else if Z.cmp_si x1 5 > 0 then (* $x > 1$ *) half_pi -! arctan_def (inv x) else if Z.cmp_si x1 3 >= 0 then (* $x$ close to 1 *) (half_pi -! arctan_def ((one -! x *! x) /! (two *! x))) /! two else (* $x$ close to 0 *) arctan_def x (*s Arcsinus and arccosinus are derived from arctangent (Algorithm 14 page 69). We use $\arcsin(x)+\arccos(x)=\pi/2$ to avoid non-termination of $\arcsin(1)$ and $\arccos(0)$. *) let arcsin_def x = arctan (x /! (sqrt (one -! (x *! x)))) let arccos_def x = arctan ((sqrt (one -! (x *! x))) /! x) let arcsin x = let x1 = approx x 1 in if z_le (Z.abs x1) z_two then (* |x| < 3/4 *) arcsin_def x else if z_le z_three x1 then (* x > 1/2 *) half_pi -! arccos_def x else (* x < -1/2 *) arccos_def (neg x) -! half_pi let arccos x = let x1 = approx x 1 in if z_le (Z.abs x1) z_two then (* |x| < 3/4 *) half_pi -! arcsin_def x else if z_le z_three x1 then (* x > 1/2 *)arccos_def x else (* x < -1/2 *) pi -! arccos_def (neg x) (*s Sinus (Algorithm 15 page 69). *) let rec sin_ x p = if Q.cmp x q_zero >= 0 then let square_x = Q.mul x x in let next n an = Q.mul (Q.mul (Q.mul an square_x) (Q.from_ints 1 (2 * n + 2))) (Q.from_ints 1 (2 * n + 3)) in alternate_powerserie_ x next p else Q.neg (sin_ (Q.neg x) p) let sin x = let p = Z.sub_ui (approx (x /! pi) 0) 1 in let theta = if Z.cmp_si p 0 == 0 then x else x -! ((of_z p) *! pi) in let z = half_pi in create (fun n -> let k = max 2 (n + 2) in let zk = approx z k in let twozk = Z.mul2exp zk 1 in let threezk = Z.mul_ui zk 3 in let fourzk = Z.mul2exp zk 2 in let thetak = approx theta k in if (z_between z_zero thetak z_one) || (z_between (Z.sub_ui fourzk 4) thetak (Z.add_ui fourzk 4)) || (z_between (Z.sub_ui twozk 2) thetak (Z.add_ui twozk 2)) then z_zero else if z_between (Z.sub_ui zk 1) thetak (Z.add_ui zk 1) then let bn = Z.mul2exp z_one (n + n) in if z_even p then bn else Z.neg bn else if z_between (Z.sub_ui threezk 3) thetak (Z.add_ui threezk 3) then let bn = Z.mul2exp z_one (n + n) in if z_even p then Z.neg bn else bn else let q = Q.from_zs thetak (Z.pow_ui_ui 4 k) in let s = sin_ q (n + 2) in let bw = Q.from_ints 16 1 in let bn_k = bexp (n - k) in let r = if (z_between z_two thetak (Z.sub_ui zk 2)) || (z_between (Z.add_ui zk 2) thetak (Z.sub_ui twozk 3)) then q_floor (Q.add (Q.div (Q.add s q_one) bw) bn_k) else q_ceil (Q.sub (Q.div (Q.sub s q_one) bw) bn_k) in if z_even p then r else Z.neg r) (*s Cosinus and tangent are derived from sinus (Algorithm 16 page 78). *) let cos x = sin (half_pi -! x) let tan x = (sin x) /! (cos x) (*s Euler constant [e]. *) type sum_cache = { mutable order : int; mutable sum : Q.t; (* sum up to [order] *) mutable term : Q.t; (* last term $a_{order}$ *) mutable prec : int } let e = let e_cache = { order = 1; sum = q_two; term = q_one; prec = 0 } in create (fun p -> if p <= e_cache.prec then fmul_Bexp e_cache.sum p else let eps = bexp (-p) in let rec sum s n an = let rn = Q.mul (Q.from_ints 1 n) an in if Q.cmp rn eps <= 0 then begin e_cache.order <- n; e_cache.sum <- s; e_cache.term <- an; e_cache.prec <- p; fmul_Bexp s p end else let asn = Q.mul (Q.from_ints 1 (n + 1)) an in sum (Q.add s asn) (n + 1) asn in sum e_cache.sum e_cache.order e_cache.term) (*s Natural logarithm (Algorithm 9 page 62). *) let ln_above_1 r = let y = Q.div (Q.sub r q_one) (Q.add r q_one) in let y_square = Q.mul y y in let one_minus_y_square = Q.sub q_one y_square in fun n -> let eps = bexp (-n) in let rec sum s k p = (* [s] is already the sum up to $a_k$ *) let p' = Q.mul p y_square in let t = Q.mul p' (Q.from_ints 1 (k + 2)) in if Q.cmp (Q.div t one_minus_y_square) eps < 0 then Q.mul q_two s else sum (Q.add s t) (k + 2) p' in Q.div (sum y 1 y) eps let rec ln_ r = if Q.cmp r q_zero <= 0 then invalid_arg "Creal.ln"; let cmp1 = Q.cmp r q_one in if cmp1 < 0 then (* $r < 1$ *) let ln_inverse_r = ln_ (Q.inv r) in (fun n -> Q.neg (ln_inverse_r n)) else if cmp1 == 0 then (* $r = 1$ *) (fun _ -> q_zero) else (* $r > 1$ *) ln_above_1 r let ln_4 = let f = ln_above_1 q_four in create (fun n -> q_floor (f n)) let rec ln x = let msd_x = msd x in let k = -msd_x + 1 in if k != 0 then ln (x /! (of_q (bexp k))) +! (of_int k) *! ln_4 else create (fun n -> let w = 2 - min 0 n in let k = n + msd_x + w in let xk = Q.from_z (approx x k) in let q = Q.div xk (bexp k) in q_floor (Q.add (Q.div (Q.add (ln_ q (n + w)) q_one) (bexp w)) (Q.div (bexp n) xk))) let log ~base:x y = ln y /! ln x (*s Inverses of hyperbolic functions. *) let arcsinh x = ln (x +! sqrt (x *! x +! one)) let arccosh x = ln (x +! sqrt (x *! x -! one)) let arctanh x = ln ((one +! x) /! (one -! x)) /! two (*s Exponential (Algorithm 7 page 57). *) let exp_neg_ r = (* $-1 \le r < 0$ *) let r = q_abs r in let next n an = Q.mul (Q.mul an r) (Q.from_ints 1 (n + 1)) in create (fun n -> q_floor (alternate_powerserie_ q_one next n)) let exp_ r = if Q.cmp r q_zero == 0 then one else let s_floor_r = Z.add_ui (q_floor r) 1 in mul (pow_z e s_floor_r) (exp_neg_ (Q.sub r (Q.from_z s_floor_r))) let exp x = create (fun n -> let qbn = bexp n in let bn = of_q qbn in let invqbn = Q.inv qbn in let one_plus_invqbn = Q.add q_one invqbn in let test1 () = let lsup = log four (of_int 7 /! ln ((bn +! one) /! (bn -! one))) in let l = Z.int_from (approx lsup 0) + 1 in let xl = approx x l in let log1 = q_floor (ln_ (Q.sub q_one invqbn) l) in let log2 = q_floor (ln_ one_plus_invqbn l) in (Z.cmp (Z.add log1 z_two) xl < 0) && (Z.cmp xl (Z.sub log2 z_two) < 0) in let test2 () = let x0 = approx x 0 in let m = Z.sub (q_floor (ln_ one_plus_invqbn 0)) z_two in Z.cmp x0 m <= 0 in if (n > 0 && test1 ()) || (n <= 0 && test2 ()) then fmul_Bexp q_one n else let msd_x = msd x in let clogBe = if Z.cmp (approx x msd_x) z_one >= 0 then Q.from_ints 577080 100000 else Q.from_ints (-72134) 100000 in let d2 = Q.div clogBe (bexp msd_x) in let p = max 0 (n + 1) in let d = q_max (Q.from_ints (-p) 1) d2 in let k2 = q_ceil (Q.add d (Q.from_ints 44732 100000)) in let k = max 1 (max msd_x (p + 1 + Z.int_from k2)) in let bk = bexp k in let xk = approx x k in let xkBk = Q.div (Q.from_z xk) bk in let exp_xkBk_p = approx (exp_ xkBk) p in if Z.cmp exp_xkBk_p z_zero <= 0 then z_zero else q_ceil (Q.mul (Q.sub (Q.div (Q.from_z exp_xkBk_p) q_four) q_one) (Q.sub q_one (Q.inv bk)))) let pow x y = exp (y *! ln x) let root n x = pow x (inv (of_int n)) (*s Hyperbolic functions. *) let sinh x = (exp x -! exp (neg x)) /! two let cosh x = (exp x +! exp (neg x)) /! two let tanh x = sinh x /! cosh x (*s Comparisons. [cmp] is absolute comparison and [rel_cmp] is comparison up to $4^{-k}$. *) let cmp x y = let rec cmp_rec n = let xn = approx x n in let yn = approx y n in if z_gt (Z.add_ui xn 1) (Z.sub_ui yn 1) && z_gt (Z.add_ui yn 1) (Z.sub_ui xn 1) then cmp_rec (succ n) else if z_le (Z.add_ui xn 1) (Z.sub_ui yn 1) then -1 else 1 in cmp_rec 0 let rel_cmp k x y = let rec cmp_rec n = let xn = approx x n in let yn = approx y n in if z_gt (Z.add_ui xn 1) (Z.sub_ui yn 1) && z_gt (Z.add_ui yn 1) (Z.sub_ui xn 1) && n <= k + 2 then cmp_rec (succ n) else if z_le (Z.add_ui xn 1) (Z.sub_ui yn 1) then -1 else if z_le (Z.add_ui yn 1) (Z.sub_ui xn 1) then 1 else 0 in cmp_rec 0 (*s Coercions to and from type [float]. *) let of_float f = of_q (Q.from_float f) let to_float x n = Q.float_from (to_q x n) (*s Coercion to and from type [string]. *) let of_string ?(radix=10) s = try begin try let n = String.length s in let p = String.index s '.' in let dec = n - p - 1 in let s' = (String.sub s 0 p) ^ (String.sub s (p + 1) dec) in of_q (Q.from_zs (Z.from_string_base radix s') (Z.pow_ui_ui radix dec)) with Not_found -> of_z (Z.from_string_base radix s) end with Invalid_argument _ -> invalid_arg "Creal.of_string" (*s Decimal approximation of [x] at order [p]. We look for an integer [n] such that $|10^px - n| < 1/2$ i.e. the integer closest to $10^px$. There is sometimes no such integer but then we can find a decimal approximation at order [p+1]. We first compute $y = 10^px$ and [approx y 3] i.e. an approximation $y_3/64$ of $y$. Let $q$ and $r$ be the quotient and remainder of the division $y_3/64$ such that $y_3 = 64q+r$ and $0\le r<63$. If $r\le 31$ then $n$ is $q$; If $r\ge 33$ then $n$ is $q+1$; Otherwise $10q+5$ is a decimal approximation of $x$ at order $p+1$. *) let to_string_aux x p = if p < 0 then invalid_arg "Creal.to_string"; let tenp = Z.pow_ui_ui 10 p in let y = mul (of_z tenp) x in let y3 = approx y 3 in let q,r = Z.fdiv_qr_ui y3 64 in let r = Z.int_from r in let n,p = if r <= 31 then q, p else if r >= 33 then Z.add_ui q 1, p else Z.add_ui (Z.mul_ui q 10) 5, succ p in let ns = Z.string_from (Z.abs n) in let lns = String.length ns in let ins,dns = if lns >= p+1 then String.sub ns 0 (lns - p), String.sub ns (lns - p) p else "0", String.make (p - lns) '0' ^ ns in Z.sgn n, ins, dns let to_string x p = let sgn,i,f = to_string_aux x p in (if sgn < 0 then "-" else "") ^ i ^ "." ^ f (*s Coercion to type [string] with digits packed 5 by 5. *) let string_concat = String.concat "" let beautiful s = let n = String.length s in let eol i = if (i + 5) mod 65 == 0 then "\n" else " " in let rec cut i = String.sub s i (min 5 (n - i)) :: if i < n - 5 then eol i :: cut (i + 5) else [] in string_concat (cut 0) let to_beautiful_string x p = let sgn,i,f = to_string_aux x p in let nl = if String.length i + String.length f > 75 then "\n" else "" in (if sgn < 0 then "-" else "") ^ i ^ "." ^ nl ^ beautiful f (* min and max here not to hide Pervasives's min and max *) (** let min x y = create (fun n -> Z.min (approx x n) (approx y n)) let max x y = create (fun n -> Z.max (approx x n) (approx y n)) **) let min x y = let min_xy = ref None in create (fun n -> match !min_xy with | Some r -> approx r n | None -> let xn = approx x n in let yn = approx y n in if z_le (Z.add_ui xn 1) (Z.sub_ui yn 1) then begin min_xy := Some x; xn end else if z_le (Z.add_ui yn 1) (Z.sub_ui xn 1) then begin min_xy := Some y; yn end else Z.min xn yn) let max x y = let max_xy = ref None in create (fun n -> match !max_xy with | Some r -> approx r n | None -> let xn = approx x n in let yn = approx y n in if z_le (Z.add_ui xn 1) (Z.sub_ui yn 1) then begin max_xy := Some y; yn end else if z_le (Z.add_ui yn 1) (Z.sub_ui xn 1) then begin max_xy := Some x; xn end else Z.max xn yn) (*s Format pretty-printer. *) let print_precision = ref 10 let set_print_precision = (:=) print_precision let print fmt x = Format.fprintf fmt "%s" (to_string x !print_precision) module Infixes = struct let (+!) = add let (-!) = sub let ( *! ) = mul let (/!) = div end creal-0.7/mlgmp/0002755000246300002640000000000010327650213014701 5ustar filliatrdemons00000000000000creal-0.7/mlgmp/gmp.mli0000640000246300002640000002301110330104265016151 0ustar filliatrdemons00000000000000type rounding_mode = GMP_RNDN | GMP_RNDZ | GMP_RNDU | GMP_RNDD module Z2 : sig type t external from_int : dest:t -> int -> unit = "_mlgmp_z2_from_int" external from_string_base : dest:t -> base:int -> string -> unit = "_mlgmp_z2_from_string_base" external from_float : dest:t -> float -> unit = "_mlgmp_z2_from_float" external create : unit -> t = "_mlgmp_z_create" external copy : dest:t -> from:t -> unit = "_mlgmp_z_copy" external add : dest:t -> t -> t -> unit = "_mlgmp_z2_add" external sub : dest:t -> t -> t -> unit = "_mlgmp_z2_sub" external mul : dest:t -> t -> t -> unit = "_mlgmp_z2_mul" external tdiv_q : dest:t -> t -> t -> unit = "_mlgmp_z2_tdiv_q" external tdiv_r : dest:t -> t -> t -> unit = "_mlgmp_z2_tdiv_r" external cdiv_q : dest:t -> t -> t -> unit = "_mlgmp_z2_cdiv_q" external cdiv_r : dest:t -> t -> t -> unit = "_mlgmp_z2_cdiv_r" external fdiv_q : dest:t -> t -> t -> unit = "_mlgmp_z2_fdiv_q" external fdiv_r : dest:t -> t -> t -> unit = "_mlgmp_z2_fdiv_r" external divexact : dest:t -> t -> t -> unit = "_mlgmp_z2_divexact" external neg : dest:t -> t -> unit = "_mlgmp_z2_neg" external abs : dest:t -> t -> unit = "_mlgmp_z2_abs" end module Z : sig type t = Z2.t external from_int : int -> t = "_mlgmp_z_from_int" external of_int : int -> t = "_mlgmp_z_from_int" external from_string_base : base:int -> string -> t = "_mlgmp_z_from_string_base" external from_float : float -> t = "_mlgmp_z_from_float" external of_float : float -> t = "_mlgmp_z_from_float" external to_string_base : base:int -> t -> string = "_mlgmp_z_to_string_base" external to_int : t -> int = "_mlgmp_z_to_int" external to_float : t -> float = "_mlgmp_z_to_float" external int_from : t -> int = "_mlgmp_z_to_int" external float_from : t -> float = "_mlgmp_z_to_float" external add : t -> t -> t = "_mlgmp_z_add" external sub : t -> t -> t = "_mlgmp_z_sub" external mul : t -> t -> t = "_mlgmp_z_mul" external add_ui : t -> int -> t = "_mlgmp_z_add_ui" external sub_ui : t -> int -> t = "_mlgmp_z_sub_ui" external mul_ui : t -> int -> t = "_mlgmp_z_mul_ui" external neg : t -> t = "_mlgmp_z_neg" external abs : t -> t = "_mlgmp_z_abs" external tdiv_qr : t -> t -> t * t = "_mlgmp_z_tdiv_qr" external tdiv_q : t -> t -> t = "_mlgmp_z_tdiv_q" external tdiv_r : t -> t -> t = "_mlgmp_z_tdiv_r" external cdiv_qr : t -> t -> t * t = "_mlgmp_z_cdiv_qr" external cdiv_q : t -> t -> t = "_mlgmp_z_cdiv_q" external cdiv_r : t -> t -> t = "_mlgmp_z_cdiv_r" external fdiv_qr : t -> t -> t * t = "_mlgmp_z_fdiv_qr" external fdiv_q : t -> t -> t = "_mlgmp_z_fdiv_q" external fdiv_r : t -> t -> t = "_mlgmp_z_fdiv_r" external dmod : t -> t -> t = "_mlgmp_z_mod" external dmod_ui : t -> int -> t = "_mlgmp_z_mod_ui" external euclidean_division : t -> t -> t * t = "_mlgmp_z_fdiv_qr" external modulo : t -> t -> t = "_mlgmp_z_mod" external tdiv_qr_ui : t -> int -> t * t = "_mlgmp_z_tdiv_qr_ui" external tdiv_q_ui : t -> int -> t = "_mlgmp_z_tdiv_q_ui" external tdiv_r_ui : t -> int -> t = "_mlgmp_z_tdiv_r_ui" external tdiv_ui : t -> int -> int = "_mlgmp_z_tdiv_ui" external cdiv_qr_ui : t -> int -> t * t = "_mlgmp_z_cdiv_qr_ui" external cdiv_q_ui : t -> int -> t = "_mlgmp_z_cdiv_q_ui" external cdiv_r_ui : t -> int -> t = "_mlgmp_z_cdiv_r_ui" external cdiv_ui : t -> int -> int = "_mlgmp_z_cdiv_ui" external fdiv_qr_ui : t -> int -> t * t = "_mlgmp_z_fdiv_qr_ui" external fdiv_q_ui : t -> int -> t = "_mlgmp_z_fdiv_q_ui" external fdiv_r_ui : t -> int -> t = "_mlgmp_z_fdiv_r_ui" external fdiv_ui : t -> int -> int = "_mlgmp_z_fdiv_ui" external divexact : t -> t -> t = "_mlgmp_z_divexact" external mul_2exp : t -> int -> t = "_mlgmp_z_mul_2exp" external mul2exp : t -> int -> t = "_mlgmp_z_mul_2exp" external tdiv_q_2exp : t -> int -> t = "_mlgmp_z_tdiv_q_2exp" external tdiv_r_2exp : t -> int -> t = "_mlgmp_z_tdiv_r_2exp" external fdiv_q_2exp : t -> int -> t = "_mlgmp_z_fdiv_q_2exp" external fdiv_r_2exp : t -> int -> t = "_mlgmp_z_fdiv_r_2exp" external cdiv_q_2exp : t -> int -> t = "_mlgmp_z_cdiv_q_2exp" external cdiv_r_2exp : t -> int -> t = "_mlgmp_z_cdiv_r_2exp" external powm : t -> t -> t -> t = "_mlgmp_z_powm" external powm_ui : t -> int -> t -> t = "_mlgmp_z_powm_ui" external pow_ui : t -> int -> t = "_mlgmp_z_pow_ui" external ui_pow_ui : int -> int -> t = "_mlgmp_z_ui_pow_ui" external pow_ui_ui : int -> int -> t = "_mlgmp_z_ui_pow_ui" external sqrt : t -> t = "_mlgmp_z_sqrt" external sqrtrem : t -> t * t = "_mlgmp_z_sqrtrem" external root : t -> int -> t = "_mlgmp_z_root" external perfect_power_p : t -> bool = "_mlgmp_z_perfect_power_p" external perfect_square_p : t -> bool = "_mlgmp_z_perfect_square_p" external is_perfect_power : t -> bool = "_mlgmp_z_perfect_power_p" external is_perfect_square : t -> bool = "_mlgmp_z_perfect_square_p" external probab_prime_p : t -> int -> bool = "_mlgmp_z_probab_prime_p" external is_probab_prime : t -> int -> bool = "_mlgmp_z_probab_prime_p" external nextprime : t -> t = "_mlgmp_z_nextprime" external gcd : t -> t -> t = "_mlgmp_z_gcd" external gcd_ui : t -> t -> t = "_mlgmp_z_gcd_ui" external lcm : t -> t -> t = "_mlgmp_z_lcm" external gcdext : t -> t -> t * t * t = "_mlgmp_z_gcdext" external inverse : t -> t -> t option = "_mlgmp_z_invert" external legendre : t -> t -> int = "_mlgmp_z_legendre" external jacobi : t -> t -> int = "_mlgmp_z_jacobi" external kronecker_si : t -> int -> int = "_mlgmp_z_kronecker_si" external si_kronecker : int -> t -> int = "_mlgmp_z_si_kronecker" external remove : t -> t -> t * int = "_mlgmp_z_remove" external fac_ui : int -> t = "_mlgmp_z_fac_ui" external fib_ui : int -> t = "_mlgmp_z_fib_ui" external bin_ui : n:t -> k:int -> t = "_mlgmp_z_bin_ui" external bin_uiui : n:int -> k:int -> t = "_mlgmp_z_bin_uiui" external cmp : t -> t -> int = "_mlgmp_z_compare" external cmp_si : t -> int -> int = "_mlgmp_z_compare_si" external compare : t -> t -> int = "_mlgmp_z_compare" external compare_si : t -> int -> int = "_mlgmp_z_compare_si" external compare_int : t -> int -> int = "_mlgmp_z_compare_si" external sgn : t -> int = "_mlgmp_z_sgn" external band : t -> t -> t = "_mlgmp_z_and" external bior : t -> t -> t = "_mlgmp_z_ior" external bxor : t -> t -> t = "_mlgmp_z_xor" external bcom : t -> t = "_mlgmp_z_com" external popcount : t -> int = "_mlgmp_z_popcount" external hamdist : t -> t -> int = "_mlgmp_z_hamdist" external scan0 : t -> int -> int = "_mlgmp_z_scan0" external scan1 : t -> int -> int = "_mlgmp_z_scan1" val zero : t val one : t val is_prime : ?prec:int -> t -> bool val equal : t -> t -> bool val equal_int : t -> int -> bool val is_zero : t -> bool val to_string : t -> string val from_string : string -> t val string_from : t -> string val output : out_channel -> t -> unit val sprintf : unit -> t -> string val print : Format.formatter -> t -> unit val succ : t -> t val pred : t -> t val min : t -> t -> t val max : t -> t -> t module Infixes : sig external ( +! ) : t -> t -> t = "_mlgmp_z_add" external ( -! ) : t -> t -> t = "_mlgmp_z_sub" external ( *! ) : t -> t -> t = "_mlgmp_z_mul" external ( /! ) : t -> t -> t = "_mlgmp_z_fdiv_q" external ( %! ) : t -> t -> t = "_mlgmp_z_fdiv_r" val ( t -> bool val ( <=! ) : t -> t -> bool val ( =! ) : t -> t -> bool val ( >=! ) : t -> t -> bool val ( >! ) : t -> t -> bool val ( <>! ) : t -> t -> bool end end module Q : sig type t external create : unit -> t = "_mlgmp_q_create" external from_z : Z.t -> t = "_mlgmp_q_from_z" external from_si : int -> int -> t = "_mlgmp_q_from_si" external from_ints : int -> int -> t = "_mlgmp_q_from_si" val from_int : int -> t external from_float : float -> t = "_mlgmp_q_from_float" external float_from : t -> float = "_mlgmp_q_to_float" external to_float : t -> float = "_mlgmp_q_to_float" external add : t -> t -> t = "_mlgmp_q_add" external sub : t -> t -> t = "_mlgmp_q_sub" external mul : t -> t -> t = "_mlgmp_q_mul" external div : t -> t -> t = "_mlgmp_q_div" external neg : t -> t = "_mlgmp_q_neg" external inv : t -> t = "_mlgmp_q_inv" external get_num : t -> Z.t = "_mlgmp_q_get_num" external get_den : t -> Z.t = "_mlgmp_q_get_den" external cmp : t -> t -> int = "_mlgmp_q_cmp" external compare : t -> t -> int = "_mlgmp_q_cmp" external cmp_ui : t -> int -> int -> int = "_mlgmp_q_cmp_ui" external sgn : t -> int = "_mlgmp_q_sgn" val zero : t val is_zero : t -> bool val from_zs : Z.t -> Z.t -> t val equal : t -> t -> bool val output : out_channel -> t -> unit val to_string : t -> string val sprintf : unit -> t -> string module Infixes : sig external ( +/ ) : t -> t -> t = "_mlgmp_q_add" external ( -/ ) : t -> t -> t = "_mlgmp_q_sub" external ( */ ) : t -> t -> t = "_mlgmp_q_mul" external ( // ) : t -> t -> t = "_mlgmp_q_div" val ( t -> bool val ( <=/ ) : t -> t -> bool val ( =/ ) : t -> t -> bool val ( >=/ ) : t -> t -> bool val ( >/ ) : t -> t -> bool val ( <>/ ) : t -> t -> bool end end exception Unimplemented of string creal-0.7/mlgmp/gmp.ml0000640000246300002640000002602210330104265016005 0ustar filliatrdemons00000000000000(* * ML GMP - Interface between Objective Caml and GNU MP * Copyright (C) 2001 David MONNIAUX * * This software is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License version 2 published by the Free Software Foundation, * or any more recent version published by the Free Software * Foundation, at your choice. * * This software is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * See the GNU Library General Public License version 2 for more details * (enclosed in the file LGPL). * * As a special exception to the GNU Library General Public License, you * may link, statically or dynamically, a "work that uses the Library" * with a publicly distributed version of the Library to produce an * executable file containing portions of the Library, and distribute * that executable file under terms of your choice, without any of the * additional requirements listed in clause 6 of the GNU Library General * Public License. By "a publicly distributed version of the Library", * we mean either the unmodified Library as distributed by INRIA, or a * modified version of the Library that is distributed under the * conditions defined in clause 3 of the GNU Library General Public * License. This exception does not however invalidate any other reasons * why the executable file might be covered by the GNU Library General * Public License. *) type rounding_mode = GMP_RNDN | GMP_RNDZ | GMP_RNDU | GMP_RNDD exception Unimplemented of string;; let _ = Callback.register_exception "Gmp.Division_by_zero" Division_by_zero;; let _ = Callback.register_exception "Gmp.Unimplemented" (Unimplemented "foo");; module Z2 = struct external z_initialize : unit->unit = "_mlgmp_z_initialize";; z_initialize ();; type t;; external from_int: dest: t->int->unit = "_mlgmp_z2_from_int";; external from_string_base: dest: t->base: int->string->unit ="_mlgmp_z2_from_string_base";; external from_float: dest: t->float->unit = "_mlgmp_z2_from_float";; external create: unit->t = "_mlgmp_z_create";; external copy: dest: t-> from: t-> unit = "_mlgmp_z_copy";; external add: dest: t-> t->t->unit = "_mlgmp_z2_add";; external sub: dest: t-> t->t->unit = "_mlgmp_z2_sub";; external mul: dest: t-> t->t->unit = "_mlgmp_z2_mul";; external tdiv_q: dest: t-> t->t->unit = "_mlgmp_z2_tdiv_q";; external tdiv_r: dest: t-> t->t->unit = "_mlgmp_z2_tdiv_r";; external cdiv_q: dest: t-> t->t->unit = "_mlgmp_z2_cdiv_q";; external cdiv_r: dest: t-> t->t->unit = "_mlgmp_z2_cdiv_r";; external fdiv_q: dest: t-> t->t->unit = "_mlgmp_z2_fdiv_q";; external fdiv_r: dest: t-> t->t->unit = "_mlgmp_z2_fdiv_r";; external divexact: dest: t-> t->t->unit = "_mlgmp_z2_divexact";; external neg: dest: t->t->unit = "_mlgmp_z2_neg";; external abs: dest: t->t->unit = "_mlgmp_z2_abs";; end;; module Z = struct type t = Z2.t;; external of_int: int->t = "_mlgmp_z_from_int";; external from_int: int->t = "_mlgmp_z_from_int";; external from_string_base: base: int->string->t="_mlgmp_z_from_string_base";; external of_float: float->t = "_mlgmp_z_from_float";; external from_float: float->t = "_mlgmp_z_from_float";; external to_string_base: base: int->t->string = "_mlgmp_z_to_string_base";; external to_int: t->int = "_mlgmp_z_to_int";; external to_float: t->float = "_mlgmp_z_to_float";; external int_from: t->int = "_mlgmp_z_to_int";; external float_from: t->float = "_mlgmp_z_to_float";; external add: t->t->t = "_mlgmp_z_add";; external sub: t->t->t = "_mlgmp_z_sub";; external mul: t->t->t = "_mlgmp_z_mul";; external add_ui: t->int->t = "_mlgmp_z_add_ui";; external sub_ui: t->int->t = "_mlgmp_z_sub_ui";; external mul_ui: t->int->t = "_mlgmp_z_mul_ui";; external neg: t->t = "_mlgmp_z_neg";; external abs: t->t = "_mlgmp_z_abs";; external tdiv_qr: t->t->t*t = "_mlgmp_z_tdiv_qr";; external tdiv_q: t->t->t = "_mlgmp_z_tdiv_q";; external tdiv_r: t->t->t = "_mlgmp_z_tdiv_r";; external cdiv_qr: t->t->t*t = "_mlgmp_z_cdiv_qr";; external cdiv_q: t->t->t = "_mlgmp_z_cdiv_q";; external cdiv_r: t->t->t = "_mlgmp_z_cdiv_r";; external fdiv_qr: t->t->t*t = "_mlgmp_z_fdiv_qr";; external fdiv_q: t->t->t = "_mlgmp_z_fdiv_q";; external fdiv_r: t->t->t = "_mlgmp_z_fdiv_r";; external dmod: t->t->t = "_mlgmp_z_mod";; external dmod_ui: t->int->t = "_mlgmp_z_mod_ui";; external euclidean_division: t->t->t*t = "_mlgmp_z_fdiv_qr";; external modulo: t->t->t = "_mlgmp_z_mod";; external tdiv_qr_ui: t->int->t*t = "_mlgmp_z_tdiv_qr_ui";; external tdiv_q_ui: t->int->t = "_mlgmp_z_tdiv_q_ui";; external tdiv_r_ui: t->int->t = "_mlgmp_z_tdiv_r_ui";; external tdiv_ui: t->int->int = "_mlgmp_z_tdiv_ui";; external cdiv_qr_ui: t->int->t*t = "_mlgmp_z_cdiv_qr_ui";; external cdiv_q_ui: t->int->t = "_mlgmp_z_cdiv_q_ui";; external cdiv_r_ui: t->int->t = "_mlgmp_z_cdiv_r_ui";; external cdiv_ui: t->int->int = "_mlgmp_z_cdiv_ui";; external fdiv_qr_ui: t->int->t*t = "_mlgmp_z_fdiv_qr_ui";; external fdiv_q_ui: t->int->t = "_mlgmp_z_fdiv_q_ui";; external fdiv_r_ui: t->int->t = "_mlgmp_z_fdiv_r_ui";; external fdiv_ui: t->int->int = "_mlgmp_z_fdiv_ui";; external divexact: t->t->t = "_mlgmp_z_divexact";; external mul_2exp: t->int->t = "_mlgmp_z_mul_2exp";; external mul2exp: t->int->t = "_mlgmp_z_mul_2exp";; external tdiv_q_2exp: t->int->t = "_mlgmp_z_tdiv_q_2exp";; external tdiv_r_2exp: t->int->t = "_mlgmp_z_tdiv_r_2exp";; external fdiv_q_2exp: t->int->t = "_mlgmp_z_fdiv_q_2exp";; external fdiv_r_2exp: t->int->t = "_mlgmp_z_fdiv_r_2exp";; external cdiv_q_2exp: t->int->t = "_mlgmp_z_cdiv_q_2exp";; external cdiv_r_2exp: t->int->t = "_mlgmp_z_cdiv_r_2exp";; external powm: t->t->t->t = "_mlgmp_z_powm";; external powm_ui: t->int->t->t = "_mlgmp_z_powm_ui";; external pow_ui: t->int->t = "_mlgmp_z_pow_ui";; external ui_pow_ui: int->int->t = "_mlgmp_z_ui_pow_ui";; external pow_ui_ui: int->int->t = "_mlgmp_z_ui_pow_ui";; external sqrt: t->t = "_mlgmp_z_sqrt" external sqrtrem: t->t*t = "_mlgmp_z_sqrtrem" external root: t->int->t = "_mlgmp_z_root" external perfect_power_p: t->bool = "_mlgmp_z_perfect_power_p" external perfect_square_p: t->bool = "_mlgmp_z_perfect_square_p" external is_perfect_power: t->bool = "_mlgmp_z_perfect_power_p" external is_perfect_square: t->bool = "_mlgmp_z_perfect_square_p" external probab_prime_p: t->int->bool = "_mlgmp_z_probab_prime_p" external is_probab_prime: t->int->bool = "_mlgmp_z_probab_prime_p" external nextprime: t->t = "_mlgmp_z_nextprime" external gcd: t->t->t = "_mlgmp_z_gcd" external gcd_ui: t->t->t = "_mlgmp_z_gcd_ui" external lcm: t->t->t = "_mlgmp_z_lcm" external gcdext: t->t->t*t*t = "_mlgmp_z_gcdext" external inverse: t->t->t option="_mlgmp_z_invert" external legendre: t->t->int="_mlgmp_z_legendre" external jacobi: t->t->int="_mlgmp_z_jacobi" external kronecker_si: t->int->int="_mlgmp_z_kronecker_si" external si_kronecker: int->t->int="_mlgmp_z_si_kronecker" external remove: t->t->t*int="_mlgmp_z_remove" external fac_ui: int->t="_mlgmp_z_fac_ui" external fib_ui: int->t="_mlgmp_z_fib_ui" external bin_ui: n: t-> k: int->t="_mlgmp_z_bin_ui" external bin_uiui: n: int-> k: int->t="_mlgmp_z_bin_uiui" external cmp: t->t->int = "_mlgmp_z_compare";; external cmp_si: t->int->int = "_mlgmp_z_compare_si";; external compare: t->t->int = "_mlgmp_z_compare";; external compare_si: t->int->int = "_mlgmp_z_compare_si";; external compare_int: t->int->int = "_mlgmp_z_compare_si";; external sgn: t->int = "_mlgmp_z_sgn";; external band: t->t->t = "_mlgmp_z_and";; external bior: t->t->t = "_mlgmp_z_ior";; external bxor: t->t->t = "_mlgmp_z_xor";; external bcom: t->t = "_mlgmp_z_com";; external popcount: t->int = "_mlgmp_z_popcount";; external hamdist: t->t->int = "_mlgmp_z_hamdist";; external scan0: t->int->int = "_mlgmp_z_scan0";; external scan1: t->int->int = "_mlgmp_z_scan1";; (* missing set/clear bit *) let zero = from_int 0 and one = from_int 1;; let succ x = add one x let pred x = sub x one let min x y = if (compare x y) <= 0 then x else y let max x y = if (compare x y) >= 0 then x else y let is_prime ?(prec = 10) x = is_probab_prime x prec let equal x y = (compare x y) = 0 let equal_int x y = (compare_int x y) = 0 let is_zero x = (sgn x) = 0 let to_string = to_string_base ~base: 10 let from_string = from_string_base ~base: 10 let string_from = to_string let output chan n = output_string chan (to_string n);; let sprintf () = to_string;; let print formatter x = Format.pp_print_string formatter (to_string x) module Infixes= struct external ( +! ) : t -> t -> t = "_mlgmp_z_add" external ( -! ) : t -> t -> t = "_mlgmp_z_sub" external ( *! ) : t -> t -> t = "_mlgmp_z_mul" external ( /! ) : t -> t -> t = "_mlgmp_z_fdiv_q" external ( %! ) : t -> t -> t = "_mlgmp_z_fdiv_r" let ( =! ) x y = (cmp x y)>=0 let ( >! ) x y = (cmp x y)>0 let ( <>! ) x y = (cmp x y)<>0 end;; end;; module Q = struct external q_initialize : unit->unit = "_mlgmp_q_initialize";; q_initialize ();; type t;; external create: unit->t = "_mlgmp_q_create";; external from_z : Z.t->t = "_mlgmp_q_from_z";; external from_si : int->int->t = "_mlgmp_q_from_si";; external from_ints : int->int->t = "_mlgmp_q_from_si";; external from_float : float->t = "_mlgmp_q_from_float";; let from_int x = from_ints x 1 external float_from : t->float = "_mlgmp_q_to_float";; external to_float : t->float = "_mlgmp_q_to_float";; external add : t->t->t = "_mlgmp_q_add";; external sub : t->t->t = "_mlgmp_q_sub";; external mul : t->t->t = "_mlgmp_q_mul";; external div : t->t->t = "_mlgmp_q_div";; external neg : t->t = "_mlgmp_q_neg";; external inv : t->t = "_mlgmp_q_inv";; external get_num : t->Z.t = "_mlgmp_q_get_num";; external get_den : t->Z.t = "_mlgmp_q_get_den";; external cmp : t->t->int = "_mlgmp_q_cmp";; external compare : t->t->int = "_mlgmp_q_cmp";; external cmp_ui : t->int->int->int = "_mlgmp_q_cmp_ui";; external sgn : t->int = "_mlgmp_q_sgn";; let zero = create ();; let is_zero x = (sgn x) = 0;; let from_zs num den = div (from_z num) (from_z den) let equal x y = (cmp x y) = 0;; let output chan x = Printf.fprintf chan "%a/%a" Z.output (get_num x) Z.output (get_den x) let to_string x = Printf.sprintf "%a/%a" Z.sprintf (get_num x) Z.sprintf (get_den x) let sprintf () = to_string module Infixes= struct external ( +/ ) : t -> t -> t = "_mlgmp_q_add" external ( -/ ) : t -> t -> t = "_mlgmp_q_sub" external ( */ ) : t -> t -> t = "_mlgmp_q_mul" external ( // ) : t -> t -> t = "_mlgmp_q_div" let ( =/ ) x y = (cmp x y)>=0 let ( >/ ) x y = (cmp x y)>0 let ( <>/ ) x y = (cmp x y)<>0 end;; end;; creal-0.7/mlgmp/conversions.c0000644000246300002640000000704710330104265017416 0ustar filliatrdemons00000000000000/* * ML GMP - Interface between Objective Caml and GNU MP * Copyright (C) 2001 David MONNIAUX * * This software is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License version 2 published by the Free Software Foundation, * or any more recent version published by the Free Software * Foundation, at your choice. * * This software is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * See the GNU Library General Public License version 2 for more details * (enclosed in the file LGPL). * * As a special exception to the GNU Library General Public License, you * may link, statically or dynamically, a "work that uses the Library" * with a publicly distributed version of the Library to produce an * executable file containing portions of the Library, and distribute * that executable file under terms of your choice, without any of the * additional requirements listed in clause 6 of the GNU Library General * Public License. By "a publicly distributed version of the Library", * we mean either the unmodified Library as distributed by INRIA, or a * modified version of the Library that is distributed under the * conditions defined in clause 3 of the GNU Library General Public * License. This exception does not however invalidate any other reasons * why the executable file might be covered by the GNU Library General * Public License. */ #include struct custom_operations _mlgmp_custom_z; static inline gmp_randstate_t *randstate_val(value val) { return ((gmp_randstate_t *) (Data_custom_val(val))); } static inline int Int_option_val(value val, int default_val) { if (val == Val_int(0)) return default_val; return Int_val(Field(val, 0)); } static inline mpz_t * mpz_val (value val) { return ((mpz_t *) (Data_custom_val(val))); } static inline value alloc_mpz (void) { return alloc_custom(&_mlgmp_custom_z, sizeof(mpz_t), 0, 1); } static inline value alloc_init_mpz (void) { value r= alloc_mpz(); mpz_init(*mpz_val(r)); return r; } #pragma inline(Int_option_val, mpz_val, alloc_mpz, alloc_init_mpz) struct custom_operations _mlgmp_custom_q; static inline mpq_t * mpq_val (value val) { return ((mpq_t *) (Data_custom_val(val))); } static inline value alloc_mpq (void) { return alloc_custom(&_mlgmp_custom_q, sizeof(mpq_t), 0, 1); } static inline value alloc_init_mpq (void) { value r= alloc_mpq(); mpq_init(*mpq_val(r)); return r; } #pragma inline(mpq_val, alloc_mpq, alloc_init_mpq) struct custom_operations _mlgmp_custom_f; static inline mpf_t * mpf_val (value val) { return ((mpf_t *) (Data_custom_val(val))); } static inline value alloc_mpf (void) { return alloc_custom(&_mlgmp_custom_f, sizeof(mpf_t), 0, 1); } static inline value alloc_init_mpf (value prec) { value r= alloc_mpf(); mpf_init2(*mpf_val(r), Int_val(prec)); return r; } struct custom_operations _mlgmp_custom_fr; #ifdef USE_MPFR static inline mpfr_t * mpfr_val (value val) { return ((mpfr_t *) (Data_custom_val(val))); } static inline mp_rnd_t Mode_val (value val) { return (mp_rnd_t) (Int_val(val)); } static inline value alloc_mpfr (void) { return alloc_custom(&_mlgmp_custom_fr, sizeof(mpfr_t), 0, 1); } static inline value alloc_init_mpfr (value prec) { value r= alloc_mpfr(); mpfr_init2(*mpfr_val(r), Int_val(prec)); return r; } #endif creal-0.7/mlgmp/mlgmp_misc.c0000644000246300002640000000204110330104265017162 0ustar filliatrdemons00000000000000#include #include #include #include #include #include #include #include #include #include "config.h" #include "conversions.c" #define MODULE "Gmp." value _mlgmp_get_runtime_version(value dummy) { CAMLparam0(); CAMLlocal1(r); r = alloc_string(strlen(gmp_version)); strcpy(String_val(r), gmp_version); CAMLreturn(r); } value _mlgmp_get_compile_version(value dummy) { CAMLparam0(); CAMLlocal1(r); r = alloc_tuple(3); Store_field(r, 0, Val_int(__GNU_MP_VERSION)); Store_field(r, 1, Val_int(__GNU_MP_VERSION_MINOR)); Store_field(r, 2, Val_int(__GNU_MP_VERSION_PATCHLEVEL)); CAMLreturn(r); } value _mlgmp_is_mpfr_available(value dummy) { #ifdef USE_MPFR return Val_true; #else return Val_false; #endif } void division_by_zero(void) { raise_constant(*caml_named_value("Gmp.Division_by_zero")); } void raise_unimplemented(char *s) { raise_with_string(*caml_named_value("Gmp.Unimplemented"), s); } creal-0.7/mlgmp/mlgmp_q.c0000644000246300002640000001157410330104265016502 0ustar filliatrdemons00000000000000#include #include #include #include #include #include #include #include #include #include "config.h" #include "conversions.c" #define MODULE "Gmp.Q." #define CAMLcheckreturn(r) \ assert(r > 0x10000); \ CAMLreturn(r) /*** Allocation functions */ void _mlgmp_q_finalize(value r) { mpq_clear(*mpq_val(r)); } int _mlgmp_q_custom_compare(value a, value b); void _mlgmp_q_serialize(value v, unsigned long * wsize_32, unsigned long * wsize_64); unsigned long _mlgmp_q_deserialize(void * dst); int _mlgmp_q_custom_compare(value a, value b); long _mlgmp_q_hash(value v); struct custom_operations _mlgmp_custom_q = { field(identifier) "Gmp.Q.t", field(finalize) &_mlgmp_q_finalize, field(compare) &_mlgmp_q_custom_compare, field(hash) &_mlgmp_q_hash, #ifdef SERIALIZE field(serialize) &_mlgmp_q_serialize, field(deserialize) &_mlgmp_q_deserialize #else field(serialize) custom_serialize_default, field(deserialize) custom_deserialize_default #endif }; value _mlgmp_q_create(void) { CAMLparam0(); trace(create); CAMLcheckreturn(alloc_init_mpq()); } value _mlgmp_q_from_z(value a) { CAMLparam1(a); CAMLlocal1(r); trace(from_z); r=alloc_init_mpq(); mpq_set_z(*mpq_val(r), *mpz_val(a)); CAMLcheckreturn(r); } value _mlgmp_q_from_si(value n, value d) { CAMLparam2(n, d); CAMLlocal1(r); trace(from_si); r=alloc_init_mpq(); mpq_set_si(*mpq_val(r), Int_val(n), Int_val(d)); mpq_canonicalize(*mpq_val(r)); CAMLcheckreturn(r); } /*** Conversions */ value _mlgmp_q_from_float(value v) { CAMLparam1(v); CAMLlocal1(r); trace(from_float); r=alloc_init_mpq(); mpq_set_d(*mpq_val(r), Double_val(v)); CAMLcheckreturn(r); } value _mlgmp_q_to_float(value v) { CAMLparam1(v); CAMLlocal1(r); trace(to_float); r = copy_double(mpq_get_d(*mpq_val(v))); CAMLreturn(r); } /*** Operations */ /**** Arithmetic */ #define q_binary_op(op) \ value _mlgmp_q_##op(value a, value b) \ { \ CAMLparam2(a, b); \ CAMLlocal1(r); \ trace(op); \ r=alloc_init_mpq(); \ mpq_##op(*mpq_val(r), *mpq_val(a), *mpq_val(b)); \ CAMLcheckreturn(r); \ } #define q_unary_op(op) \ value _mlgmp_q_##op(value a) \ { \ CAMLparam1(a); \ CAMLlocal1(r); \ trace(op); \ r=alloc_init_mpq(); \ mpq_##op(*mpq_val(r), *mpq_val(a)); \ CAMLcheckreturn(r); \ } q_binary_op(add) q_binary_op(sub) q_binary_op(mul) q_binary_op(div) q_unary_op(neg) q_unary_op(inv) #define q_z_unary_op(op) \ value _mlgmp_q_##op(value a) \ { \ CAMLparam1(a); \ CAMLlocal1(r); \ trace(op); \ r=alloc_init_mpz(); \ mpq_##op(*mpz_val(r), *mpq_val(a)); \ CAMLcheckreturn(r); \ } q_z_unary_op(get_num) q_z_unary_op(get_den) /*** Compare */ int _mlgmp_q_custom_compare(value a, value b) { CAMLparam2(a, b); CAMLreturn(mpq_cmp(*mpq_val(a), *mpq_val(b))); } value _mlgmp_q_cmp(value a, value b) { CAMLparam2(a, b); trace(cmp); \ CAMLreturn(Val_int(mpq_cmp(*mpq_val(a), *mpq_val(b)))); } value _mlgmp_q_cmp_ui(value a, value n, value d) { CAMLparam3(a, n, d); trace(cmp_ui); \ CAMLreturn(Val_int(mpq_cmp_ui(*mpq_val(a), Int_val(n), Int_val(d)))); } value _mlgmp_q_sgn(value a) { CAMLparam1(a); trace(sgn); \ CAMLreturn(Val_int(mpq_sgn(*mpq_val(a)))); } /*** Serialization */ value _mlgmp_q_initialize() { CAMLparam0(); register_custom_operations(& _mlgmp_custom_q); CAMLreturn(Val_unit); } #ifdef SERIALIZE void _mlgmp_q_serialize(value v, unsigned long * wsize_32, unsigned long * wsize_64) { CAMLparam1(v); char *s; int len; *wsize_32 = MPQ_SIZE_ARCH32; *wsize_64 = MPQ_SIZE_ARCH64; s = mpz_get_str (NULL, 16, mpq_numref(*mpq_val(v))); len = strlen(s); serialize_int_4(len); serialize_block_1(s, len); free(s); s = mpz_get_str (NULL, 16, mpq_denref(*mpq_val(v))); len = strlen(s); serialize_int_4(len); serialize_block_1(s, len); free(s); CAMLreturn0; } unsigned long _mlgmp_q_deserialize(void * dst) { char *s; int len; len = deserialize_uint_4(); s = malloc(len+1); deserialize_block_1(s, len); s[len] = 0; mpz_init_set_str (mpq_numref(*((mpq_t*) dst)), s, 16); free(s); len = deserialize_uint_4(); s = malloc(len+1); deserialize_block_1(s, len); s[len] = 0; mpz_init_set_str (mpq_denref(*((mpq_t*) dst)), s, 16); free(s); return sizeof(mpq_t); } #endif long _mlgmp_q_hash(value v) { CAMLparam1(v); mpz_t dummy; long r; mpz_init(dummy); r = mpz_mod_ui(dummy, mpq_denref(*mpq_val(v)), HASH_MODULUS) ^ mpz_mod_ui(dummy, mpq_numref(*mpq_val(v)), HASH_MODULUS); mpz_clear(dummy); CAMLreturn(r); } creal-0.7/mlgmp/mlgmp_z.c0000644000246300002640000004574410330104265016521 0ustar filliatrdemons00000000000000#include #include #include #include #include #include #include #include #include #include "config.h" #include "mlgmp.h" #include "conversions.c" #define MODULE "Gmp.Z." /*** Allocation functions */ void _mlgmp_z_finalize(value r) { mpz_clear(*mpz_val(r)); } int _mlgmp_z_custom_compare(value a, value b); void _mlgmp_z_serialize(value v, unsigned long * wsize_32, unsigned long * wsize_64); unsigned long _mlgmp_z_deserialize(void * dst); long _mlgmp_z_hash(value v); struct custom_operations _mlgmp_custom_z = { field(identifier) "Gmp.Z.t", field(finalize) &_mlgmp_z_finalize, field(compare) &_mlgmp_z_custom_compare, field(hash) &_mlgmp_z_hash, #ifdef SERIALIZE field(serialize) &_mlgmp_z_serialize, field(deserialize) &_mlgmp_z_deserialize #else field(serialize) custom_serialize_default, field(deserialize) custom_deserialize_default #endif }; value _mlgmp_z_create(void) { CAMLparam0(); CAMLreturn(alloc_init_mpz()); } value _mlgmp_z_copy(value from) { CAMLparam1(from); CAMLlocal1(r); r = alloc_mpz(); mpz_init_set(*mpz_val(r), *mpz_val(from)); CAMLreturn(r); } value _mlgmp_z_from_int(value ml_val) { CAMLparam1(ml_val); CAMLlocal1(r); r=alloc_mpz(); mpz_init_set_si(*mpz_val(r), Int_val(ml_val)); CAMLreturn(r); } value _mlgmp_z_from_string_base(value base, value ml_val) { CAMLparam2(base, ml_val); CAMLlocal1(r); r=alloc_mpz(); mpz_init_set_str(*mpz_val(r), String_val(ml_val), Int_val(base)); CAMLreturn(r); } value _mlgmp_z_from_float(value ml_val) { CAMLparam1(ml_val); CAMLlocal1(r); r=alloc_mpz(); mpz_init_set_d(*mpz_val(r), Double_val(ml_val)); CAMLreturn(r); } value _mlgmp_z2_from_int(value r, value ml_val) { CAMLparam2(r, ml_val); mpz_init_set_si(*mpz_val(r), Int_val(ml_val)); CAMLreturn(Val_unit); } value _mlgmp_z2_from_string_base(value r, value base, value ml_val) { CAMLparam3(r, base, ml_val); mpz_init_set_str(*mpz_val(r), String_val(ml_val), Int_val(base)); CAMLreturn(Val_unit); } value _mlgmp_z2_from_float(value r, value ml_val) { CAMLparam2(r, ml_val); mpz_init_set_d(*mpz_val(r), Double_val(ml_val)); CAMLreturn(Val_unit); } /*** Conversions */ value _mlgmp_z_to_string_base(value ml_base, value ml_val) { int base; char *s; CAMLparam2(ml_base, ml_val); CAMLlocal1(r); base=Int_val(ml_base); /* This is sub-optimal, but using mpz_sizeinbase would need a means of shortening the length of a pre-allocated Caml string (mpz_sizeinbase sometimes overestimates lengths). */ s=mpz_get_str(NULL, base, *mpz_val(ml_val)); r=alloc_string(strlen(s)); strcpy(String_val(r), s); free(s); CAMLreturn(r); } value _mlgmp_z_to_int(value ml_val) { CAMLparam1(ml_val); CAMLreturn(Val_int(mpz_get_si(* mpz_val(ml_val)))); } value _mlgmp_z_to_float(value v) { CAMLparam1(v); CAMLlocal1(r); r = copy_double(mpz_get_d(*mpz_val(v))); CAMLreturn(r); } /*** Operations */ /**** Arithmetic */ #define z_binary_op_ui(op) \ value _mlgmp_z_##op(value a, value b) \ { \ CAMLparam2(a, b); \ CAMLlocal1(r); \ r=alloc_init_mpz(); \ mpz_##op(*mpz_val(r), *mpz_val(a), Int_val(b)); \ CAMLreturn(r); \ } \ \ value _mlgmp_z2_##op(value r, value a, value b) \ { \ CAMLparam3(r, a, b); \ mpz_##op(*mpz_val(r), *mpz_val(a), Int_val(b)); \ CAMLreturn(Val_unit); \ } #define z_binary_op_mpz(op) \ value _mlgmp_z_##op(value a, value b) \ { \ CAMLparam2(a, b); \ CAMLlocal1(r); \ r=alloc_init_mpz(); \ mpz_##op(*mpz_val(r), *mpz_val(a), *mpz_val(b)); \ CAMLreturn(r); \ } \ \ value _mlgmp_z2_##op(value r, value a, value b) \ { \ CAMLparam3(r, a, b); \ mpz_##op(*mpz_val(r), *mpz_val(a), *mpz_val(b)); \ CAMLreturn(Val_unit); \ } #define z_binary_op(op) \ z_binary_op_mpz(op) \ z_binary_op_ui(op##_ui) z_binary_op(add) z_binary_op(sub) z_binary_op(mul) /**** Powers */ z_binary_op_ui(pow_ui) value _mlgmp_z_powm_ui(value a, value b, value modulus) { CAMLparam3(a, b, modulus); CAMLlocal1(r); r=alloc_init_mpz(); mpz_powm_ui(*mpz_val(r), *mpz_val(a), Int_val(b), *mpz_val(modulus)); CAMLreturn(r); } value _mlgmp_z_ui_pow_ui(value a, value b) { CAMLparam2(a, b); CAMLlocal1(r); r=alloc_init_mpz(); mpz_ui_pow_ui(*mpz_val(r), Int_val(a), Int_val(b)); CAMLreturn(r); } value _mlgmp_z_powm(value a, value b, value modulus) { CAMLparam3(a, b, modulus); CAMLlocal1(r); r=alloc_init_mpz(); mpz_powm(*mpz_val(r), *mpz_val(a), *mpz_val(b), *mpz_val(modulus)); CAMLreturn(r); } value _mlgmp_z2_powm_ui(value r, value a, value b, value modulus) { CAMLparam4(r, a, b, modulus); mpz_powm_ui(*mpz_val(r), *mpz_val(a), Int_val(b), *mpz_val(modulus)); CAMLreturn(Val_unit); } value _mlgmp_z2_ui_pow_ui(value r, value a, value b) { CAMLparam3(r, a, b); mpz_ui_pow_ui(*mpz_val(r), Int_val(a), Int_val(b)); CAMLreturn(Val_unit); } value _mlgmp_z2_powm(value r, value a, value b, value modulus) { CAMLparam4(r, a, b, modulus); mpz_powm(*mpz_val(r), *mpz_val(a), *mpz_val(b), *mpz_val(modulus)); CAMLreturn(Val_unit); } /**** Unary */ #define z_unary_op(op) \ value _mlgmp_z_##op(value a) \ { \ CAMLparam1(a); \ CAMLlocal1(r); \ r=alloc_init_mpz(); \ mpz_##op(*mpz_val(r), *mpz_val(a)); \ CAMLreturn(r); \ } \ \ value _mlgmp_z2_##op(value r, value a) \ { \ CAMLparam2(r, a); \ mpz_##op(*mpz_val(r), *mpz_val(a)); \ CAMLreturn(Val_unit); \ } z_unary_op(neg) z_unary_op(abs) /**** Roots */ /* Negative ?*/ z_unary_op(sqrt) value _mlgmp_z_sqrtrem(value a) { CAMLparam1(a); CAMLlocal3(q, r, qr); q=alloc_init_mpz(); r=alloc_init_mpz(); mpz_sqrtrem(*mpz_val(q), *mpz_val(r), *mpz_val(a)); qr=alloc_tuple(2); Store_field(qr, 0, q); Store_field(qr, 1, r); CAMLreturn(qr); } z_binary_op_ui(root) #define z_unary_p(name) \ value _mlgmp_z_##name(value a) \ { \ CAMLparam1(a); \ CAMLreturn(Val_bool(mpz_##name(*mpz_val(a))));\ } z_unary_p(perfect_power_p) z_unary_p(perfect_square_p) /**** Division */ /* IMPORTANT NOTE: Storing mpz_val(d) into a temporary pointer won't work because the GC may move the data when allocating q and r. */ #define z_xdivision_op(kind) \ value _mlgmp_z_##kind##div_qr(value n, value d) \ { \ CAMLparam2(n, d); \ CAMLlocal3(q, r, qr); \ if (! mpz_sgn(*mpz_val(d))) \ division_by_zero(); \ \ q=alloc_init_mpz(); \ r=alloc_init_mpz(); \ \ mpz_##kind##div_qr(*mpz_val(q), *mpz_val(r), *mpz_val(n), *mpz_val(d));\ \ qr=alloc_tuple(2); \ Store_field(qr, 0, q); \ Store_field(qr, 1, r); \ CAMLreturn(qr); \ } \ \ value _mlgmp_z_##kind##div_q(value n, value d) \ { \ CAMLparam2(n, d); \ CAMLlocal1(q); \ \ if (! mpz_sgn(*mpz_val(d))) \ division_by_zero(); \ \ q=alloc_init_mpz(); \ \ mpz_##kind##div_q(*mpz_val(q), *mpz_val(n), *mpz_val(d)); \ \ CAMLreturn(q); \ } \ \ value _mlgmp_z2_##kind##div_q(value q, value n, value d) \ { \ CAMLparam3(q, n, d); \ \ if (! mpz_sgn(*mpz_val(d))) \ division_by_zero(); \ \ mpz_##kind##div_q(*mpz_val(q), *mpz_val(n), *mpz_val(d)); \ \ CAMLreturn(Val_unit); \ } \ \ value _mlgmp_z_##kind##div_r(value n, value d) \ { \ CAMLparam2(n, d); \ CAMLlocal1(r); \ \ if (! mpz_sgn(*mpz_val(d))) \ division_by_zero(); \ \ r=alloc_init_mpz(); \ \ mpz_##kind##div_r(*mpz_val(r), *mpz_val(n), *mpz_val(d)); \ \ CAMLreturn(r); \ } \ \ value _mlgmp_z2_##kind##div_r(value r, value n, value d) \ { \ CAMLparam3(r, n, d); \ \ if (! mpz_sgn(*mpz_val(d))) \ division_by_zero(); \ \ mpz_##kind##div_r(*mpz_val(r), *mpz_val(n), *mpz_val(d)); \ \ CAMLreturn(Val_unit); \ } \ \ value _mlgmp_z_##kind##div_qr_ui(value n, value d) \ { \ CAMLparam2(n, d); \ CAMLlocal3(q, r, qr); \ unsigned long int ui_d = Int_val(d); \ \ if (! ui_d) division_by_zero(); \ \ q=alloc_init_mpz(); \ r=alloc_init_mpz(); \ \ mpz_##kind##div_qr_ui(*mpz_val(q), *mpz_val(r), *mpz_val(n), ui_d); \ \ qr=alloc_tuple(2); \ Store_field(qr, 0, q); \ Store_field(qr, 1, r); \ CAMLreturn(qr); \ } \ \ value _mlgmp_z_##kind##div_q_ui(value n, value d) \ { \ CAMLparam2(n, d); \ CAMLlocal1(q); \ unsigned long int ui_d = Int_val(d); \ \ if (! ui_d) division_by_zero(); \ \ q=alloc_init_mpz(); \ \ mpz_##kind##div_q_ui(*mpz_val(q), *mpz_val(n), ui_d); \ \ CAMLreturn(q); \ } \ \ value _mlgmp_z2_##kind##div_q_ui(value q, value n, value d) \ { \ CAMLparam3(q, n, d); \ unsigned long int ui_d = Int_val(d); \ \ if (! ui_d) division_by_zero(); \ \ mpz_##kind##div_q_ui(*mpz_val(q), *mpz_val(n), ui_d); \ \ CAMLreturn(Val_unit); \ } \ \ value _mlgmp_z_##kind##div_r_ui(value n, value d) \ { \ CAMLparam2(n, d); \ CAMLlocal1(r); \ unsigned long int ui_d = Int_val(d); \ \ if (! ui_d) division_by_zero(); \ \ r=alloc_init_mpz(); \ \ mpz_##kind##div_r_ui(*mpz_val(r), *mpz_val(n), ui_d); \ \ CAMLreturn(r); \ } \ \ value _mlgmp_z2_##kind##div_r_ui(value r, value n, value d) \ { \ CAMLparam3(r, n, d); \ unsigned long int ui_d = Int_val(d); \ \ if (! ui_d) division_by_zero(); \ \ mpz_##kind##div_r_ui(*mpz_val(r), *mpz_val(n), ui_d); \ \ CAMLreturn(Val_unit); \ } \ \ value _mlgmp_z_##kind##div_ui(value n, value d) \ { \ CAMLparam2(n, d); \ unsigned long int ui_d = Int_val(d); \ \ if (! ui_d) division_by_zero(); \ \ CAMLreturn(Val_int(mpz_##kind##div_ui(*mpz_val(n), ui_d))); \ } z_xdivision_op(t) z_xdivision_op(f) z_xdivision_op(c) #define z_division_op(op) \ value _mlgmp_z_##op(value n, value d) \ { \ CAMLparam2(n, d); \ CAMLlocal1(q); \ \ if (! mpz_sgn(*mpz_val(d))) \ division_by_zero(); \ \ q=alloc_init_mpz(); \ \ mpz_##op(*mpz_val(q), *mpz_val(n), *mpz_val(d)); \ \ CAMLreturn(q); \ } \ \ value _mlgmp_z2_##op(value q, value n, value d) \ { \ CAMLparam3(q, n, d); \ \ if (! mpz_sgn(*mpz_val(d))) \ division_by_zero(); \ \ mpz_##op(*mpz_val(q), *mpz_val(n), *mpz_val(d)); \ \ CAMLreturn(Val_unit); \ } #define z_division_op_ui(op) \ value _mlgmp_z_##op(value n, value d) \ { \ CAMLparam2(n, d); \ CAMLlocal1(q); \ unsigned int ld = Int_val(d); \ \ if (! ld) \ division_by_zero(); \ \ q=alloc_init_mpz(); \ \ mpz_##op(*mpz_val(q), *mpz_val(n), ld); \ \ CAMLreturn(q); \ } \ \ value _mlgmp_z2_##op(value q, value n, value d) \ { \ CAMLparam3(q, n, d); \ unsigned int ld = Int_val(d); \ \ if (! ld) \ division_by_zero(); \ \ mpz_##op(*mpz_val(q), *mpz_val(n), ld); \ \ CAMLreturn(Val_unit); \ } z_division_op(divexact) z_division_op(mod) z_division_op_ui(mod_ui) /*** Shift ops */ #define z_shift_op(type) \ value _mlgmp_z_##type(value a, value shift) \ { \ CAMLparam2(a, shift); \ CAMLlocal1(r); \ r=alloc_init_mpz(); \ mpz_##type(*mpz_val(r), *mpz_val(a), Int_val(shift)); \ CAMLreturn(r); \ } \ \ value _mlgmp_z2_##type(value r, value a, value shift) \ { \ CAMLparam3(r, a, shift); \ mpz_##type(*mpz_val(r), *mpz_val(a), Int_val(shift)); \ CAMLreturn(Val_unit); \ } #define z_shift_op_unimplemented(type) \ value _mlgmp_z_##type(value a, value shift) \ { \ CAMLparam2(a, shift); \ CAMLreturn0(); \ } \ \ value _mlgmp_z2_##type(value r, value a, value shift) \ { \ CAMLparam3(r, a, shift); \ unimplemented(z2_##type); \ CAMLreturn0(); \ } z_shift_op(mul_2exp) z_shift_op(tdiv_q_2exp) z_shift_op(tdiv_r_2exp) z_shift_op(fdiv_q_2exp) z_shift_op(fdiv_r_2exp) #if __GNU_MP_VERSION >= 4 z_shift_op(cdiv_q_2exp) z_shift_op(cdiv_r_2exp) #else z_shift_op_unimplemented(cdiv_q_2exp) z_shift_op_unimplemented(cdiv_r_2exp) #endif /*** Comparisons */ int _mlgmp_z_custom_compare(value a, value b) { CAMLparam2(a, b); CAMLreturn(mpz_cmp(*mpz_val(a), *mpz_val(b))); } value _mlgmp_z_compare(value a, value b) { CAMLparam2(a, b); CAMLreturn(Val_int(mpz_cmp(*mpz_val(a), *mpz_val(b)))); } value _mlgmp_z_compare_si(value a, value b) { CAMLparam2(a, b); CAMLreturn(Val_int(mpz_cmp_si(*mpz_val(a), Int_val(b)))); } /*** Number theory */ value _mlgmp_z_probab_prime_p(value n, value reps) { CAMLparam2(n, reps); CAMLreturn(Val_bool(mpz_probab_prime_p(*mpz_val(n), Int_val(reps)))); } z_unary_op(nextprime) z_binary_op(gcd) z_binary_op_mpz(lcm) value _mlgmp_z_gcdext(value a, value b) { CAMLparam2(a, b); CAMLlocal4(g, s, t, r); g=alloc_init_mpz(); s=alloc_init_mpz(); t=alloc_init_mpz(); mpz_gcdext(*mpz_val(g), *mpz_val(s), *mpz_val(t), *mpz_val(a), *mpz_val(b)); r=alloc_tuple(3); Store_field(r, 0, g); Store_field(r, 1, s); Store_field(r, 2, t); CAMLreturn(r); } value _mlgmp_z_invert(value a, value b) { CAMLparam2(a, b); CAMLlocal2(i, r); i = alloc_init_mpz(); if (! mpz_invert(*mpz_val(i),*mpz_val(a), *mpz_val(b))) { r=Val_false; } else { r=alloc_tuple(1); Store_field(r, 0, i); } CAMLreturn(r); } #define z_int_binary_op(op) \ value _mlgmp_z_##op(value a, value b) \ { \ CAMLparam2(a, b); \ CAMLreturn(Val_int(mpz_##op(*mpz_val(a), *mpz_val(b)))); \ } z_int_binary_op(legendre) z_int_binary_op(jacobi) value _mlgmp_z_kronecker_si(value a, value b) { CAMLparam2(a, b); CAMLreturn(Val_int(mpz_kronecker_si(*mpz_val(a), Int_val(b)))); } value _mlgmp_z_si_kronecker(value a, value b) { CAMLparam2(a, b); CAMLreturn(Val_int(mpz_si_kronecker(Int_val(a), *mpz_val(b)))); } value _mlgmp_z_remove(value a, value b) { int x; CAMLparam2(a, b); CAMLlocal2(f, r); f = alloc_init_mpz(); x = mpz_remove(*mpz_val(f), *mpz_val(a), *mpz_val(b)); r=alloc_tuple(2); Store_field(r, 0, f); Store_field(r, 1, Val_int(x)); CAMLreturn(r); } #define z_unary_op_ui(op) \ value _mlgmp_z_##op(value a) \ { \ CAMLparam1(a); \ CAMLlocal1(r); \ r = alloc_init_mpz(); \ mpz_##op(*mpz_val(r), Int_val(a)); \ CAMLreturn(r); \ } z_unary_op_ui(fac_ui) z_unary_op_ui(fib_ui) z_binary_op_ui(bin_ui) value _mlgmp_z_bin_uiui(value n, value k) { CAMLparam2(n, k); CAMLlocal1(r); r = alloc_init_mpz(); mpz_bin_uiui(*mpz_val(r), Int_val(n), Int_val(k)); CAMLreturn(r); } #define z_int_unary_op(op) \ value _mlgmp_z_##op(value a) \ { \ CAMLparam1(a); \ CAMLreturn(Val_int(mpz_##op(*mpz_val(a)))); \ } z_int_unary_op(sgn) z_binary_op_mpz(and) z_binary_op_mpz(ior) z_binary_op_mpz(xor) z_unary_op(com) z_int_unary_op(popcount) z_int_binary_op(hamdist) #define z_int_binary_op_ui(op) \ value _mlgmp_z_##op(value a, value b) \ { \ CAMLparam2(a, b); \ CAMLreturn(Val_int(mpz_##op(*mpz_val(a), Int_val(b)))); \ } z_int_binary_op_ui(scan0) z_int_binary_op_ui(scan1) /*** Random */ #define z_random_op_ui(op) \ value _mlgmp_z_##op(value state, value n) \ { \ CAMLparam2(state, n); \ CAMLlocal1(r); \ r = alloc_init_mpz(); \ mpz_##op(*mpz_val(r), *randstate_val(state), Int_val(n)); \ CAMLreturn(r); \ } #define z_random_op(op) \ value _mlgmp_z_##op(value state, value n) \ { \ CAMLparam2(state, n); \ CAMLlocal1(r); \ r = alloc_init_mpz(); \ mpz_##op(*mpz_val(r), *randstate_val(state), *mpz_val(n)); \ CAMLreturn(r); \ } z_random_op_ui(urandomb) z_random_op(urandomm) z_random_op_ui(rrandomb) /*** Serialization */ value _mlgmp_z_initialize() { CAMLparam0(); register_custom_operations(& _mlgmp_custom_z); CAMLreturn(Val_unit); } #ifdef SERIALIZE void _mlgmp_z_serialize(value v, unsigned long * wsize_32, unsigned long * wsize_64) { CAMLparam1(v); char *s; int len; *wsize_32 = MPZ_SIZE_ARCH32; *wsize_64 = MPZ_SIZE_ARCH64; s = mpz_get_str (NULL, 16, *mpz_val(v)); len = strlen(s); serialize_int_4(len); serialize_block_1(s, len); free(s); CAMLreturn0; } unsigned long _mlgmp_z_deserialize(void * dst) { char *s; int len; len = deserialize_uint_4(); s = malloc(len+1); deserialize_block_1(s, len); s[len] = 0; mpz_init_set_str (*((mpz_t*) dst), s, 16); free(s); return sizeof(mpz_t); } #endif /* Hash */ long _mlgmp_z_hash(value v) { CAMLparam1(v); mpz_t dummy; long r; mpz_init(dummy); r = mpz_mod_ui(dummy, *mpz_val(v), HASH_MODULUS); mpz_clear(dummy); CAMLreturn(r); } creal-0.7/mlgmp/config.h0000644000246300002640000000301210330104265016304 0ustar filliatrdemons00000000000000#define SERIALIZE #undef USE_MPFR #define NDEBUG #undef TRACE #include #ifdef USE_MPFR #include /* If you use version 20011026 of MPFR, use #define mpfr_get_z_exp mpz_get_fr */ #endif /* This is the largest prime less than 2^32 */ #define HASH_MODULUS 4294967291UL #ifdef TRACE #define trace(x) do { fprintf(stderr, "mlgmp: %s%s\n", MODULE, #x);\ fflush(stderr); } while(0) #else #define trace(x) #endif #ifdef __GNUC__ #define noreturn __attribute__((noreturn)) #else #define noreturn #endif /* In C99 or recent versions of gcc, - you can specify which field you want to initialize - you have "inline". */ #if defined(__GNUC__) || (defined(__STDC__) && __STDC_VERSION__ >= 199901L) #define field(x) .x = #else #define field(x) #define inline #endif #ifdef SERIALIZE /* Sizes of types on arch 32/ arch 64 */ /* THOSE SIZES ARE A HACK. */ /* __mpz_struct = 2*int + ptr */ #define MPZ_SIZE_ARCH32 12 #define MPZ_SIZE_ARCH64 16 /* __mpq_struct = 2 * __mpz_struct */ #define MPQ_SIZE_ARCH32 (2 * MPZ_SIZE_ARCH32) #define MPQ_SIZE_ARCH64 (2 * MPZ_SIZE_ARCH64) /* __mpf_struct = 3 * int + ptr */ #define MPF_SIZE_ARCH32 16 #define MPF_SIZE_ARCH64 24 /* __mpfr_struct = 3 * int + ptr */ #define MPFR_SIZE_ARCH32 16 #define MPFR_SIZE_ARCH64 24 extern void serialize_int_4(int32 i); extern void serialize_block_1(void * data, long len); extern uint32 deserialize_uint_4(void); extern int32 deserialize_sint_4(void); extern void deserialize_block_1(void * data, long len); #endif /* SERIALIZE */ creal-0.7/mlgmp/mlgmp.h0000644000246300002640000000013010330104265016151 0ustar filliatrdemons00000000000000void division_by_zero(void) noreturn; void raise_unimplemented(const char *s) noreturn; creal-0.7/trace.ml0000644000246300002640000000200410330104265015202 0ustar filliatrdemons00000000000000 open Graphics let pi = 4. *. atan 1. let xmin = -9. let xmax = 9. let ymin = -1. let ymax = 1. let creal = ref false let () = Arg.parse ["-creal", Arg.Set creal, ""; "-cr", Arg.Clear creal, ""] (fun _ -> ()) "" let f_creal x = Creal.to_float (Creal.sin (Creal.of_float x)) 3 let f_cr x = Cr.to_float (Cr.sin (Cr.of_float x)) 6 let f = if !creal then f_creal else f_cr let w = 800 let h = 600 let g = Printf.sprintf " %dx%d" w h let () = open_graph g; set_color black let one_pixel = (xmax -. xmin) /. float w let dx = xmax -. xmin let dy = ymax -. ymin let i x = truncate (float w *. (x -. xmin) /. dx) let j y = truncate (float h *. (y -. ymin) /. dy) let moveto x y = moveto (i x) (j y) let lineto x y = lineto (i x) (j y) let plot x y = plot (i x) (j y) let () = moveto 0. ymin; lineto 0. ymax; moveto xmin 0.; lineto xmax 0. let () = for i = 0 to w - 1 do let x = xmin +. float i *. one_pixel in let y = f x in Graphics.plot i (j y) done let _ = wait_next_event [Key_pressed] creal-0.7/calc.mll0000644000246300002640000001064510330104265015174 0ustar filliatrdemons00000000000000(* * Exact calculator. * Copyright (C) 2001 Jean-Christophe FILLIATRE * * This software is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License version 2, as published by the Free Software Foundation. * * This software is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * See the GNU Library General Public License version 2 for more details * (enclosed in the file LGPL). *) (*i $Id: calc.mll,v 1.6 2005/10/26 09:25:06 filliatr Exp $ i*) { open Lexing open Printf open Cr (*s Options and parsing of the command-line. *) let precision = ref 10 let usage = "usage: ecalc [-p prec] ecalc is a reverse-polish exact calcultator Copyright (c) 2001- Jean-Christophe Filliâtre This is free software with ABSOLUTELY NO WARRANTY commands are k, prec pops the top of stack and uses it as precision ;, p, print displays top of stack n, popd pops top of stack and displays it f, show displays the whole stack pop pops top of stack c, clear clears the stack d, dup duplicates top of stack r, swap swaps the two elements on top of stack constants are pi, e binary operations are +, -, *, /, log ('x y log' is log_x(y)), pow (or ^) unary operations are ~ (negation), i (inverse), sqrt (or v), sin, cos, tan, ln, exp, arcsin, arccos, arctan, sinh, cosh, tanh, arcsinh, arccosh, arctanh options are" let speclist = ["-p", Arg.Int (fun n -> precision := n), " set decimal precision"] let _ = Arg.parse speclist (fun _ -> ()) usage (*s The stack. *) let stack = ref [] let push x = stack := x :: !stack let error msg = printf "%s\n" msg; flush stdout let pop () = match !stack with | [] -> invalid_arg "pop" | x :: l -> stack := l; x let display_stack () = List.iter (fun x -> printf " %s\n" (to_string x !precision)) (List.rev !stack); flush stdout (*s Unary and binary operations on the stack. *) let unop f = push (f (pop ())) let binop f = let x2 = pop () in let x1 = pop () in push (f x1 x2) } (*s Commands are parsed with a lexer. *) let digit = ['0'-'9'] let constant = digit+ | (digit* '.' digit+ | digit+ '.' digit*) rule loop = parse | [' ' '\t' '\n']+ { loop lexbuf } | "help" { Arg.usage speclist usage; flush stderr } | "k" | "prec" | "precision" { precision := Gmp.Z.int_from (approx (pop ()) 0) } | "K" | "pushprec" { push (of_int !precision) } | "f" | "show" | "stack" { display_stack () } | "n" | "popd" { let x = pop () in printf " %s\n" (to_string x !precision); flush stdout } | ";" | "p" | "print" { match !stack with | [] -> error "" | x :: _ -> printf " %s\n" (to_string x !precision); flush stdout } | "pop" { ignore (pop ()) } | "c" | "clear" { stack := [] } | "d" | "dup" { let x = pop () in push x; push x } | "r" | "swap" { let x = pop () in let y = pop () in push x; push y } | "z" | "pushstackdepth" { push (of_int (List.length !stack)) } | constant { push (of_string (lexeme lexbuf)) } | "pi" { push pi } | "e" { push e } | "+" { binop add } | "-" { binop sub } | "*" { binop mul } | "/" { binop div } | "~" { unop neg } | "i" { unop inv } | "sin" { unop sin } | "cos" { unop cos } | "tan" { unop tan } | "arcsin" { unop arcsin } | "arccos" { unop arccos } | "arctan" { unop arctan } | "exp" { unop exp } | "ln" { unop ln } | "log" { binop (fun base -> log ~base) } | "^" | "pow" { binop pow } | "sinh" { unop sinh } | "cosh" { unop cosh } | "tanh" { unop tanh } | "arcsinh" { unop arcsinh } | "arccosh" { unop arccosh } | "arctanh" { unop arctanh } | "v" | "sqrt" { unop sqrt } | eof { raise End_of_file } | _ { raise Parsing.Parse_error } { (*s The main program is an infinite loop exiting on [End_of_file]. *) let _ = Sys.catch_break true let main () = let lb = from_channel stdin in try while true do try loop lb with | Sys.Break -> error "" | Parsing.Parse_error -> error "" | Invalid_argument "pop" -> error "" done with End_of_file -> flush stdout; exit 0 let _ = Printexc.catch main () } creal-0.7/test.ml0000644000246300002640000001164110330104265015072 0ustar filliatrdemons00000000000000 (*s Test program for [Creal]. *) open Printf open Gmp open Creal open Creal.Infixes (*s Options *) let prec = ref 50 let display = ref true let sanity_check = ref false let _ = Arg.parse ["-p", Arg.Int ((:=) prec), "n set the precision"; "-silent", Arg.Clear display, " no display"; "-check", Arg.Set sanity_check, " only sanity checks" ] (fun s -> raise (Arg.Bad ("unknown option " ^ s))) "test [-p prec] [silent]" (*s Sanity checks. Compare two numbers up to the precision. *) let _ = if !sanity_check then begin printf "*** Sanity checks ***\n\n"; flush stdout end let check msg x y = if !sanity_check then begin printf "%s... " msg; flush stdout; let delta = Z.sub (approx x !prec) (approx y !prec) in if Z.cmp_si (Z.abs delta) 1 <= 0 then printf "ok\n\n" else begin printf "FAILED!\n\n"; exit 1 end; flush stdout end let sqrt_2 = sqrt two let _ = check "sqrt(2)^2 = 2" (sqrt_2 *! sqrt_2) two let _ = check "1/sqrt(2) = sqrt(2)/2" (inv sqrt_2) (sqrt_2 /! two) let sqrt_3 = sqrt (of_int 3) let _ = check "1 = (sqrt(3) + sqrt(2)) * (sqrt(3) - sqrt(2))" one ((sqrt_3 +! sqrt_2) *! (sqrt_3 -! sqrt_2)) let _ = check "(sqrt(2) ^ sqrt(2)) ^ sqrt(2) = 2" (pow (pow sqrt_2 sqrt_2) sqrt_2) two let one_third = of_int 1 /! of_int 3 let root3 x = pow x one_third let _ = check "54^1/3 - 2^1/3 = 16^1/3" (root3 (of_int 54) -! root3 two) (root3 (of_int 16)) let _ = check "cos(0)=1" (cos zero) one let _ = check "cos(pi/2)=0" (cos half_pi) zero let _ = check "sin(0)=0" (sin zero) zero let _ = check "sin(pi/2)=1" (sin half_pi) one let pi_over_4 = pi /! (of_int 4) let square x = x *! x let _ = check "cos^2(pi/4) + sin^2(pi/4) = 1" (square (cos pi_over_4) +! square (sin pi_over_4)) one let _ = check "tan(pi/4) = 1" (tan pi_over_4) one let _ = check "pi/4 = 4arctan(1/5) - arctan(1/239)" pi_over_4 (of_int 4 *! arctan_reciproqual 5 -! arctan_reciproqual 239) let _ = check "ln(1) = 0" (ln one) zero let _ = check "ln(e) = 1" (ln e) one let _ = check "ln(pi*pi) = 2ln(pi)" (ln (square pi)) (two *! ln pi) let _ = check "exp(-pi) = exp(-pi/2) * exp(-pi/2)" (exp (neg pi)) (let y = exp (neg half_pi) in y *! y) let _ = if !sanity_check then exit 0 (*s Benchmark. *) (* Test function: display the real number, if not [silent] ; otherwise, just compute the approximation (for timings). *) let _ = printf "\n*** Benchmarks ***\n\n"; flush stdout let test msg beautiful x = if !display then begin printf "%s = " msg; flush stdout; printf "%s\n\n" (if beautiful then to_beautiful_string x !prec else to_string x !prec); flush stdout end else begin printf "%s\n" msg; flush stdout; ignore (approx x !prec) end (*s golden ratio *) let phi = (one +! sqrt (of_int 5)) /! (of_int 2) let _ = test "golden ratio" true phi (* e (predefined in [Creal]) *) let _ = test "e" true e (* pi (predefined in [Creal]) *) let _ = test "pi" true pi (*s The Exact Arithmetic Competition: Level 0 Tests http://www.cs.man.ac.uk/arch/dlester/arithmetic/level0t.html *) (* sqrt(pi) *) let _ = test "sqrt(pi)" false (sqrt pi) (* sin(exp(1)) *) let _ = test "sin(e)" false (sin e) (* cos(exp(1)) *) let _ = test "cos(e)" false (cos e) (* sin(sin(sin(1))) *) let x = sin (sin (sin one)) let _ = test "sin(sin(sin(1)))" false x (* cos(cos(cos(1))) *) let x = cos (cos (cos one)) let _ = test "cos(cos(cos(1)))" false x (* exp(exp(exp(1))) *) let x = exp (exp (exp one)) let _ = test "exp(exp(exp(1)))" false x (* log(pi) *) let _ = test "ln(pi)" false (ln pi) (* log(1+log(1+log(1+pi))) *) let ln_ln_ln_pi = ln (one +! ln (one +! ln (one +! pi))) let _ = test "ln(1+ln(1+ln(1+pi)))" false ln_ln_ln_pi (* log(1+log(1+log(1+exp(1)))) *) let ln_ln_ln_e = ln (one +! ln (one +! ln (one +! e))) let _ = test "ln(1+ln(1+ln(1+e)))" false ln_ln_ln_e (*i (* log(1+log(1+log(1+log(1+log(1+log(1+pi)))))) *) let x = ln (one +! ln (one +! ln (one +! ln_ln_ln_pi))) let _ = test "ln(1+ln(1+ln(1+ln(1+ln(1+ln(1+pi))))))" false x (* log(1+log(1+log(1+log(1+log(1+log(1+exp(1))))))) *) let x = ln (one +! ln (one +! ln (one +! ln_ln_ln_e))) let _ = test "ln(1+ln(1+ln(1+ln(1+ln(1+ln(1+e))))))" false x i*) (* sin(1e50) *) let ten_to_50 = pow_int (of_int 10) 50 let x = sin ten_to_50 let _ = test "sin(1e50)" false x (* cos(1e50) *) let x = cos ten_to_50 let _ = test "cos(1e50)" false x (* arctan(1) *) (*let _ = test "arctan(1)" false (arctan one)*) (*i (* BUG GMP 2 *) let q = Q.from_zs (Z.from_int 1) (Z.from_string "19807040628566084398385987584" 10) let _ = Q.add q (Q.from_ints 1 2) (* BUG GMP 3 *) let q = Q.from_zs (Z.from_string "112803124130337404998606757686274889113032882986303222429756948481" 10) (Z.from_string "5192296858534827628530496329220096" 10) let q' = Q.add q (Q.from_ints 1 2) let _ = Z.fdiv_q (Q.get_num q') (Q.get_den q') let time f x = let old = Sys.time () in let y = f x in Printf.printf "%f\n" (Sys.time () -. old); y ;; i*) creal-0.7/creal_pp.ml0000644000246300002640000000022610330104265015675 0ustar filliatrdemons00000000000000 open Format let precision = ref 20;; let pp x = print_string (try Creal.to_string x !precision with e -> "Error: " ^ Printexc.to_string e);; creal-0.7/creal_pp.mli0000644000246300002640000000006210330104265016044 0ustar filliatrdemons00000000000000 val precision : int ref val pp : Creal.t -> unit creal-0.7/gmp_pp.ml0000644000246300002640000000033310330104265015371 0ustar filliatrdemons00000000000000 open Gmp open Format let z z = print_string (Z.string_from z) let q q = let n = Q.get_num q and d = Q.get_den q in print_string (Z.string_from n); if Z.cmp_si d 1 != 0 then printf "/%s" (Z.string_from d);; creal-0.7/gmp_pp.mli0000644000246300002640000000006310330104265015542 0ustar filliatrdemons00000000000000 open Gmp val z : Z.t -> unit val q : Q.t -> unit creal-0.7/install_creal_pp.ml0000644000246300002640000000051210330104265017421 0ustar filliatrdemons00000000000000 (* This is a hack to install the pretty-printers in the customized toplevel. *) (* Caml longidents. *) type t = | Lident of string | Ldot of t * string | Lapply of t * t let _ = Topdirs.dir_directory "+creal" let _ = Topdirs.dir_install_printer Format.std_formatter (Obj.magic (Ldot (Lident "Creal_pp", "pp")) : 'a) creal-0.7/install_gmp_pp.ml0000644000246300002640000000066410330104265017126 0ustar filliatrdemons00000000000000 (* This is a hack to install the pretty-printers in the customized toplevel. *) (* Caml longidents. *) type t = | Lident of string | Ldot of t * string | Lapply of t * t let _ = Topdirs.dir_directory "+creal" let _ = Topdirs.dir_install_printer Format.std_formatter (Obj.magic (Ldot (Lident "Gmp_pp", "z")) : 'a) let _ = Topdirs.dir_install_printer Format.std_formatter (Obj.magic (Ldot (Lident "Gmp_pp", "q")) : 'a) creal-0.7/configure0000755000246300002640000010603510330104265015472 0ustar filliatrdemons00000000000000#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated automatically using autoconf version 2.13 # Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. # Defaults: ac_help= ac_default_prefix=/usr/local # Any additions from configure.in: # Initialize some variables set by options. # The variables have the same names as the options, with # dashes changed to underlines. build=NONE cache_file=./config.cache exec_prefix=NONE host=NONE no_create= nonopt=NONE no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= target=NONE verbose= x_includes=NONE x_libraries=NONE bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' # Initialize some other variables. subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Maximum number of lines to put in a shell here document. ac_max_here_lines=12 ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi case "$ac_option" in -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; *) ac_optarg= ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case "$ac_option" in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir="$ac_optarg" ;; -build | --build | --buil | --bui | --bu) ac_prev=build ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build="$ac_optarg" ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file="$ac_optarg" ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir="$ac_optarg" ;; -disable-* | --disable-*) ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } fi ac_feature=`echo $ac_feature| sed 's/-/_/g'` eval "enable_${ac_feature}=no" ;; -enable-* | --enable-*) ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } fi ac_feature=`echo $ac_feature| sed 's/-/_/g'` case "$ac_option" in *=*) ;; *) ac_optarg=yes ;; esac eval "enable_${ac_feature}='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix="$ac_optarg" ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he) # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat << EOF Usage: configure [options] [host] Options: [defaults in brackets after descriptions] Configuration: --cache-file=FILE cache test results in FILE --help print this message --no-create do not create output files --quiet, --silent do not print \`checking...' messages --version print the version of autoconf that created configure Directory and file names: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [same as prefix] --bindir=DIR user executables in DIR [EPREFIX/bin] --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] --libexecdir=DIR program executables in DIR [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data in DIR [PREFIX/share] --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data in DIR [PREFIX/com] --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] --libdir=DIR object code libraries in DIR [EPREFIX/lib] --includedir=DIR C header files in DIR [PREFIX/include] --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] --infodir=DIR info documentation in DIR [PREFIX/info] --mandir=DIR man documentation in DIR [PREFIX/man] --srcdir=DIR find the sources in DIR [configure dir or ..] --program-prefix=PREFIX prepend PREFIX to installed program names --program-suffix=SUFFIX append SUFFIX to installed program names --program-transform-name=PROGRAM run sed PROGRAM on installed program names EOF cat << EOF Host type: --build=BUILD configure for building on BUILD [BUILD=HOST] --host=HOST configure for HOST [guessed] --target=TARGET configure for TARGET [TARGET=HOST] Features and packages: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --x-includes=DIR X include files are in DIR --x-libraries=DIR X library files are in DIR EOF if test -n "$ac_help"; then echo "--enable and --with options recognized:$ac_help" fi exit 0 ;; -host | --host | --hos | --ho) ac_prev=host ;; -host=* | --host=* | --hos=* | --ho=*) host="$ac_optarg" ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir="$ac_optarg" ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir="$ac_optarg" ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir="$ac_optarg" ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir="$ac_optarg" ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir="$ac_optarg" ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir="$ac_optarg" ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir="$ac_optarg" ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix="$ac_optarg" ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix="$ac_optarg" ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix="$ac_optarg" ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name="$ac_optarg" ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir="$ac_optarg" ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir="$ac_optarg" ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site="$ac_optarg" ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir="$ac_optarg" ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir="$ac_optarg" ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target="$ac_optarg" ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers) echo "configure generated by autoconf version 2.13" exit 0 ;; -with-* | --with-*) ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } fi ac_package=`echo $ac_package| sed 's/-/_/g'` case "$ac_option" in *=*) ;; *) ac_optarg=yes ;; esac eval "with_${ac_package}='$ac_optarg'" ;; -without-* | --without-*) ac_package=`echo $ac_option|sed -e 's/-*without-//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } fi ac_package=`echo $ac_package| sed 's/-/_/g'` eval "with_${ac_package}=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes="$ac_optarg" ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries="$ac_optarg" ;; -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } ;; *) if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then echo "configure: warning: $ac_option: invalid host type" 1>&2 fi if test "x$nonopt" != xNONE; then { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } fi nonopt="$ac_option" ;; esac done if test -n "$ac_prev"; then { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } fi trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 # File descriptor usage: # 0 standard input # 1 file creation # 2 errors and warnings # 3 some systems may open it to /dev/tty # 4 used on the Kubota Titan # 6 checking for... messages and results # 5 compiler messages saved in config.log if test "$silent" = yes; then exec 6>/dev/null else exec 6>&1 fi exec 5>./config.log echo "\ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. " 1>&5 # Strip out --no-create and --no-recursion so they do not pile up. # Also quote any args containing shell metacharacters. ac_configure_args= for ac_arg do case "$ac_arg" in -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c) ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) ac_configure_args="$ac_configure_args '$ac_arg'" ;; *) ac_configure_args="$ac_configure_args $ac_arg" ;; esac done # NLS nuisances. # Only set these to C if already set. These must not be set unconditionally # because not all systems understand e.g. LANG=C (notably SCO). # Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! # Non-C LC_CTYPE values break the ctype check. if test "${LANG+set}" = set; then LANG=C; export LANG; fi if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo > confdefs.h # A filename unique to this package, relative to the directory that # configure is in, which we can look for to find out if srcdir is correct. ac_unique_file=creal.mli # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_prog=$0 ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } else { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } fi fi srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then echo "loading site script $ac_site_file" . "$ac_site_file" fi done if test -r "$cache_file"; then echo "loading cache $cache_file" . $cache_file else echo "creating cache $cache_file" > $cache_file fi ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross ac_exeext= ac_objext=o if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then ac_n= ac_c=' ' ac_t=' ' else ac_n=-n ac_c= ac_t= fi else ac_n= ac_c='\c' ac_t= fi VERSION=0.7 # Check for Ocaml compilers # we first look for ocamlc in the path; if not present, we fail # Extract the first word of "ocamlc", so it can be a program name with args. set dummy ocamlc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:534: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_OCAMLC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$OCAMLC"; then ac_cv_prog_OCAMLC="$OCAMLC" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_OCAMLC="ocamlc" break fi done IFS="$ac_save_ifs" test -z "$ac_cv_prog_OCAMLC" && ac_cv_prog_OCAMLC="no" fi fi OCAMLC="$ac_cv_prog_OCAMLC" if test -n "$OCAMLC"; then echo "$ac_t""$OCAMLC" 1>&6 else echo "$ac_t""no" 1>&6 fi if test "$OCAMLC" = no ; then { echo "configure: error: Cannot find ocamlc." 1>&2; exit 1; } fi # we extract Ocaml version number and library path OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` echo "ocaml version is $OCAMLVERSION" OCAMLLIB=`$OCAMLC -v | tail -1 | cut -f 4 -d " "` echo "ocaml library path is $OCAMLLIB" # then we look for ocamlopt; if not present, we issue a warning # if the version is not the same, we also discard it # we set OCAMLBEST to "opt" or "byte", whether ocamlopt is available or not # Extract the first word of "ocamlopt", so it can be a program name with args. set dummy ocamlopt; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:577: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_OCAMLOPT'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$OCAMLOPT"; then ac_cv_prog_OCAMLOPT="$OCAMLOPT" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_OCAMLOPT="ocamlopt" break fi done IFS="$ac_save_ifs" test -z "$ac_cv_prog_OCAMLOPT" && ac_cv_prog_OCAMLOPT="no" fi fi OCAMLOPT="$ac_cv_prog_OCAMLOPT" if test -n "$OCAMLOPT"; then echo "$ac_t""$OCAMLOPT" 1>&6 else echo "$ac_t""no" 1>&6 fi OCAMLBEST=byte if test "$OCAMLOPT" = no ; then echo "configure: warning: Cannot find ocamlopt; bytecode compilation only." 1>&2 else echo $ac_n "checking ocamlopt version""... $ac_c" 1>&6 echo "configure:609: checking ocamlopt version" >&5 TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` if test "$TMPVERSION" != $OCAMLVERSION ; then echo "$ac_t""differs from ocamlc; ocamlopt discarded." 1>&6 OCAMLOPT=no else echo "$ac_t""ok" 1>&6 OCAMLBEST=opt fi fi # checking for ocamlc.opt # Extract the first word of "ocamlc.opt", so it can be a program name with args. set dummy ocamlc.opt; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:624: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_OCAMLCDOTOPT'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$OCAMLCDOTOPT"; then ac_cv_prog_OCAMLCDOTOPT="$OCAMLCDOTOPT" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_OCAMLCDOTOPT="ocamlc.opt" break fi done IFS="$ac_save_ifs" test -z "$ac_cv_prog_OCAMLCDOTOPT" && ac_cv_prog_OCAMLCDOTOPT="no" fi fi OCAMLCDOTOPT="$ac_cv_prog_OCAMLCDOTOPT" if test -n "$OCAMLCDOTOPT"; then echo "$ac_t""$OCAMLCDOTOPT" 1>&6 else echo "$ac_t""no" 1>&6 fi if test "$OCAMLCDOTOPT" != no ; then echo $ac_n "checking ocamlc.opt version""... $ac_c" 1>&6 echo "configure:653: checking ocamlc.opt version" >&5 TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` if test "$TMPVERSION" != $OCAMLVERSION ; then echo "$ac_t""differs from ocamlc; ocamlc.opt discarded." 1>&6 else echo "$ac_t""ok" 1>&6 OCAMLC=$OCAMLCDOTOPT fi fi # checking for ocamlopt.opt if test "$OCAMLOPT" != no ; then # Extract the first word of "ocamlopt.opt", so it can be a program name with args. set dummy ocamlopt.opt; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:668: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_OCAMLOPTDOTOPT'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$OCAMLOPTDOTOPT"; then ac_cv_prog_OCAMLOPTDOTOPT="$OCAMLOPTDOTOPT" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_OCAMLOPTDOTOPT="ocamlopt.opt" break fi done IFS="$ac_save_ifs" test -z "$ac_cv_prog_OCAMLOPTDOTOPT" && ac_cv_prog_OCAMLOPTDOTOPT="no" fi fi OCAMLOPTDOTOPT="$ac_cv_prog_OCAMLOPTDOTOPT" if test -n "$OCAMLOPTDOTOPT"; then echo "$ac_t""$OCAMLOPTDOTOPT" 1>&6 else echo "$ac_t""no" 1>&6 fi if test "$OCAMLOPTDOTOPT" != no ; then echo $ac_n "checking ocamlc.opt version""... $ac_c" 1>&6 echo "configure:697: checking ocamlc.opt version" >&5 TMPVER=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` if test "$TMPVER" != $OCAMLVERSION ; then echo "$ac_t""differs from ocamlc; ocamlopt.opt discarded." 1>&6 else echo "$ac_t""ok" 1>&6 OCAMLOPT=$OCAMLOPTDOTOPT fi fi fi # ocamldep, ocamllex and ocamlyacc should also be present in the path # Extract the first word of "ocamldep", so it can be a program name with args. set dummy ocamldep; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:712: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_OCAMLDEP'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$OCAMLDEP"; then ac_cv_prog_OCAMLDEP="$OCAMLDEP" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_OCAMLDEP="ocamldep" break fi done IFS="$ac_save_ifs" test -z "$ac_cv_prog_OCAMLDEP" && ac_cv_prog_OCAMLDEP="no" fi fi OCAMLDEP="$ac_cv_prog_OCAMLDEP" if test -n "$OCAMLDEP"; then echo "$ac_t""$OCAMLDEP" 1>&6 else echo "$ac_t""no" 1>&6 fi if test "$OCAMLDEP" = no ; then { echo "configure: error: Cannot find ocamldep." 1>&2; exit 1; } fi # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:746: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_OCAMLLEX'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$OCAMLLEX"; then ac_cv_prog_OCAMLLEX="$OCAMLLEX" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_OCAMLLEX="ocamllex" break fi done IFS="$ac_save_ifs" test -z "$ac_cv_prog_OCAMLLEX" && ac_cv_prog_OCAMLLEX="no" fi fi OCAMLLEX="$ac_cv_prog_OCAMLLEX" if test -n "$OCAMLLEX"; then echo "$ac_t""$OCAMLLEX" 1>&6 else echo "$ac_t""no" 1>&6 fi if test "$OCAMLLEX" = no ; then { echo "configure: error: Cannot find ocamllex." 1>&2; exit 1; } fi # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:780: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_OCAMLYACC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$OCAMLYACC"; then ac_cv_prog_OCAMLYACC="$OCAMLYACC" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_OCAMLYACC="ocamlyacc" break fi done IFS="$ac_save_ifs" test -z "$ac_cv_prog_OCAMLYACC" && ac_cv_prog_OCAMLYACC="no" fi fi OCAMLYACC="$ac_cv_prog_OCAMLYACC" if test -n "$OCAMLYACC"; then echo "$ac_t""$OCAMLYACC" 1>&6 else echo "$ac_t""no" 1>&6 fi if test "$OCAMLYACC" = no ; then { echo "configure: error: Cannot find ocamlyacc." 1>&2; exit 1; } fi # substitutions to perform # Finally create the Makefile from Makefile.in trap '' 1 2 15 cat > confcache <<\EOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs. It is not useful on other systems. # If it contains results you don't want to keep, you may remove or edit it. # # By default, configure uses ./config.cache as the cache file, # creating it if it does not exist already. You can give configure # the --cache-file=FILE option to use a different cache file; that is # what configure does when it calls configure scripts in # subdirectories, so they share the cache. # Giving --cache-file=/dev/null disables caching, for debugging configure. # config.status only pays attention to the cache file if you give it the # --recheck option to rerun configure. # EOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. (set) 2>&1 | case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote substitution # turns \\\\ into \\, and sed turns \\ into \). sed -n \ -e "s/'/'\\\\''/g" \ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p" ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p' ;; esac >> confcache if cmp -s $cache_file confcache; then : else if test -w $cache_file; then echo "updating cache $cache_file" cat confcache > $cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # Any assignment to VPATH causes Sun make to only execute # the first set of double-colon rules, so remove it if not needed. # If there is a colon in the path, we need to keep it. if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' fi trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. cat > conftest.defs <<\EOF s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g s%\[%\\&%g s%\]%\\&%g s%\$%$$%g EOF DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '` rm -f conftest.defs # Without the "./", some shells look in PATH for config.status. : ${CONFIG_STATUS=./config.status} echo creating $CONFIG_STATUS rm -f $CONFIG_STATUS cat > $CONFIG_STATUS </dev/null | sed 1q`: # # $0 $ac_configure_args # # Compiler output produced by configure, useful for debugging # configure, is in ./config.log if it exists. ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" for ac_option do case "\$ac_option" in -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) echo "$CONFIG_STATUS generated by autoconf version 2.13" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; *) echo "\$ac_cs_usage"; exit 1 ;; esac done ac_given_srcdir=$srcdir trap 'rm -fr `echo "Makefile creal.spec" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 EOF cat >> $CONFIG_STATUS < conftest.subs <<\\CEOF $ac_vpsub $extrasub s%@SHELL@%$SHELL%g s%@CFLAGS@%$CFLAGS%g s%@CPPFLAGS@%$CPPFLAGS%g s%@CXXFLAGS@%$CXXFLAGS%g s%@FFLAGS@%$FFLAGS%g s%@DEFS@%$DEFS%g s%@LDFLAGS@%$LDFLAGS%g s%@LIBS@%$LIBS%g s%@exec_prefix@%$exec_prefix%g s%@prefix@%$prefix%g s%@program_transform_name@%$program_transform_name%g s%@bindir@%$bindir%g s%@sbindir@%$sbindir%g s%@libexecdir@%$libexecdir%g s%@datadir@%$datadir%g s%@sysconfdir@%$sysconfdir%g s%@sharedstatedir@%$sharedstatedir%g s%@localstatedir@%$localstatedir%g s%@libdir@%$libdir%g s%@includedir@%$includedir%g s%@oldincludedir@%$oldincludedir%g s%@infodir@%$infodir%g s%@mandir@%$mandir%g s%@OCAMLC@%$OCAMLC%g s%@OCAMLOPT@%$OCAMLOPT%g s%@OCAMLCDOTOPT@%$OCAMLCDOTOPT%g s%@OCAMLOPTDOTOPT@%$OCAMLOPTDOTOPT%g s%@OCAMLDEP@%$OCAMLDEP%g s%@OCAMLLEX@%$OCAMLLEX%g s%@OCAMLYACC@%$OCAMLYACC%g s%@OCAMLBEST@%$OCAMLBEST%g s%@OCAMLVERSION@%$OCAMLVERSION%g s%@OCAMLLIB@%$OCAMLLIB%g s%@VERSION@%$VERSION%g CEOF EOF cat >> $CONFIG_STATUS <<\EOF # Split the substitutions into bite-sized pieces for seds with # small command number limits, like on Digital OSF/1 and HP-UX. ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. ac_file=1 # Number of current file. ac_beg=1 # First line for current file. ac_end=$ac_max_sed_cmds # Line after last line for current file. ac_more_lines=: ac_sed_cmds="" while $ac_more_lines; do if test $ac_beg -gt 1; then sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file else sed "${ac_end}q" conftest.subs > conftest.s$ac_file fi if test ! -s conftest.s$ac_file; then ac_more_lines=false rm -f conftest.s$ac_file else if test -z "$ac_sed_cmds"; then ac_sed_cmds="sed -f conftest.s$ac_file" else ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" fi ac_file=`expr $ac_file + 1` ac_beg=$ac_end ac_end=`expr $ac_end + $ac_max_sed_cmds` fi done if test -z "$ac_sed_cmds"; then ac_sed_cmds=cat fi EOF cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case "$ac_file" in *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; *) ac_file_in="${ac_file}.in" ;; esac # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. # Remove last slash and all that follows it. Not all systems have dirname. ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then # The file is in a subdirectory. test ! -d "$ac_dir" && mkdir "$ac_dir" ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" # A "../" for each directory in $ac_dir_suffix. ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` else ac_dir_suffix= ac_dots= fi case "$ac_given_srcdir" in .) srcdir=. if test -z "$ac_dots"; then top_srcdir=. else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; *) # Relative path. srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" top_srcdir="$ac_dots$ac_given_srcdir" ;; esac echo creating "$ac_file" rm -f "$ac_file" configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." case "$ac_file" in *Makefile*) ac_comsub="1i\\ # $configure_input" ;; *) ac_comsub= ;; esac ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` sed -e "$ac_comsub s%@configure_input@%$configure_input%g s%@srcdir@%$srcdir%g s%@top_srcdir@%$top_srcdir%g " $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file fi; done rm -f conftest.s* EOF cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF exit 0 EOF chmod +x $CONFIG_STATUS rm -fr confdefs* $ac_clean_files test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 chmod a-w Makefile creal-0.7/configure.in0000644000246300002640000000666010330104265016077 0ustar filliatrdemons00000000000000# autoconf input for Objective Caml programs # by Jean-Christophe Filliâtre, from a first script by Georges Mariano # # the script generated by autoconf from this input will set the following # variables: # OCAMLC "ocamlc" if present in the path, or a failure # or "ocamlc.opt" if present with same version number as ocamlc # OCAMLOPT "ocamlopt" (or "ocamlopt.opt" if present), or "no" # OCAMLBEST either "byte" if no native compiler was found, # or "opt" otherwise # OCAMLDEP "ocamldep" # OCAMLLEX "ocamllex" # OCAMLYACC "ocamlyac" # OCAMLLIB the path to the ocaml standard library # OCAMLVERSION the ocaml version number # check for one particular file of the sources # ADAPT THE FOLLOWING LINE TO YOUR SOURCES! AC_INIT(creal.mli) VERSION=0.7 # Check for Ocaml compilers # we first look for ocamlc in the path; if not present, we fail AC_CHECK_PROG(OCAMLC,ocamlc,ocamlc,no) if test "$OCAMLC" = no ; then AC_MSG_ERROR(Cannot find ocamlc.) fi # we extract Ocaml version number and library path OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` echo "ocaml version is $OCAMLVERSION" OCAMLLIB=`$OCAMLC -v | tail -1 | cut -f 4 -d " "` echo "ocaml library path is $OCAMLLIB" # then we look for ocamlopt; if not present, we issue a warning # if the version is not the same, we also discard it # we set OCAMLBEST to "opt" or "byte", whether ocamlopt is available or not AC_CHECK_PROG(OCAMLOPT,ocamlopt,ocamlopt,no) OCAMLBEST=byte if test "$OCAMLOPT" = no ; then AC_MSG_WARN(Cannot find ocamlopt; bytecode compilation only.) else AC_MSG_CHECKING(ocamlopt version) TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` if test "$TMPVERSION" != $OCAMLVERSION ; then AC_MSG_RESULT(differs from ocamlc; ocamlopt discarded.) OCAMLOPT=no else AC_MSG_RESULT(ok) OCAMLBEST=opt fi fi # checking for ocamlc.opt AC_CHECK_PROG(OCAMLCDOTOPT,ocamlc.opt,ocamlc.opt,no) if test "$OCAMLCDOTOPT" != no ; then AC_MSG_CHECKING(ocamlc.opt version) TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` if test "$TMPVERSION" != $OCAMLVERSION ; then AC_MSG_RESULT(differs from ocamlc; ocamlc.opt discarded.) else AC_MSG_RESULT(ok) OCAMLC=$OCAMLCDOTOPT fi fi # checking for ocamlopt.opt if test "$OCAMLOPT" != no ; then AC_CHECK_PROG(OCAMLOPTDOTOPT,ocamlopt.opt,ocamlopt.opt,no) if test "$OCAMLOPTDOTOPT" != no ; then AC_MSG_CHECKING(ocamlc.opt version) TMPVER=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` if test "$TMPVER" != $OCAMLVERSION ; then AC_MSG_RESULT(differs from ocamlc; ocamlopt.opt discarded.) else AC_MSG_RESULT(ok) OCAMLOPT=$OCAMLOPTDOTOPT fi fi fi # ocamldep, ocamllex and ocamlyacc should also be present in the path AC_CHECK_PROG(OCAMLDEP,ocamldep,ocamldep,no) if test "$OCAMLDEP" = no ; then AC_MSG_ERROR(Cannot find ocamldep.) fi AC_CHECK_PROG(OCAMLLEX,ocamllex,ocamllex,no) if test "$OCAMLLEX" = no ; then AC_MSG_ERROR(Cannot find ocamllex.) fi AC_CHECK_PROG(OCAMLYACC,ocamlyacc,ocamlyacc,no) if test "$OCAMLYACC" = no ; then AC_MSG_ERROR(Cannot find ocamlyacc.) fi # substitutions to perform AC_SUBST(OCAMLC) AC_SUBST(OCAMLOPT) AC_SUBST(OCAMLDEP) AC_SUBST(OCAMLLEX) AC_SUBST(OCAMLYACC) AC_SUBST(OCAMLBEST) AC_SUBST(OCAMLVERSION) AC_SUBST(OCAMLLIB) AC_SUBST(VERSION) # Finally create the Makefile from Makefile.in AC_OUTPUT(Makefile creal.spec) chmod a-w Makefile creal-0.7/Makefile.in0000644000246300002640000001320410330104265015623 0ustar filliatrdemons00000000000000 ########################################################################### # DO NOT EDIT (automatically generated by ./configure) ########################################################################### # where to install the binaries prefix=@prefix@ exec_prefix=@exec_prefix@ BINDIR=@bindir@ # where to install the man page MANDIR=@mandir@ OCAMLC = @OCAMLC@ OCAMLOPT = @OCAMLOPT@ OCAMLLEX = @OCAMLLEX@ OCAMLYACC= @OCAMLYACC@ INCLUDES = -I mlgmp BFLAGS = -g $(INCLUDES) OFLAGS = -unsafe $(INCLUDES) CMO = cr.cmo creal.cmo CMI = $(CMO:.cmo=.cmi) MLI = $(CMO:.cmo=.mli) CMX = $(CMO:.cmo=.cmx) CRCMO=cr.cmo CRCMX = $(CRCMO:.cmo=.cmx) CMA = creal.cma CMXA = creal.cmxa GMPCMA = mlgmp/gmp.cma GMPCMXA = mlgmp/gmp.cmxa all: @OCAMLBEST@ test.@OCAMLBEST@ test_cr.@OCAMLBEST@ ecalc.@OCAMLBEST@ byte: $(GMPCMA) $(CMA) $(CRCMO) cmpf.cmo opt: $(GMPCMA) $(CMA) $(GMPCMXA) $(CMXA) $(CRCMO) $(CRCMX) cmpf.cmx $(CMA): libcreal.a $(GMPCMA) $(CMO) ocamlmklib -linkall -o creal $(GMPCMA) $(CMO) -lgmp $(CMXA):libcreal.a $(GMPCMX) $(CMX) ocamlmklib -linkall -o creal $(GMPCMX) $(CMX) -lgmp libcreal.a: mlgmp/mlgmp_z.o mlgmp/mlgmp_q.o mlgmp/mlgmp_misc.o ocamlmklib -oc creal $^ -lgmp ranlib $@ GMPCMO=mlgmp/gmp.cmo $(GMPCMA): mlgmp/libmlgmp.a $(GMPCMO) $(OCAMLC) -custom -a -o $@ $^ -cclib "-Lmlgmp -lmlgmp -lgmp" GMPCMX=mlgmp/gmp.cmx $(GMPCMXA): mlgmp/libmlgmp.a $(GMPCMX) $(OCAMLOPT) -a -o $@ $^ -cclib "-Lmlgmp -lmlgmp -lgmp" mlgmp/libmlgmp.a: mlgmp/mlgmp_z.o mlgmp/mlgmp_q.o mlgmp/mlgmp_misc.o rm -f $@ ar rc $@ $^ ranlib $@ TESTCMO=test.cmo TESTCMX=$(TESTCMO:.cmo=.cmx) test.opt: $(CMXA) $(TESTCMX) $(OCAMLOPT) $(OFLAGS) -o $@ $^ -cclib "-L." test.byte: $(CMA) $(TESTCMO) $(OCAMLC) $(BFLAGS) -o $@ $^ -cclib "-L." TESTCRCMO=test_cr.cmo TESTCRCMX=$(TESTCRCMO:.cmo=.cmx) test_cr.opt: $(CMXA) $(TESTCRCMX) $(OCAMLOPT) $(OFLAGS) -o $@ $^ -cclib "-L." test_cr.byte: $(CMA) $(TESTCRCMO) $(OCAMLC) $(BFLAGS) -o $@ $^ -cclib "-L." md.opt: $(CMXA) md.ml $(OCAMLOPT) $(OFLAGS) -o $@ $^ -cclib "-L." md_cr.opt: $(CMXA) md_cr.ml $(OCAMLOPT) $(OFLAGS) -o $@ $^ -cclib "-L." TRACECMO=trace.cmo TRACECMX=$(TRACECMO:.cmo=.cmx) trace.opt: $(CMXA) $(TRACECMX) $(OCAMLOPT) $(OFLAGS) -o $@ graphics.cmxa $^ -cclib "-L." trace.byte: $(CMA) $(TRACECMO) $(OCAMLC) $(BFLAGS) -o $@ graphics.cma $^ -cclib "-L." CALCCMO=calc.cmo CALCCMX=$(CALCCMO:.cmo=.cmx) ecalc.opt: $(CMXA) $(CALCCMX) $(OCAMLOPT) $(OFLAGS) -o $@ $^ -cclib "-L." ecalc.byte: $(CMA) $(CALCCMO) $(OCAMLC) $(BFLAGS) -o $@ $^ -cclib "-L." GENERATED=calc.ml GMPPP=gmp_pp.cmo install_gmp_pp.cmo ocamlgmp: mlgmp/gmp.cma $(GMPPP) ocamlmktop -custom -o $@ $^ CREALPP=creal_pp.cmo install_creal_pp.cmo ocamlcreal: creal.cma $(GMPPP) $(CREALPP) ocamlmktop -o $@ $^ -cclib "-L." test: test.opt ./test.opt -check -p 50 bench: test.opt echo -n `date +"%a %d/%m/%Y %H:%M"` >> bench.log /usr/bin/time -f " user = %Us system = %Ss" -o bench.log -a ./test.opt -silent -p 100 # install ######### GMPBYTEFILES = mlgmp/gmp.cma mlgmp/gmp.cmi mlgmp/gmp.mli mlgmp/libmlgmp.a GMPOPTFILES = mlgmp/gmp.cmxa mlgmp/gmp.a BYTEFILES = $(CMA) $(CMI) $(MLI) OPTFILES = $(CMXA) creal.a libcreal.a LIBDIR = @OCAMLLIB@/creal install: install-prog install-lib install-toplevels install-lib: install-lib-@OCAMLBEST@ install-prog: install-prog-@OCAMLBEST@ install-lib-byte: mkdir -p $(LIBDIR) cp -f $(BYTEFILES) $(GMPBYTEFILES) $(LIBDIR) install-prog-byte: mkdir -p $(BINDIR) cp ecalc.byte $(BINDIR)/ecalc install-lib-opt: mkdir -p $(LIBDIR) cp -f $(BYTEFILES) $(GMPBYTEFILES) $(LIBDIR) cp -f $(OPTFILES) $(GMPOPTFILES) $(LIBDIR) install-prog-opt: mkdir -p $(BINDIR) cp ecalc.opt $(BINDIR)/ecalc install-toplevels: if test -f ocamlgmp; then \ cp -f ocamlgmp $(BINDIR); \ cp -f gmp_pp.cmi $(LIBDIR); \ fi if test -f ocamlcreal; then \ cp -f ocamlcreal $(BINDIR); \ cp -f creal_pp.cmi $(LIBDIR); \ fi local: cp ecalc.opt $$HOME/bin/$$OSTYPE/ecalc # l.p. ###### doc: creal.dvi WEBFILES = macros.tex creal.mli creal.ml creal.tex: $(WEBFILES) ocamlweb --no-index $(WEBFILES) -o $@ creal.dvi: creal.tex latex creal && latex creal creal.ps: creal.dvi dvips creal.dvi -o creal.ps.gz: creal.ps gzip -f --best creal.ps # export ######## VERSION=@VERSION@ NAME=creal-$(VERSION) SOURCES = *.mli *.ml mlgmp/*.mli mlgmp/*.ml \ mlgmp/*.c mlgmp/*.h \ calc.mll configure configure.in \ Makefile.in creal.spec.in .depend README COPYING LGPL CHANGES FTP=$(HOME)/WWW/ftp/ocaml/ds export:: creal.ps.gz $(SOURCES) mkdir -p export/$(NAME) cp --parents $(SOURCES) export/$(NAME) (cd export; tar cf $(NAME).tar $(NAME); \ gzip -f --best $(NAME).tar) cp -f creal.mli creal.ps.gz export/$(NAME).tar.gz $(FTP) caml2html -d $(FTP) cr.mli creal.mli ocamldoc -html -d $(FTP)/../creal -I mlgmp creal.mli cr.mli # generic rules : ################# .SUFFIXES: .mli .ml .cmi .cmo .cmx .mll .mly .mli.cmi: $(OCAMLC) -c $(BFLAGS) $< .ml.cmo: $(OCAMLC) -c $(BFLAGS) $< .c.o: $(OCAMLC) -ccopt "-o $@" -c $< .ml.o: $(OCAMLOPT) -c $(OFLAGS) $< .ml.cmx: $(OCAMLOPT) -c $(OFLAGS) $< .mll.ml: $(OCAMLLEX) $< .mly.ml: $(OCAMLYACC) -v $< .mly.mli: $(OCAMLYACC) -v $< # myself ######## Makefile: Makefile.in config.status ./config.status config.status: configure ./config.status --recheck configure: configure.in autoconf # clean and depend ################## clean: rm -f *~ *.a *.cm[aiox] *.cmxa *.o *.aux *.log rm -f mlgmp/*~ mlgmp/*.cm[aiox] mlgmp/*.o mlgmp/*.a mlgmp/*.cmxa rm -f $(GENERATED) rm -f creal.tex creal.dvi creal.ps creal.ps.gz rm -f test.byte test.opt ecalc.byte ecalc.opt rm -f ocamlgmp ocamlcreal depend: $(GENERATED) rm -f .depend @OCAMLDEP@ $(INCLUDES) mlgmp/*.mli mlgmp/*.ml *.mli *.ml > .depend include .depend creal-0.7/creal.spec.in0000644000246300002640000000367110330104265016134 0ustar filliatrdemons00000000000000%define base_name creal %define name ocaml-%{base_name} %define version @VERSION@ %define release 1mdk Name: %{name} Version: %{version} Release: %{release} Summary: Module Creal for Objective caml: Exact real arithmetic Source: http://www.lri.fr/~filliatr/ftp/ocaml/ds/%{base_name}-%{version}.tar.bz2 URL: http://www.lri.fr/~filliatr/software.en.html License: LGPL Group: Development/Other BuildRoot: %{_tmppath}/%{name}-%{version} BuildRequires: ocaml BuildRequires: gmp-devel %description Creal is an exact real arithmetic library for Objective Caml. This module implements exact real arithmetic, following Valérie Ménissier-Morain Ph.D. thesis (http://www-calfor.lip6.fr/~vmm/). A real x is represented as a function giving, for any n, an approximation zn/4^n of x such that |zn/4^n - x| < 1, where zn is an arbitrary precision integer (of type Gmp.Z.t). Coercions from type int, Gmp.Z.t, Gmp.Q.t, basic operations (addition, subtraction, multiplication, division, power, square root) and transcendental functions (sin, cos, tan, log, exp, arcsin, arccos, etc.) and a few constants (pi, e) are provided. A small reverse-polish calculator is provided to test the library. Written by Jean-Christophe Filliâtre. %package devel Summary: Exact real arithmetic for Objective Caml. Group: Development/Other %description devel Creal is an exact real arithmetic library for Objective Caml. %prep %setup -q -n %{base_name}-%{version} chmod 644 README CHANGES *.mli perl -pi -e 's/\015$//' README %build %configure %make %install rm -rf %{buildroot} destdir=`ocamlc -where` install -d %{buildroot}$destdir make LIBDIR=$RPM_BUILD_ROOT%{_libdir}/ocaml/%{base_name} install-lib %clean rm -rf %{buildroot} %files devel %defattr(-,root,root) %doc README CHANGES %{_libdir}/ocaml/%{base_name} %changelog * Fri Oct 21 2005 Guillaume Rousse 0.6-1mdk - contributed by Julien Narboux (Julien.Narboux@inria.fr) creal-0.7/.depend0000644000246300002640000000165210330104265015022 0ustar filliatrdemons00000000000000mlgmp/gmp.cmo: mlgmp/gmp.cmi mlgmp/gmp.cmx: mlgmp/gmp.cmi cmpf.cmi: mlgmp/gmp.cmi creal.cmi: mlgmp/gmp.cmi creal_pp.cmi: creal.cmi cr.cmi: mlgmp/gmp.cmi gmp_pp.cmi: mlgmp/gmp.cmi calc.cmo: mlgmp/gmp.cmi creal.cmi calc.cmx: mlgmp/gmp.cmx creal.cmx cmpf.cmo: mlgmp/gmp.cmi creal.cmi cmpf.cmi cmpf.cmx: mlgmp/gmp.cmx creal.cmx cmpf.cmi creal.cmo: mlgmp/gmp.cmi creal.cmi creal.cmx: mlgmp/gmp.cmx creal.cmi creal_pp.cmo: creal.cmi creal_pp.cmi creal_pp.cmx: creal.cmx creal_pp.cmi cr.cmo: mlgmp/gmp.cmi cr.cmi cr.cmx: mlgmp/gmp.cmx cr.cmi gmp_pp.cmo: mlgmp/gmp.cmi gmp_pp.cmi gmp_pp.cmx: mlgmp/gmp.cmx gmp_pp.cmi md.cmo: creal.cmi md.cmx: creal.cmx test_cmp.cmo: cmpf.cmi test_cmp.cmx: cmpf.cmx test_cr.cmo: mlgmp/gmp.cmi cr.cmi test_cr.cmx: mlgmp/gmp.cmx cr.cmx testcr.cmo: cr.cmi testcr.cmx: cr.cmx test.cmo: mlgmp/gmp.cmi creal.cmi test.cmx: mlgmp/gmp.cmx creal.cmx trace.cmo: creal.cmi trace.cmx: creal.cmx creal-0.7/README0000644000246300002640000000254110330104265014440 0ustar filliatrdemons00000000000000 Creal for Objective caml: Exact real arithmetic. Copyright (C) 2000 Jean-Christophe Filliâtre. This library implements exact real arithmetic. There are actually two different implementations: - Module Creal, following Valérie Ménissier-Morain Ph.D. thesis (http://www-calfor.lip6.fr/~vmm/). A real x is represented as a function giving, for any n, an approximation zn/4^n of x such that |zn/4^n - x| < 1, where zn is an arbitrary precision integer (of type Gmp.Z.t). - Module Cr, a translation of Hans Boehm's Java library CR (see http://www.hpl.hp.com/personal/Hans_Boehm/crcalc/) The two implementations have almost identical interfaces, so that it is easy to switch from one to the other. Coercions from type int, Gmp.Z.t, Gmp.Q.t, basic operations (addition, subtraction, multiplication, division, power, square root) and transcendental functions (sin, cos, tan, log, exp, arcsin, arccos, etc.) and a few constants (pi, e) are provided. A small reverse-polish calculator is provided to test the library (ecalc.opt). USAGE ===== Compilation of a program with a single module Foo (in foo.ml) using Creal (assumes Creal is installed; see INSTALL). Bytecode: ocamlc -c -I +creal foo.ml ocamlc -o foo -I +creal creal.cma foo.cmo Native-code: ocamlopt -c -I +creal foo.ml ocamlopt -o foo -I +creal creal.cmxa foo.cmx creal-0.7/COPYING0000644000246300002640000000134410330104265014613 0ustar filliatrdemons00000000000000Module Creal for Objective caml: Exact real arithmetic. Copyright (C) 2000 Jean-Christophe Filliâtre. Everything in directory mlgmp/ is Copyright (C) 1999- David Monniaux. Most algorithms are from Valérie Ménissier-Morain Ph.D. thesis (http://www-calfor.lip6.fr/~vmm/) This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License version 2, as published by the Free Software Foundation. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License version 2 for more details (enclosed in the file LGPL). creal-0.7/LGPL0000644000246300002640000006127310330104265014250 0ustar filliatrdemons00000000000000 GNU LIBRARY GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the library GPL. It is numbered 2 because it goes with version 2 of the ordinary GPL.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Library General Public License, applies to some specially designated Free Software Foundation software, and to any other libraries whose authors decide to use it. You can use it for your libraries, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library, or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link a program with the library, you must provide complete object files to the recipients so that they can relink them with the library, after making changes to the library and recompiling it. And you must show them these terms so they know their rights. Our method of protecting your rights has two steps: (1) copyright the library, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the library. Also, for each distributor's protection, we want to make certain that everyone understands that there is no warranty for this free library. If the library is modified by someone else and passed on, we want its recipients to know that what they have is not the original version, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that companies distributing free software will individually obtain patent licenses, thus in effect transforming the program into proprietary software. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License, which was designed for utility programs. This license, the GNU Library General Public License, applies to certain designated libraries. This license is quite different from the ordinary one; be sure to read it in full, and don't assume that anything in it is the same as in the ordinary license. The reason we have a separate public license for some libraries is that they blur the distinction we usually make between modifying or adding to a program and simply using it. Linking a program with a library, without changing the library, is in some sense simply using the library, and is analogous to running a utility program or application program. However, in a textual and legal sense, the linked executable is a combined work, a derivative of the original library, and the ordinary General Public License treats it as such. Because of this blurred distinction, using the ordinary General Public License for libraries did not effectively promote software sharing, because most developers did not use the libraries. We concluded that weaker conditions might promote sharing better. However, unrestricted linking of non-free programs would deprive the users of those programs of all benefit from the free status of the libraries themselves. This Library General Public License is intended to permit developers of non-free programs to use free libraries, while preserving your freedom as a user of such programs to change the free libraries that are incorporated in them. (We have not seen how to achieve this as regards changes in header files, but we have achieved it as regards changes in the actual functions of the Library.) The hope is that this will lead to faster development of free libraries. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, while the latter only works together with the library. Note that it is possible for a library to be covered by the ordinary General Public License rather than by this special one. GNU LIBRARY GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Library General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also compile or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. c) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. d) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Library General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! creal-0.7/CHANGES0000644000246300002640000000341310330104265014552 0ustar filliatrdemons00000000000000 o new implementation of constructive reals in module Cr (Java library by Hans Boehm ported to ocaml); this one is usually more efficient than Creal (uses less memory). The two interfaces are (almost) identical, so it is easy to switch from one to the other. o slight changes in Creal interface to be compatible with Cr interface: - of_string : ?radix:int -> string -> t - log: ~base:t -> t -> t Version 0.6, 10/05/2005 ======================= o RPM package contributed by Julien Narboux (ftp://ftp.mandriva.com/incoming/) o fixed installation issues (now uses ocamlmklib); no need to link with gmp.cmxa anymore (see README) o improved arctan near 1 (contribution by Roland Zumkeller) o improved min and max (contribution by Roland Zumkeller) Version 0.5, 29/11/2004 ======================= o added min and max o fixed bug in arccos/arcsin (discontinuity) Version 0.4, 25/2/2003 ====================== o integration of release 2002/11/23 of mlgmp (fixing a GC bug during integer division) o new module Cmpf: parallel use of floats and exact reals o fixed bug in multiplication algorithm (found while doing a formal proof!) Version 0.3, 11/4/2002 ====================== o toplevels pretty-printers now trap and print errors o improved Creal.to_string (now has a clear specification) o integration of release 2002/03/06 of mlgmp Version 0.2, 9/4/2002 ===================== o libraries (.cma/.cmxa) instead of single .cmo/.cmx files; installation in subdir creal/ of ocaml stdlib o sanity checks with "make test", benchmark with "make bench" o acceleration of arctan when |x|>=1 o bug fixed: non-termination of arcsin(1) or arccos(0) o customized toplevels ocamlgmp and ocamlcreal Version 0.1, 2/11/2001 ====================== o first public release creal-0.7/cr.mli0000644000246300002640000000462010330104265014667 0ustar filliatrdemons00000000000000 (*s Hans Boehm's Jaca CR library ported to ocaml. See file cr.ml for license *) open Gmp type t exception PrecisionOverflow (* [approx x p] returns [x / 2^p] rounded to an integer; the error in the result is strictly [< 1]. *) val approx : t -> int -> Z.t (* if [msd x = n] then [2^(n-1) < abs(x) < 2^(n+1)] *) val msd : t -> int (*s Basic operations *) val add : t -> t -> t val neg : t -> t val sub : t -> t -> t val abs : t -> t val mul : t -> t -> t val inv : t -> t val div : t -> t -> t val pow_int : t -> int -> t val root : int -> t -> t val sqrt : t -> t val ln : t -> t val log : base:t -> t -> t val exp : t -> t val pow : t -> t -> t val sin : t -> t val cos : t -> t val tan : t -> t val arcsin : t -> t val arccos : t -> t val arctan : t -> t val arctan_reciproqual : int -> t val sinh : t -> t val cosh : t -> t val tanh : t -> t val arcsinh : t -> t val arccosh : t -> t val arctanh : t -> t (*s [select s x y] is [x] if [s < 0], and [y] otherwise. (assumes [x = y] if [s = 0]) *) val select : t -> t -> t -> t val compare : t -> t -> int val min : t -> t -> t val max : t -> t -> t (*s Coercions *) val of_int : int -> t val of_z : Z.t -> t val of_int64 : Int64.t -> t val of_float : float -> t (* [to_q x n] and [to_float x n] return an approximation of [x] up to [1/2^n]. [to_q x n] is exactly [(approx x (-n)) / 2^n] and [to_float x n] returns the best floating point representation of this rational. *) val to_q : t -> int -> Q.t val to_float : t -> int -> float (* String representation. [2 <= radix <= 16] and [radix] defaults to 10. *) val to_string : ?radix:int -> t -> int -> string val of_string : ?radix:int -> string -> t (*s Some constants *) val zero : t val one : t val two : t val e : t val ln2 : t val pi : t val half_pi : t (*s Inverse of a monotone function. Computes the inverse of a function, which must be defined and strictly monotone on the interval [low, high]. The resulting function is defined only on the image of [low, high]. The original function may be either increasing or decreasing. *) val inverse_monotone : (t -> t) -> low:t -> high:t -> t -> t (*s Format pretty-printer (uses radix 10). *) val print : Format.formatter -> t -> unit val set_print_precision : int -> unit (*s Infix notations *) module Infixes : sig val ( +! ) : t -> t -> t val ( -! ) : t -> t -> t val ( *! ) : t -> t -> t val ( /! ) : t -> t -> t end creal-0.7/cr.ml0000644000246300002640000006401010330104265014515 0ustar filliatrdemons00000000000000(* This module is a translation in ocaml of Hans's Boehm Java library CR *) (*i // Copyright (c) 1999, Silicon Graphics, Inc. -- ALL RIGHTS RESERVED // // Permission is granted free of charge to copy, modify, use and distribute // this software provided you include the entirety of this notice in all // copies made. // // THIS SOFTWARE IS PROVIDED ON AN AS IS BASIS, WITHOUT WARRANTY OF ANY // KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, WITHOUT LIMITATION, // WARRANTIES THAT THE SUBJECT SOFTWARE IS FREE OF DEFECTS, MERCHANTABLE, FIT // FOR A PARTICULAR PURPOSE OR NON-INFRINGING. SGI ASSUMES NO RISK AS TO THE // QUALITY AND PERFORMANCE OF THE SOFTWARE. SHOULD THE SOFTWARE PROVE // DEFECTIVE IN ANY RESPECT, SGI ASSUMES NO COST OR LIABILITY FOR ANY // SERVICING, REPAIR OR CORRECTION. THIS DISCLAIMER OF WARRANTY CONSTITUTES // AN ESSENTIAL PART OF THIS LICENSE. NO USE OF ANY SUBJECT SOFTWARE IS // AUTHORIZED HEREUNDER EXCEPT UNDER THIS DISCLAIMER. // // UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, WHETHER TORT (INCLUDING, // WITHOUT LIMITATION, NEGLIGENCE OR STRICT LIABILITY), CONTRACT, OR // OTHERWISE, SHALL SGI BE LIABLE FOR ANY DIRECT, INDIRECT, SPECIAL, // INCIDENTAL, OR CONSEQUENTIAL DAMAGES OF ANY CHARACTER WITH RESPECT TO THE // SOFTWARE INCLUDING, WITHOUT LIMITATION, DAMAGES FOR LOSS OF GOODWILL, WORK // STOPPAGE, LOSS OF DATA, COMPUTER FAILURE OR MALFUNCTION, OR ANY AND ALL // OTHER COMMERCIAL DAMAGES OR LOSSES, EVEN IF SGI SHALL HAVE BEEN INFORMED OF // THE POSSIBILITY OF SUCH DAMAGES. THIS LIMITATION OF LIABILITY SHALL NOT // APPLY TO LIABILITY RESULTING FROM SGI's NEGLIGENCE TO THE EXTENT APPLICABLE // LAW PROHIBITS SUCH LIMITATION. SOME JURISDICTIONS DO NOT ALLOW THE // EXCLUSION OR LIMITATION OF INCIDENTAL OR CONSEQUENTIAL DAMAGES, SO THAT // EXCLUSION AND LIMITATION MAY NOT APPLY TO YOU. // // These license terms shall be governed by and construed in accordance with // the laws of the United States and the State of California as applied to // agreements entered into and to be performed entirely within California // between California residents. Any litigation relating to these license // terms shall be subject to the exclusive jurisdiction of the Federal Courts // of the Northern District of California (or, absent subject matter // jurisdiction in such courts, the courts of the State of California), with // venue lying exclusively in Santa Clara County, California. // Copyright (c) 2001-2004, Hewlett-Packard Development Company, L.P. // // Permission is granted free of charge to copy, modify, use and distribute // this software provided you include the entirety of this notice in all // copies made. // // THIS SOFTWARE IS PROVIDED ON AN AS IS BASIS, WITHOUT WARRANTY OF ANY // KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, WITHOUT LIMITATION, // WARRANTIES THAT THE SUBJECT SOFTWARE IS FREE OF DEFECTS, MERCHANTABLE, FIT // FOR A PARTICULAR PURPOSE OR NON-INFRINGING. HEWLETT-PACKARD ASSUMES // NO RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE. // SHOULD THE SOFTWARE PROVE DEFECTIVE IN ANY RESPECT, // HEWLETT-PACKARD ASSUMES NO COST OR LIABILITY FOR ANY // SERVICING, REPAIR OR CORRECTION. THIS DISCLAIMER OF WARRANTY CONSTITUTES // AN ESSENTIAL PART OF THIS LICENSE. NO USE OF ANY SUBJECT SOFTWARE IS // AUTHORIZED HEREUNDER EXCEPT UNDER THIS DISCLAIMER. // // UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, WHETHER TORT (INCLUDING, // WITHOUT LIMITATION, NEGLIGENCE OR STRICT LIABILITY), CONTRACT, OR // OTHERWISE, SHALL HEWLETT-PACKARD BE LIABLE FOR ANY DIRECT, INDIRECT, SPECIAL, // INCIDENTAL, OR CONSEQUENTIAL DAMAGES OF ANY CHARACTER WITH RESPECT TO THE // SOFTWARE INCLUDING, WITHOUT LIMITATION, DAMAGES FOR LOSS OF GOODWILL, WORK // STOPPAGE, LOSS OF DATA, COMPUTER FAILURE OR MALFUNCTION, OR ANY AND ALL // OTHER COMMERCIAL DAMAGES OR LOSSES, EVEN IF HEWLETT-PACKARD SHALL // HAVE BEEN INFORMED OF THE POSSIBILITY OF SUCH DAMAGES. // THIS LIMITATION OF LIABILITY SHALL NOT APPLY TO LIABILITY RESULTING // FROM HEWLETT-PACKARD's NEGLIGENCE TO THE EXTENT APPLICABLE // LAW PROHIBITS SUCH LIMITATION. SOME JURISDICTIONS DO NOT ALLOW THE // EXCLUSION OR LIMITATION OF INCIDENTAL OR CONSEQUENTIAL DAMAGES, SO THAT // EXCLUSION AND LIMITATION MAY NOT APPLY TO YOU. // i*) open Gmp type t = { mutable cache : (int * Z.t) option; approximate : int -> Z.t } let create f = { cache = None; approximate = f } let bound_log2 n = let np1 = float (abs n + 1) in truncate (ceil (log np1 /. log 2.0)) let z_zero = Z.from_int 0 let z_one = Z.from_int 1 let z_mone = Z.from_int (-1) let z_two = Z.from_int 2 let z_three = Z.from_int 3 let z_four = Z.from_int 4 let z_six = Z.from_int 6 let z_shift_left = Z.mul2exp let z_shift_right = Z.fdiv_q_2exp let shift k n = if n == 0 then k else if n < 0 then z_shift_right k (-n) else z_shift_left k n let scale k n = if n >= 0 then z_shift_left k n else let adj_k = Z.add_ui (shift k (n+1)) 1 in z_shift_right adj_k 1 exception PrecisionOverflow let check_prec n = let high = n lsr 28 in let high_shifted = n lsr 29 in (* TODO *) () let approx x p = check_prec p; match x.cache with | Some (min_p, ma) when p >= min_p -> scale ma (min_p - p) | _ -> let r = x.approximate p in x.cache <- Some (p, r); r (* ceil(log2(if z < 0 then -z else z+1)) *) let z_bit_length z = let rec loop k two_k = if Z.cmp z two_k <= 0 then k else loop (succ k) (Z.mul2exp two_k 1) in let z = if Z.sgn z < 0 then Z.neg z else Z.add_ui z 1 in if Z.cmp z z_one = 0 then 0 else loop 1 z_two let known_msd x = match x.cache with | Some (mp, ma) -> let length = if Z.sgn ma >= 0 then z_bit_length ma else z_bit_length (Z.neg ma) in mp + length - 1 | None -> assert false let msd_n x n = let close_to_0 = match x.cache with | None -> true | Some (_, ma) -> Z.cmp ma z_one <= 0 && Z.cmp ma z_mone >= 0 in if close_to_0 then begin ignore (approx x (n-1)); match x.cache with | Some (_, ma) when Z.cmp (Z.abs ma) z_one <= 0 -> min_int | Some _ -> known_msd x | None -> assert false end else known_msd x let iter_msd x n = let rec iter prec = if prec > n + 30 then let msd = msd_n x prec in if msd != min_int then msd else begin check_prec prec; iter ((prec * 3)/2 - 16) end else msd_n x n in iter 0 let msd x = iter_msd x min_int let shifted x n = create (fun p -> approx x (p - n)) let shift_left x n = shifted x n let shift_right x n = shifted x (-n) let of_z z = create (fun p -> scale z (-p)) let of_int n = of_z (Z.from_int n) let of_int64 n = let z = Z.from_string (Int64.to_string n) in of_z z let zero = of_int 0 let one = of_int 1 let two = of_int 2 let four = of_int 4 (* Operations *) let add x y = create (fun p -> scale (Z.add (approx x (p-2)) (approx y (p-2))) (-2)) let (+!) = add let neg x = create (fun p -> Z.neg (approx x p)) let sub x y = add x (neg y) let (-!) = sub exception Zero let mul x y = create (fun p -> let half_prec = (p asr 1) - 1 in try let x,y,msd_x = let msd_x = msd_n x half_prec in if msd_x == min_int then let msd_y = msd_n y half_prec in if msd_y == min_int then raise Zero else y,x,msd_y else x,y,msd_x in let prec2 = p - msd_x - 3 in let appry = approx y prec2 in if Z.sgn appry == 0 then raise Zero; let msd_y = known_msd y in let prec1 = p - msd_y - 3 in let apprx = approx x prec1 in let scale_digits = prec1 + prec2 - p in scale (Z.mul apprx appry) scale_digits with Zero -> z_zero) let ( *! ) = mul let inv x = create (fun p -> let msd = msd x in let inv_msd = 1 - msd in let digits_needed = inv_msd - p + 3 in let prec_needed = msd - digits_needed in let log_scale_factor = -p - prec_needed in if log_scale_factor < 0 then z_zero else let dividend = z_shift_left z_one log_scale_factor in let scaled_divisor = approx x prec_needed in let abs_scaled_divisor = Z.abs scaled_divisor in let adj_dividend = Z.add dividend (z_shift_right abs_scaled_divisor 1) in let result = Z.fdiv_q adj_dividend abs_scaled_divisor in if Z.sgn scaled_divisor < 0 then Z.neg result else result) let div x y = mul x (inv y) let (/!) = div let sgn_n x a = let quick_try = match x.cache with | Some (_, ma) -> Z.sgn ma | None -> 0 in if quick_try != 0 then quick_try else let needed_prec = a - 1 in let appr = approx x needed_prec in Z.sgn appr let sgn x = let rec loop a = check_prec a; let result = sgn_n x a in if result != 0 then result else loop (2 * a) in loop (-20) let select s x y = let selector_sign = ref (Z.sgn (approx s (-20))) in create (fun p -> if !selector_sign < 0 then approx x p else if !selector_sign > 0 then approx y p else let x_appr = approx x (p-1) in let y_appr = approx y (p-1) in let diff = Z.abs (Z.sub x_appr y_appr) in if Z.cmp diff z_one <= 0 then scale x_appr (-1) else if sgn s < 0 then begin selector_sign := -1; scale x_appr (-1) end else begin selector_sign := 1; scale y_appr (-1) end) let abs x = select x (neg x) x let max x y = select (sub x y) y x let min x y = select (sub x y) x y let compare_a x y a = let needed_prec = a - 1 in let x_appr = approx x needed_prec in let y_appr = approx y needed_prec in let comp1 = Z.cmp x_appr (Z.add_ui y_appr 1) in if comp1 > 0 then 1 else let comp2 = Z.cmp x_appr (Z.add_ui y_appr (-1)) in if comp2 < 0 then -1 else 0 let compare x y = let rec loop a = check_prec a; let r = compare_a x y a in if r <> 0 then r else loop (2 * a) in loop (-20) let rec pow_int x n = if n == 0 then one else if n < 0 then inv (pow_int x (-n)) else let y = pow_int (mul x x) (n / 2) in if n mod 2 == 0 then y else mul y x let prescaled_exp x = create (fun p -> if p >= 1 then z_zero else let iterations_needed = -p/2 + 2 in let calc_precision = p - bound_log2(2*iterations_needed) - 4 in let op_prec = p - 3 in let op_appr = approx x op_prec in let scaled_1 = z_shift_left z_one (-calc_precision) in let current_term = ref scaled_1 in let current_sum = ref scaled_1 in let n = ref 0 in let max_trunc_error = z_shift_left z_one (p - 4 - calc_precision) in while Z.cmp (Z.abs !current_term) max_trunc_error >= 0 do incr n; current_term := scale (Z.mul !current_term op_appr) op_prec; current_term := Z.fdiv_q_ui !current_term !n; current_sum := Z.add !current_sum !current_term done; scale !current_sum (calc_precision - p)) let rec exp x = let low_prec = -10 in let rough_appr = approx x low_prec in if Z.sgn rough_appr < 0 then inv (exp (neg x)) else if Z.cmp rough_appr z_two > 0 then let square_root = exp (shift_right x 1) in mul square_root square_root else prescaled_exp x let e = prescaled_exp one let sqrt x = let fp_prec = 50 in let fp_op_prec = 60 in let rec sqrt_rec p = let max_prec_needed = 2*p - 1 in let msd = msd_n x max_prec_needed in if msd <= max_prec_needed then z_zero else let result_msd = msd / 2 in let result_digits = result_msd - p in if result_digits > fp_prec then let appr_digits = result_digits/2 + 6 in let appr_prec = result_msd - appr_digits in let last_appr = sqrt_rec appr_prec in let prod_prec = 2 * appr_prec in let op_appr = approx x prod_prec in let prod_prec_scaled_numerator = Z.add (Z.mul last_appr last_appr) op_appr in let scaled_numerator = scale prod_prec_scaled_numerator (appr_prec - p) in assert (Z.cmp last_appr z_zero != 0); let shifted_result = Z.fdiv_q scaled_numerator last_appr in z_shift_right (Z.add shifted_result z_one) 1 else begin let op_prec = (msd - fp_op_prec) land (lnot 1) in let working_prec = op_prec - fp_op_prec in let scaled_bi_appr = z_shift_left (approx x op_prec) fp_op_prec in let scaled_appr = Z.float_from scaled_bi_appr in if scaled_appr < 0.0 then invalid_arg "Cr.sqrt"; let scaled_fp_sqrt = sqrt scaled_appr in let scaled_sqrt = Z.from_string (Int64.to_string (Int64.of_float scaled_fp_sqrt)) in let shift_count = working_prec/2 - p in shift scaled_sqrt shift_count end in create sqrt_rec let prescaled_ln x = create (fun p -> if p >= 0 then z_zero else let iterations_needed = -p in let calc_precision = p - bound_log2(2 * iterations_needed) - 4 in let op_prec = p - 3 in let op_appr = approx x op_prec in let scaled_1 = z_shift_left z_one (-calc_precision) in let x_nth = ref (scale op_appr (op_prec - calc_precision)) in let current_term = ref !x_nth in let current_sum = ref !current_term in let n = ref 1 in let current_sign = ref 1 in let max_trunc_error = z_shift_left z_one (p - 4 - calc_precision) in while Z.cmp (Z.abs !current_term) max_trunc_error >= 0 do incr n; current_sign := - !current_sign; x_nth := scale (Z.mul !x_nth op_appr) op_prec; current_term := Z.fdiv_q !x_nth (Z.of_int (!n * !current_sign)); current_sum := Z.add !current_sum !current_term done; scale !current_sum (calc_precision - p)) let simple_ln x = prescaled_ln (sub x one) (* ln(2) = 7ln(10/9) - 2ln(25/24) + 3ln(81/80) *) let ten_ninths = of_int 10 /! of_int 9 let ln2_1 = of_int 7 *! simple_ln ten_ninths let twentyfive_twentyfourths = of_int 25 /! of_int 24 let ln2_2 = of_int 2 *! simple_ln twentyfive_twentyfourths let eightyone_eightyeths = of_int 81 /! of_int 80 let ln2_3 = of_int 3 *! simple_ln eightyone_eightyeths let ln2 = ln2_1 -! ln2_2 +! ln2_3 let low_ln_limit = Z.of_int 8 let high_ln_limit = Z.of_int (16 + 8) let scaled_4 = Z.of_int (4 * 16) let rec ln x = let low_prec = -4 in let rough_appr = approx x low_prec in if Z.cmp rough_appr z_zero < 0 then invalid_arg "Cr.ln"; if Z.cmp rough_appr low_ln_limit <= 0 then neg (ln (inv x)) else if Z.cmp rough_appr high_ln_limit >= 0 then if Z.cmp rough_appr scaled_4 <= 0 then let quarter = ln (sqrt (sqrt x)) in shift_left quarter 2 else let extra_bits = z_bit_length rough_appr - 3 in let scaled_result = ln (shift_right x extra_bits) in add scaled_result (mul (of_int extra_bits) ln2) else simple_ln x let log ~base:x y = ln y /! ln x let pow x y = exp (y *! ln x) let root n x = pow x (inv (of_int n)) let arctan_reciproqual op = create (fun p -> if p >= 1 then z_zero else let iterations_needed = -p/2 + 2 in let calc_precision = p - bound_log2(2 * iterations_needed) - 2 in let scaled_1 = z_shift_left z_one (-calc_precision) in let big_op = Z.of_int op in let big_op_squared = Z.of_int (op*op) in let op_inverse = Z.fdiv_q scaled_1 big_op in let current_power = ref op_inverse in let current_term = ref op_inverse in let current_sum = ref op_inverse in let current_sign = ref 1 in let n = ref 1 in let max_trunc_error = z_shift_left z_one (p - 2 - calc_precision) in while Z.cmp (Z.abs !current_term) max_trunc_error >= 0 do n := !n + 2; current_power := Z.fdiv_q !current_power big_op_squared; current_sign := - !current_sign; current_term := Z.fdiv_q !current_power (Z.of_int (!current_sign * !n)); current_sum := Z.add !current_sum !current_term done; scale !current_sum (calc_precision - p)) let pi = (of_int 48 *! arctan_reciproqual 18) +! (of_int 32 *! arctan_reciproqual 57) -! (of_int 20 *! arctan_reciproqual 239) let half_pi = shift_right pi 1 let prescaled_cos x = create (fun p -> if p >= 1 then z_zero else begin let iterations_needed = -p/2 + 4 in let calc_precision = p - bound_log2(2 * iterations_needed) - 4 in let op_prec = p - 2 in let op_appr = approx x op_prec in let current_term = ref (z_shift_left z_one (-calc_precision)) in let n = ref 0 in let max_trunc_error = z_shift_left z_one (p - 4 - calc_precision) in let current_sum = ref !current_term in while Z.cmp (Z.abs !current_term) max_trunc_error >= 0 do n := !n + 2; current_term := scale (Z.mul !current_term op_appr) op_prec; current_term := scale (Z.mul !current_term op_appr) op_prec; let divisor = Z.mul (Z.of_int (- !n)) (Z.of_int (!n-1)) in current_term := Z.fdiv_q !current_term divisor; current_sum := Z.add !current_sum !current_term done; scale !current_sum (calc_precision - p) end) let rec cos x = let rough_appr = approx x (-1) in let abs_rough_appr = Z.abs rough_appr in if Z.cmp abs_rough_appr z_six >= 0 then let multiplier = Z.fdiv_q_ui rough_appr 6 in let adjustment = mul pi (of_z multiplier) in if Z.sgn (Z.band multiplier z_one) != 0 then neg (cos (x -! adjustment)) else cos (x -! adjustment) else if Z.cmp abs_rough_appr z_two >= 0 then let cos_half = cos (shift_right x 1) in (shift_left (cos_half *! cos_half) 1) -! one else prescaled_cos x let sin x = cos (half_pi -! x) let tan x = sin x /! cos x (*s Hyperbolic functions. *) let sinh x = let expx = exp x in (expx -! inv expx) /! two let cosh x = let expx = exp x in (expx +! inv expx) /! two let tanh x = let expx = exp x in let exp_minus_x = inv expx in (expx -! exp_minus_x) /! (expx +! exp_minus_x) let arcsinh x = ln (x +! sqrt (x *! x +! one)) let arccosh x = ln (x +! sqrt (x *! x -! one)) let arctanh x = ln ((one +! x) /! (one -! x)) /! two let of_float n = begin match classify_float n with | FP_nan | FP_infinite -> invalid_arg "Cr.of_float" | _ -> () end; let negative = n < 0.0 in let bits = Int64.bits_of_float (abs_float n) in let mantissa = Int64.logand bits 0xfffffffffffffL in let biased_exp = Int64.to_int (Int64.shift_right_logical bits 52) in let exp = biased_exp - 1075 in let mantissa = if biased_exp != 0 then Int64.add mantissa (Int64.shift_left Int64.one 52) else Int64.shift_left mantissa 1 in let result = shift_left (of_int64 mantissa) exp in if negative then neg result else result let to_string ?(radix=10) x n = if n < 0 then invalid_arg "Cr.to_string"; let scaled_x = if radix == 16 then shift_left x (4 * n) else let scale_factor = Z.ui_pow_ui radix n in mul x (of_z scale_factor) in let scaled_int = approx scaled_x 0 in let scaled_string = Z.to_string_base ~base:radix (Z.abs scaled_int) in let result = if n == 0 then scaled_string else let len = String.length scaled_string in let len, scaled_string = if len <= n then n + 1, String.make (n + 1 - len) '0' ^ scaled_string else len, scaled_string in let whole = String.sub scaled_string 0 (len - n) in let fraction = String.sub scaled_string (len - n) n in whole ^ "." ^ fraction in if Z.sgn scaled_int < 0 then "-" ^ result else result let of_string ?(radix=10) s = try begin try let n = String.length s in let p = String.index s '.' in let dec = n - p - 1 in let s' = (String.sub s 0 p) ^ (String.sub s (p + 1) dec) in div (of_z (Z.from_string_base radix s')) (of_z (Z.pow_ui_ui radix dec)) with Not_found -> of_z (Z.from_string_base radix s) end with Invalid_argument _ -> invalid_arg "Cr.of_string" let to_q x n = let xn = approx x (-n) in Q.div (Q.from_z xn) (Q.from_z (z_shift_left z_one n)) let to_float x n = Q.float_from (to_q x n) (* Inverse of a monotone function (see file UnaryCRFunction.java) *) let sloppy_compare x y = let difference = Z.sub x y in if Z.cmp difference z_one > 0 then 1 else if Z.cmp difference z_mone < 0 then -1 else 0 let trace = false let printf = Format.printf let inverse_monotone f ~low ~high = let f_low = f low in let f_high = f high in let f,negated,f_low,f_high = if compare f_low f_high > 0 then (fun x -> neg (f x)), true, neg f_low, neg f_high else f, false, f_low, f_high in let max_msd = msd (max (abs low) (abs high)) in let max_arg_prec = msd (high -! low) - 4 in let deriv_msd = msd ((f_high -! f_low) /! (high -! low)) in fun x -> let arg = if negated then neg x else x in let rec r = { cache = None; approximate = fun p -> let digits_needed = max_msd - p in if digits_needed < 0 then z_zero else let extra_arg_prec = 4 in let working_arg_prec = Pervasives.min (p - extra_arg_prec) max_arg_prec in let working_eval_prec = ref (working_arg_prec + deriv_msd - 20) in let low_appr = Z.add_ui (approx low working_arg_prec) 1 in let high_appr = Z.sub_ui (approx high working_arg_prec) 1 in let arg_appr = ref (approx arg !working_eval_prec) in let have_good_appr = match r.cache with | Some (min_prec, _) -> min_prec < max_msd | None -> false in let small_steps = ref 0 in let l,f_l,h,f_h,at_left,at_right = if digits_needed < 30 && not have_good_appr then begin if trace then printf "Setting interval to entire domain@."; small_steps := 2; low_appr, approx f_low !working_eval_prec, high_appr, approx f_high !working_eval_prec, true, true end else let rough_prec = p + digits_needed/2 in let rough_prec = match r.cache with | Some (min_prec, _) when digits_needed < 30 || min_prec min_prec | _ -> rough_prec in let rough_appr = approx r rough_prec in if trace then begin printf "Setting interval based on prev. appr@."; printf "prev. prec = %d appr = %a@." rough_prec Z.print rough_appr end; let h = z_shift_left (Z.add_ui rough_appr 1) (rough_prec - working_arg_prec) in let l = z_shift_left (Z.sub_ui rough_appr 1) (rough_prec - working_arg_prec) in let h,f_h,at_right = if Z.cmp h high_appr > 0 then high_appr, approx f_high !working_eval_prec, true else let h_cr = shift_left (of_z h) working_arg_prec in let f_h = approx (f h_cr) !working_eval_prec in h, f_h, false in let l,f_l,at_left = if Z.cmp l low_appr < 0 then low_appr, approx f_low !working_eval_prec, true else let l_cr = shift_left (of_z l) working_arg_prec in let f_l = approx (f l_cr) !working_eval_prec in l, f_l, false in l,f_l,h,f_h,at_left,at_right in let l,f_l,h,f_h,at_left,at_right = ref l, ref f_l, ref h, ref f_h, ref at_left, ref at_right in let difference = ref (Z.sub !h !l) in let rec loop i = if trace then begin printf "***Iteration: %d@." i; printf "Arg prec = %d eval prec = %d arg appr. = %a@." working_arg_prec !working_eval_prec Z.print !arg_appr; printf "l = %a h = %a@." Z.print !l Z.print !h; printf "f(l) = %a; f(h) = %a@." Z.print !f_l Z.print !f_h end; if Z.cmp !difference z_six < 0 then scale !h (-extra_arg_prec) else let f_difference = Z.sub !f_h !f_l in let guess = if !small_steps >= 2 || Z.sgn f_difference = 0 then z_shift_right (Z.add !l !h) 1 else let arg_difference = Z.sub !arg_appr !f_l in let t = Z.mul arg_difference !difference in let adj = Z.fdiv_q t f_difference in let adj = if Z.cmp adj (z_shift_right !difference 2) < 0 then z_shift_left adj 1 else if Z.cmp adj (z_shift_right (Z.mul_ui !difference 3) 2) > 0 then Z.sub !difference (z_shift_left (Z.sub !difference adj) 1) else adj in let adj = if Z.sgn adj <= 0 then z_two else adj in let adj = if Z.cmp adj !difference >= 0 then Z.sub_ui !difference 2 else adj in if Z.sgn adj <= 0 then Z.add_ui !l 2 else Z.add !l adj in let guess = ref guess in let tweak = ref z_two in let rec loop2 adj_prec = let guess_cr = shift_left (of_z !guess) working_arg_prec in if trace then begin printf "Evaluating at %s with precision %d@." (to_string guess_cr 10) !working_eval_prec; end; let f_guess_cr = f guess_cr in if trace then begin printf "fn value = %s@." (to_string f_guess_cr 10) end; let f_guess = approx f_guess_cr !working_eval_prec in let outcome = sloppy_compare f_guess !arg_appr in if outcome <> 0 then begin (* break *) if outcome > 0 then begin h := !guess; f_h := f_guess; at_right := false end else begin l := !guess; f_l := f_guess; at_left := false end; let new_difference = Z.sub !h !l in if Z.cmp new_difference (z_shift_right !difference 1) >= 0 then incr small_steps else small_steps := 0; difference := new_difference; loop (i+1) end else begin if adj_prec then begin let adjustment = if deriv_msd > 0 then -20 else deriv_msd - 20 in let l_cr = shift_left (of_z !l) working_arg_prec in let h_cr = shift_left (of_z !h) working_arg_prec in working_eval_prec := !working_eval_prec + adjustment; if trace then begin printf "New eval prec = %d %s%s@." !working_eval_prec (if !at_left then "(at left)" else "") (if !at_right then "(at right)" else "") end; if !at_left then f_l := approx f_low !working_eval_prec else f_l := approx (f l_cr) !working_eval_prec; if !at_right then f_h := approx f_high !working_eval_prec else f_h := approx (f h_cr) !working_eval_prec; arg_appr := approx arg !working_eval_prec; end else begin if trace then printf "tweaking guess@."; let new_guess = Z.add !guess !tweak in if Z.cmp new_guess !h >= 0 then guess := Z.sub !guess !tweak else guess := new_guess; tweak := Z.neg !tweak end; loop2 (not adj_prec) end in loop2 false in loop 0 } in r (* Application to the inverse trigonometric functions *) let arcsin = inverse_monotone sin ~low:(neg half_pi) ~high:half_pi let arccos x = half_pi -! arcsin x (* uses the identity [(sin x)^2 = (tan x)^2/(1 + (tan x)^2)] *) let arctan x = let x2 = x *! x in let abs_sin_atan = sqrt (x2 /! (one +! x2)) in let sin_atan = select x (neg abs_sin_atan) abs_sin_atan in arcsin sin_atan (*s Format pretty-printer. *) let print_precision = ref 10 let set_print_precision = (:=) print_precision let print fmt x = Format.fprintf fmt "%s" (to_string x !print_precision) (* Infix notations *) module Infixes = struct let (+!) = add let (-!) = sub let ( *! ) = mul let (/!) = div end creal-0.7/cmpf.mli0000644000246300002640000000216710330104265015214 0ustar filliatrdemons00000000000000 (** Comparison between floating-point numbers and exact arithmetic *) open Gmp type t val add : t -> t -> t val neg : t -> t val sub : t -> t -> t val abs : t -> t val mul : t -> t -> t val inv : t -> t val div : t -> t -> t val pow_int : t -> int -> t val sqrt : t -> t val ln : t -> t val exp : t -> t val pow : t -> t -> t val sin : t -> t val cos : t -> t val tan : t -> t val arcsin : t -> t val arccos : t -> t val arctan : t -> t val arctan_reciproqual : int -> t val sinh : t -> t val cosh : t -> t val tanh : t -> t val zero : t val one : t val two : t val pi : t val pi_over_2 : t val e : t val cmp : t -> t -> int (*s Coercions *) val of_int : int -> t val of_z : Z.t -> t val of_q : Q.t -> t val of_float : float -> t val of_string : string -> t val to_float : t -> int -> float val to_q : t -> int -> Q.t (*s Pretty-print *) val set_precision : int -> unit val to_string : t -> string val pp : Format.formatter -> t -> unit (*s Infix operators *) module Infixes : sig val ( + ) : t -> t -> t val ( - ) : t -> t -> t val ( * ) : t -> t -> t val ( / ) : t -> t -> t end creal-0.7/calc.ml0000644000246300002640000003704010330104265015016 0ustar filliatrdemons00000000000000# 19 "calc.mll" open Lexing open Printf open Cr (*s Options and parsing of the command-line. *) let precision = ref 10 let usage = "usage: ecalc [-p prec] ecalc is a reverse-polish exact calcultator Copyright (c) 2001- Jean-Christophe Filliâtre This is free software with ABSOLUTELY NO WARRANTY commands are k, prec pops the top of stack and uses it as precision ;, p, print displays top of stack n, popd pops top of stack and displays it f, show displays the whole stack pop pops top of stack c, clear clears the stack d, dup duplicates top of stack r, swap swaps the two elements on top of stack constants are pi, e binary operations are +, -, *, /, log ('x y log' is log_x(y)), pow (or ^) unary operations are ~ (negation), i (inverse), sqrt (or v), sin, cos, tan, ln, exp, arcsin, arccos, arctan, sinh, cosh, tanh, arcsinh, arccosh, arctanh options are" let speclist = ["-p", Arg.Int (fun n -> precision := n), " set decimal precision"] let _ = Arg.parse speclist (fun _ -> ()) usage (*s The stack. *) let stack = ref [] let push x = stack := x :: !stack let error msg = printf "%s\n" msg; flush stdout let pop () = match !stack with | [] -> invalid_arg "pop" | x :: l -> stack := l; x let display_stack () = List.iter (fun x -> printf " %s\n" (to_string x !precision)) (List.rev !stack); flush stdout (*s Unary and binary operations on the stack. *) let unop f = push (f (pop ())) let binop f = let x2 = pop () in let x1 = pop () in push (f x1 x2) # 77 "calc.ml" let __ocaml_lex_tables = { Lexing.lex_base = "\000\000\217\255\216\255\002\000\002\000\253\255\252\255\251\255\ \250\255\249\255\000\000\245\255\244\255\012\000\028\000\240\255\ \239\255\238\255\237\255\236\255\235\255\000\000\013\000\225\255\ \014\000\019\000\001\000\007\000\218\255\028\000\000\000\009\000\ \012\000\003\000\015\000\018\000\031\000\224\255\024\000\038\000\ \031\000\020\000\041\000\043\000\038\000\034\000\049\000\038\000\ \045\000\219\255\035\000\047\000\220\255\042\000\049\000\221\255\ \044\000\051\000\222\255\055\000\042\000\056\000\223\255\064\000\ \048\000\247\255\062\000\049\000\242\255\053\000\066\000\064\000\ \058\000\055\000\055\000\077\000\076\000\069\000\077\000\077\000\ \067\000\064\000\077\000\081\000\084\000\085\000\075\000\070\000\ \082\000\073\000\084\000\079\000\081\000\227\255\089\000\226\255\ \081\000\228\255\146\000\156\000\102\000\246\255\107\000\104\000\ \254\255"; Lexing.lex_backtrk = "\255\255\255\255\255\255\000\000\039\000\255\255\255\255\255\255\ \255\255\255\255\009\000\255\255\255\255\039\000\012\000\255\255\ \255\255\255\255\255\255\255\255\255\255\014\000\039\000\255\255\ \006\000\008\000\039\000\039\000\255\255\039\000\255\255\255\255\ \255\255\255\255\255\255\255\255\021\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \026\000\255\255\255\255\025\000\255\255\255\255\024\000\255\255\ \255\255\023\000\255\255\255\255\255\255\022\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\007\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \002\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\012\000\012\000\255\255\255\255\255\255\255\255\ \255\255"; Lexing.lex_default = "\002\000\000\000\000\000\255\255\255\255\000\000\000\000\000\000\ \000\000\000\000\255\255\000\000\000\000\255\255\255\255\000\000\ \000\000\000\000\000\000\000\000\000\000\255\255\255\255\000\000\ \255\255\255\255\255\255\255\255\000\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\000\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\000\000\255\255\255\255\000\000\255\255\255\255\000\000\ \255\255\255\255\000\000\255\255\255\255\255\255\000\000\255\255\ \255\255\000\000\255\255\255\255\000\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\000\000\255\255\000\000\ \255\255\000\000\255\255\255\255\255\255\000\000\255\255\255\255\ \000\000"; Lexing.lex_trans = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\003\000\003\000\003\000\003\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \003\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\017\000\015\000\000\000\016\000\013\000\018\000\ \014\000\014\000\014\000\014\000\014\000\014\000\014\000\014\000\ \014\000\014\000\000\000\009\000\099\000\099\000\099\000\099\000\ \099\000\099\000\099\000\099\000\099\000\099\000\000\000\000\000\ \000\000\000\000\098\000\006\000\014\000\014\000\014\000\014\000\ \014\000\014\000\014\000\014\000\014\000\014\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\023\000\000\000\ \000\000\027\000\056\000\025\000\010\000\021\000\007\000\102\000\ \004\000\020\000\039\000\005\000\022\000\038\000\008\000\041\000\ \024\000\036\000\011\000\029\000\026\000\100\000\028\000\068\000\ \096\000\042\000\012\000\093\000\094\000\069\000\019\000\059\000\ \066\000\035\000\060\000\067\000\030\000\033\000\028\000\037\000\ \011\000\040\000\007\000\007\000\043\000\034\000\045\000\053\000\ \031\000\050\000\047\000\032\000\048\000\049\000\051\000\052\000\ \054\000\055\000\057\000\058\000\063\000\061\000\044\000\046\000\ \062\000\064\000\065\000\085\000\071\000\070\000\008\000\086\000\ \072\000\083\000\073\000\075\000\023\000\074\000\076\000\077\000\ \078\000\079\000\080\000\081\000\082\000\012\000\084\000\006\000\ \088\000\087\000\009\000\089\000\090\000\091\000\092\000\005\000\ \095\000\097\000\098\000\098\000\098\000\098\000\098\000\098\000\ \098\000\098\000\098\000\098\000\099\000\099\000\099\000\099\000\ \099\000\099\000\099\000\099\000\099\000\099\000\101\000\103\000\ \104\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000"; Lexing.lex_check = "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\000\000\000\000\003\000\003\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\255\255\003\000\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\000\000\000\000\255\255\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\255\255\000\000\013\000\013\000\013\000\013\000\ \013\000\013\000\013\000\013\000\013\000\013\000\255\255\255\255\ \255\255\255\255\014\000\000\000\014\000\014\000\014\000\014\000\ \014\000\014\000\014\000\014\000\014\000\014\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\000\000\255\255\ \255\255\000\000\026\000\000\000\000\000\000\000\000\000\004\000\ \000\000\000\000\031\000\000\000\000\000\032\000\000\000\030\000\ \000\000\033\000\000\000\000\000\000\000\010\000\000\000\024\000\ \021\000\027\000\000\000\022\000\022\000\024\000\000\000\025\000\ \024\000\034\000\025\000\024\000\029\000\029\000\035\000\036\000\ \038\000\039\000\040\000\041\000\042\000\029\000\043\000\044\000\ \029\000\045\000\046\000\029\000\047\000\048\000\050\000\051\000\ \053\000\054\000\056\000\057\000\059\000\060\000\043\000\043\000\ \061\000\063\000\064\000\066\000\067\000\069\000\070\000\066\000\ \071\000\073\000\072\000\074\000\069\000\072\000\075\000\076\000\ \077\000\078\000\079\000\080\000\081\000\082\000\083\000\084\000\ \085\000\086\000\087\000\088\000\089\000\090\000\091\000\092\000\ \094\000\096\000\098\000\098\000\098\000\098\000\098\000\098\000\ \098\000\098\000\098\000\098\000\099\000\099\000\099\000\099\000\ \099\000\099\000\099\000\099\000\099\000\099\000\100\000\102\000\ \103\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255"; Lexing.lex_base_code = ""; Lexing.lex_backtrk_code = ""; Lexing.lex_default_code = ""; Lexing.lex_trans_code = ""; Lexing.lex_check_code = ""; Lexing.lex_code = ""; } let rec loop lexbuf = __ocaml_lex_loop_rec lexbuf 0 and __ocaml_lex_loop_rec lexbuf __ocaml_lex_state = match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with | 0 -> # 101 "calc.mll" ( loop lexbuf ) # 251 "calc.ml" | 1 -> # 104 "calc.mll" ( Arg.usage speclist usage; flush stderr ) # 256 "calc.ml" | 2 -> # 106 "calc.mll" ( precision := Gmp.Z.int_from (approx (pop ()) 0) ) # 261 "calc.ml" | 3 -> # 108 "calc.mll" ( push (of_int !precision) ) # 266 "calc.ml" | 4 -> # 111 "calc.mll" ( display_stack () ) # 271 "calc.ml" | 5 -> # 113 "calc.mll" ( let x = pop () in printf " %s\n" (to_string x !precision); flush stdout ) # 277 "calc.ml" | 6 -> # 116 "calc.mll" ( match !stack with | [] -> error "" | x :: _ -> printf " %s\n" (to_string x !precision); flush stdout ) # 286 "calc.ml" | 7 -> # 123 "calc.mll" ( ignore (pop ()) ) # 291 "calc.ml" | 8 -> # 125 "calc.mll" ( stack := [] ) # 296 "calc.ml" | 9 -> # 127 "calc.mll" ( let x = pop () in push x; push x ) # 301 "calc.ml" | 10 -> # 129 "calc.mll" ( let x = pop () in let y = pop () in push x; push y ) # 306 "calc.ml" | 11 -> # 131 "calc.mll" ( push (of_int (List.length !stack)) ) # 311 "calc.ml" | 12 -> # 134 "calc.mll" ( push (of_string (lexeme lexbuf)) ) # 316 "calc.ml" | 13 -> # 135 "calc.mll" ( push pi ) # 321 "calc.ml" | 14 -> # 136 "calc.mll" ( push e ) # 326 "calc.ml" | 15 -> # 138 "calc.mll" ( binop add ) # 331 "calc.ml" | 16 -> # 139 "calc.mll" ( binop sub ) # 336 "calc.ml" | 17 -> # 140 "calc.mll" ( binop mul ) # 341 "calc.ml" | 18 -> # 141 "calc.mll" ( binop div ) # 346 "calc.ml" | 19 -> # 142 "calc.mll" ( unop neg ) # 351 "calc.ml" | 20 -> # 143 "calc.mll" ( unop inv ) # 356 "calc.ml" | 21 -> # 145 "calc.mll" ( unop sin ) # 361 "calc.ml" | 22 -> # 146 "calc.mll" ( unop cos ) # 366 "calc.ml" | 23 -> # 147 "calc.mll" ( unop tan ) # 371 "calc.ml" | 24 -> # 148 "calc.mll" ( unop arcsin ) # 376 "calc.ml" | 25 -> # 149 "calc.mll" ( unop arccos ) # 381 "calc.ml" | 26 -> # 150 "calc.mll" ( unop arctan ) # 386 "calc.ml" | 27 -> # 152 "calc.mll" ( unop exp ) # 391 "calc.ml" | 28 -> # 153 "calc.mll" ( unop ln ) # 396 "calc.ml" | 29 -> # 154 "calc.mll" ( binop (fun base -> log ~base) ) # 401 "calc.ml" | 30 -> # 155 "calc.mll" ( binop pow ) # 406 "calc.ml" | 31 -> # 157 "calc.mll" ( unop sinh ) # 411 "calc.ml" | 32 -> # 158 "calc.mll" ( unop cosh ) # 416 "calc.ml" | 33 -> # 159 "calc.mll" ( unop tanh ) # 421 "calc.ml" | 34 -> # 160 "calc.mll" ( unop arcsinh ) # 426 "calc.ml" | 35 -> # 161 "calc.mll" ( unop arccosh ) # 431 "calc.ml" | 36 -> # 162 "calc.mll" ( unop arctanh ) # 436 "calc.ml" | 37 -> # 164 "calc.mll" ( unop sqrt ) # 441 "calc.ml" | 38 -> # 166 "calc.mll" ( raise End_of_file ) # 446 "calc.ml" | 39 -> # 167 "calc.mll" ( raise Parsing.Parse_error ) # 451 "calc.ml" | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_loop_rec lexbuf __ocaml_lex_state ;; # 169 "calc.mll" (*s The main program is an infinite loop exiting on [End_of_file]. *) let _ = Sys.catch_break true let main () = let lb = from_channel stdin in try while true do try loop lb with | Sys.Break -> error "" | Parsing.Parse_error -> error "" | Invalid_argument "pop" -> error "" done with End_of_file -> flush stdout; exit 0 let _ = Printexc.catch main () # 481 "calc.ml" creal-0.7/cmpf.ml0000644000246300002640000000412110330104265015033 0ustar filliatrdemons00000000000000 open Format open Gmp type t = Creal.t * float let binop cf ff (c1,f1) (c2,f2) = (cf c1 c2, ff f1 f2) let unop cf ff (c,f) = (cf c, ff f) let add = binop Creal.add (+.) let sub = binop Creal.sub (-.) let mul = binop Creal.mul ( *.) let div = binop Creal.div (/.) let neg = unop Creal.neg (fun x -> -. x) let inv = unop Creal.inv (fun x -> 1.0 /. x) let sqrt = unop Creal.sqrt sqrt let abs = unop Creal.abs abs_float let ln = unop Creal.ln log let exp = unop Creal.exp exp let pow = binop Creal.pow ( ** ) let pow_int (c,f) n = (Creal.pow_int c n, f ** (float n)) let sin = unop Creal.sin sin let cos = unop Creal.cos cos let tan = unop Creal.tan tan let arcsin = unop Creal.arcsin asin let arccos = unop Creal.arccos acos let arctan = unop Creal.arctan atan let arctan_reciproqual n = (Creal.arctan_reciproqual n, atan (1.0 /. float n)) let sinh = unop Creal.sinh sinh let cosh = unop Creal.cosh cosh let tanh = unop Creal.tanh tanh let zero = (Creal.zero, 0.0) let one = (Creal.one, 1.0) let two = (Creal.two, 2.0) let e = (Creal.e, 2.71828182845904523536) let pi = (Creal.pi, 3.14159265358979323846) let pi_over_2 = (Creal.half_pi, 1.57079632679489661923) let cmp (c1,f1) (c2,f2) = let cmpf = compare f1 f2 in let cmpc = Creal.rel_cmp 50 c1 c2 in if cmpc <> cmpf then begin eprintf "comparisons differ: exact=%d float=%d\n" cmpc cmpf; flush stderr end; cmpc let of_z z = (Creal.of_z z,Z.float_from z) let of_q q = (Creal.of_q q, Q.float_from q) let of_float f = (Creal.of_float f, f) let of_int n = (Creal.of_int n, float n) let of_string s = (Creal.of_string s, float_of_string s) let to_q (c,_) = Creal.to_q c let to_float (c,_) = Creal.to_float c (*s Pretty-print *) let precision = ref 50 let set_precision = (:=) precision let to_string (c,f) = let cf = Creal.of_float f in sprintf "exact = %s\nfp = %s\ndelta = %s" (Creal.to_string c !precision) (Creal.to_string cf !precision) (Creal.to_string (Creal.sub c cf) !precision) let pp fmt x = fprintf fmt "@[%s@]" (to_string x) module Infixes = struct let (+) = add let (-) = sub let ( * ) = mul let (/) = div end creal-0.7/md_cr.ml0000644000246300002640000000155210330104265015177 0ustar filliatrdemons00000000000000open Cr;; open Infixes;; print_endline ( to_string (match int_of_string (Sys.argv.(2)) with | 1-> sin(tan(cos one)) | 2 -> sqrt (e /! pi) | 3 -> sin (pow_int (e +! one) 3) | 4 -> pow e (pi *! sqrt (of_int 2011)) | 5 -> pow e (pow e (sqrt e)) | 6 -> arctanh (one -! arctanh (one -! arctanh (one -! arctanh (one/!pi)))) | 7 -> pow_int pi 1000 | 8 -> sin (pow_int (of_int 6) (6*6*6*6*6*6)) | 9 -> sin (of_int 10 *! arctanh(tanh(pi *! sqrt(of_int 2011) /! of_int 3))) | 10 -> let root_5_2 = root 5 (of_int 2) in root 3 (of_int 7 +! root_5_2 -! of_int 5 *! root 5 (of_int 8)) +! root 5 (of_int 4) -! root_5_2 | 11 -> tan (sqrt two) +! arctanh(sin one) | 12 -> arcsin(inv e) +! cosh e +! arctanh e | _ -> failwith "unknown problem number" ) (int_of_string Sys.argv.(1)) );; creal-0.7/md.ml0000644000246300002640000000150710330104265014513 0ustar filliatrdemons00000000000000open Creal;; open Infixes;; print_endline ( to_string (match int_of_string (Sys.argv.(2)) with | 1-> sin(tan(cos one)) | 2 -> sqrt (e /! pi) | 3 -> sin (pow_int (e +! one) 3) | 4 -> pow e (pi *! sqrt (of_int 2011)) | 5 -> pow e (pow e (sqrt e)) | 6 -> arctanh (one -! arctanh (one -! arctanh (one -! arctanh (one/!pi)))) | 7 -> pow_int pi 1000 | 8 -> sin (of_float (6.**(6.**6.))) | 9 -> sin (of_int 10 *! arctanh(tanh(pi *! sqrt(of_int 2011) /! of_int 3))) | 10 -> root 3 (of_int 7 +! root 5 (of_int 2) -! of_int 5 *! root 5 (of_int 8)) +! root 5 (of_int 4) -! root 5 (of_int 2) | 11 -> tan (sqrt two) +! arctanh(sin one) | 12 -> arcsin(inv e) +! cosh e +! arctanh e | _ -> failwith "unknown problem number" ) (int_of_string Sys.argv.(1)) );; creal-0.7/test_cmp.ml0000644000246300002640000000014710330104265015730 0ustar filliatrdemons00000000000000#load "cmpf.cmo";; #install_printer Cmpf.pp;; open Cmpf;; let s = Cmpf.of_string;; open Infixes;; pi;; creal-0.7/test_cr.ml0000644000246300002640000001155410330104265015561 0ustar filliatrdemons00000000000000 (*s Test program for [Creal]. *) open Printf open Gmp open Cr open Cr.Infixes (*s Options *) let prec = ref 50 let display = ref true let sanity_check = ref false let _ = Arg.parse ["-p", Arg.Int ((:=) prec), "n set the precision"; "-silent", Arg.Clear display, " no display"; "-check", Arg.Set sanity_check, " only sanity checks" ] (fun s -> raise (Arg.Bad ("unknown option " ^ s))) "test [-p prec] [silent]" (*s Sanity checks. Compare two numbers up to the precision. *) let _ = if !sanity_check then begin printf "*** Sanity checks ***\n\n"; flush stdout end let check msg x y = if !sanity_check then begin printf "%s... " msg; flush stdout; let delta = Z.sub (approx x !prec) (approx y !prec) in if Z.cmp_si (Z.abs delta) 1 <= 0 then printf "ok\n\n" else begin printf "FAILED!\n\n"; exit 1 end; flush stdout end let sqrt_2 = sqrt two let _ = check "sqrt(2)^2 = 2" (sqrt_2 *! sqrt_2) two let _ = check "1/sqrt(2) = sqrt(2)/2" (inv sqrt_2) (sqrt_2 /! two) let sqrt_3 = sqrt (of_int 3) let _ = check "1 = (sqrt(3) + sqrt(2)) * (sqrt(3) - sqrt(2))" one ((sqrt_3 +! sqrt_2) *! (sqrt_3 -! sqrt_2)) let _ = check "(sqrt(2) ^ sqrt(2)) ^ sqrt(2) = 2" (pow (pow sqrt_2 sqrt_2) sqrt_2) two let one_third = of_int 1 /! of_int 3 let root3 x = pow x one_third let _ = check "54^1/3 - 2^1/3 = 16^1/3" (root3 (of_int 54) -! root3 two) (root3 (of_int 16)) let _ = check "cos(0)=1" (cos zero) one let _ = check "cos(pi/2)=0" (cos half_pi) zero let _ = check "sin(0)=0" (sin zero) zero let _ = check "sin(pi/2)=1" (sin half_pi) one let pi_over_4 = pi /! (of_int 4) let square x = x *! x let _ = check "cos^2(pi/4) + sin^2(pi/4) = 1" (square (cos pi_over_4) +! square (sin pi_over_4)) one let _ = check "tan(pi/4) = 1" (tan pi_over_4) one let _ = check "pi/4 = 4arctan(1/5) - arctan(1/239)" pi_over_4 (of_int 4 *! arctan_reciproqual 5 -! arctan_reciproqual 239) let _ = check "ln(1) = 0" (ln one) zero let _ = check "ln(e) = 1" (ln e) one let _ = check "ln(pi*pi) = 2ln(pi)" (ln (square pi)) (two *! ln pi) let _ = check "exp(-pi) = exp(-pi/2) * exp(-pi/2)" (exp (neg pi)) (let y = exp (neg half_pi) in y *! y) let _ = if !sanity_check then exit 0 (*s Benchmark. *) (* Test function: display the real number, if not [silent] ; otherwise, just compute the approximation (for timings). *) let _ = printf "\n*** Benchmarks ***\n\n"; flush stdout let test msg beautiful x = if !display then begin printf "%s = " msg; flush stdout; printf "%s\n\n" (to_string ~radix:10 x !prec); flush stdout end else begin printf "%s\n" msg; flush stdout; ignore (approx x !prec) end (*s golden ratio *) let phi = (one +! sqrt (of_int 5)) /! (of_int 2) let _ = test "golden ratio" true phi (* e (predefined in [Creal]) *) let _ = test "e" true e (* pi (predefined in [Creal]) *) let _ = test "pi" true pi (*s The Exact Arithmetic Competition: Level 0 Tests http://www.cs.man.ac.uk/arch/dlester/arithmetic/level0t.html *) (* sqrt(pi) *) let _ = test "sqrt(pi)" false (sqrt pi) (* sin(exp(1)) *) let _ = test "sin(e)" false (sin e) (* cos(exp(1)) *) let _ = test "cos(e)" false (cos e) (* sin(sin(sin(1))) *) let x = sin (sin (sin one)) let _ = test "sin(sin(sin(1)))" false x (* cos(cos(cos(1))) *) let x = cos (cos (cos one)) let _ = test "cos(cos(cos(1)))" false x (* exp(exp(exp(1))) *) let x = exp (exp (exp one)) let _ = test "exp(exp(exp(1)))" false x (* log(pi) *) let _ = test "ln(pi)" false (ln pi) (* log(1+log(1+log(1+pi))) *) let ln_ln_ln_pi = ln (one +! ln (one +! ln (one +! pi))) let _ = test "ln(1+ln(1+ln(1+pi)))" false ln_ln_ln_pi (* log(1+log(1+log(1+exp(1)))) *) let ln_ln_ln_e = ln (one +! ln (one +! ln (one +! e))) let _ = test "ln(1+ln(1+ln(1+e)))" false ln_ln_ln_e (*i (* log(1+log(1+log(1+log(1+log(1+log(1+pi)))))) *) let x = ln (one +! ln (one +! ln (one +! ln_ln_ln_pi))) let _ = test "ln(1+ln(1+ln(1+ln(1+ln(1+ln(1+pi))))))" false x (* log(1+log(1+log(1+log(1+log(1+log(1+exp(1))))))) *) let x = ln (one +! ln (one +! ln (one +! ln_ln_ln_e))) let _ = test "ln(1+ln(1+ln(1+ln(1+ln(1+ln(1+e))))))" false x i*) (* sin(1e50) *) let ten_to_50 = pow_int (of_int 10) 50 let x = sin ten_to_50 let _ = test "sin(1e50)" false x (* cos(1e50) *) let x = cos ten_to_50 let _ = test "cos(1e50)" false x (* arctan(1) *) (*let _ = test "arctan(1)" false (arctan one)*) (*i (* BUG GMP 2 *) let q = Q.from_zs (Z.from_int 1) (Z.from_string "19807040628566084398385987584" 10) let _ = Q.add q (Q.from_ints 1 2) (* BUG GMP 3 *) let q = Q.from_zs (Z.from_string "112803124130337404998606757686274889113032882986303222429756948481" 10) (Z.from_string "5192296858534827628530496329220096" 10) let q' = Q.add q (Q.from_ints 1 2) let _ = Z.fdiv_q (Q.get_num q') (Q.get_den q') let time f x = let old = Sys.time () in let y = f x in Printf.printf "%f\n" (Sys.time () -. old); y ;; i*) creal-0.7/testcr.ml0000644000246300002640000000050410330104265015413 0ustar filliatrdemons00000000000000 open Cr open Cr.Infixes let x = of_int 1 let y = of_int 7 let r = sin (sin (sin one)) (* "exp(-pi) = exp(-pi/2) * exp(-pi/2)" (exp (neg pi)) (let y = exp (neg half_pi) in y *! y) *) let r = mul (of_int 4) (arctan one) let () = Format.printf "%F@." (to_float r 50) let () = print_endline (to_string ~radix:10 r 100)