libapron-ocaml-dev 0.9.10-7 / usr / lib / ocaml / apron / scalar.idl

/* -*- mode: c -*- */

/* This file is part of the APRON Library, released under LGPL license.
   Please read the COPYING file packaged in the distribution  */

quote(C, "\n\
#define HAS_MPFR 1\n\
#include <limits.h>\n\
#include \"ap_coeff.h\"\n\
#include \"gmp_caml.h\"\n\
#include \"apron_caml.h\"\n\
")


/* For ap_scalar_t,

- the conversion from ML to C reuse the ML allocated memory
- the conversion from C to ML duplicate the C allocated memory.
  Hence, the C type should be explicitly deallocated
  (if allocated from the underlying C function)
*/

quote(C,"\n\
void camlidl_apron_scalar_ml2c(value v, struct ap_scalar_t* scalar)\n\
{\n\
  value v2 = Field(v,0);\n\
  scalar->discr = Tag_val(v);\n\
  switch (scalar->discr) {\n\
  case 0: /* DOUBLE */\n\
    scalar->val.dbl = Double_val(v2);\n\
    break;\n\
  case 1: /* MPQ */\n\
    scalar->val.mpq = (mpq_ptr)(Data_custom_val(v2));\n\
    break;\n\
  case 2: /* MPFR */\n\
    scalar->val.mpfr = (mpfr_ptr)(Data_custom_val(v2));\n\
    break;\n\
  default:\n\
    caml_failwith(\"unknown scalar discriminant in camlidl_apron_scalar_ml2c\");\n\
  }\n\
  return;\n\
}\n\
value camlidl_apron_scalar_c2ml(struct ap_scalar_t* scalar)\n\
{\n\
  value v,v2;\n\
  v2 = Val_unit;\n\
  Begin_root(v2);\n\
  switch(scalar->discr){\n\
  case AP_SCALAR_DOUBLE:\n\
    v2 = caml_copy_double(scalar->val.dbl);\n\
    break;\n\
  case AP_SCALAR_MPQ:\n\
    {\n\
      mpq_t mpq;\n\
      mpq_ptr mpq_ptr = mpq;\n\
      mpq_init(mpq);\n\
      mpq_set(mpq,scalar->val.mpq);\n\
      v2 = camlidl_mpq_ptr_c2ml(&mpq_ptr);\n\
    }\n\
    break;\n\
  case AP_SCALAR_MPFR:\n\
    {\n\
      mpfr_t mpfr;\n\
      mpfr_ptr mpfr_ptr = mpfr;\n\
      mpfr_init2(mpfr,mpfr_get_prec(scalar->val.mpfr));\n\
      mpfr_set(mpfr,scalar->val.mpfr,GMP_RNDU /* exact */);\n\
      v2 = camlidl_mpfr_ptr_c2ml(&mpfr_ptr);\n\
    }\n\
    break;\n\
  default:\n\
    caml_failwith(\"unknown scalar discriminant in camlidl_apron_scalar_c2ml\");\n\
  }\n\
  v = alloc_small(1,scalar->discr);\n\
  Field(v,0) = v2;\n\
  End_roots();\n\
  return v;\n\
}\n\
")

typedef [mltype("Float of float | Mpqf of Mpqf.t | Mpfrf of Mpfrf.t"),
	 abstract,
	 ml2c(camlidl_apron_scalar_ml2c),
	 c2ml(camlidl_apron_scalar_c2ml)]
struct ap_scalar_t ap_scalar_t;
typedef [ref]ap_scalar_t* ap_scalar_ptr;
struct ap_scalar_array_t {
  [size_is(size)]ap_scalar_ptr* p;
  int size;
};
quote(MLMLI,"(** APRON Scalar numbers. See {!Mpqf} for operations on GMP multiprecision rational numbers and {!Mpfr} for operations on MPFR multi-precision floating-point numbers. *)\n\n")

quote(MLI,"\n\
val of_mpq : Mpq.t -> t\n\
val of_mpqf : Mpqf.t -> t\n\
val of_int : int -> t\n\
val of_frac : int -> int -> t\n\
  (** Create a scalar of type [Mpqf] from resp.\n\
    - A multi-precision rational [Mpq.t] \n\
    - A multi-precision rational [Mpqf.t] \n\
    - an integer \n\
    - a fraction [x/y]\n\
  *)\n\
\n\
val of_mpfr : Mpfr.t -> t\n\
val of_mpfrf : Mpfrf.t -> t\n\
  (** Create a scalar of type [Mpfrf] with the given value *)\n\
val of_float : float -> t\n\
  (** Create a scalar of type [Float] with the given value *)\n\
val of_infty : int -> t \n\
  (** Create a scalar of type [Float] with the value multiplied by\n\
    infinity (resulting in minus infinity, zero, or infinity \n\
  *)\n\
val is_infty : t -> int\n\
  (** Infinity test.\n\
    [is_infty x] returns [-1] if x is [-oo], [1] if x is [+oo], and [0] if [x] is\n\
    finite. *)\n\
\n\
val sgn : t -> int\n\
  (** Return the sign of the coefficient, which may be a negative value, zero\n\
    or a positive value. *)\n\
\n\
val cmp : t -> t -> int\n\
  (** Compare two coefficients, possibly converting to [Mpqf.t].\n\
    [compare x y] returns a negative number if [x] is less than [y], \n\
    [0] if they ar equal, and a positive number if [x] is greater than [y].\n\
  *)\n\
\n\
val cmp_int : t -> int -> int\n\
  (** Compare a coefficient with an integer *)\n\
\n\
val equal : t -> t -> bool\n\
  (** Equality test, possibly using a conversion to [Mpqf.t].\n\
    Return [true] if the 2 values are equal. Two infinite values of the same\n\
    signs are considered as equal. *)\n\
\n\
val equal_int : t -> int -> bool\n\
  (** Equality test with an integer *)\n\
\n\
val neg : t -> t\n\
  (** Negation *)\n\
val to_string : t -> string\n\
  (** Conversion to string, using [string_of_double], [Mpqf.to_string] or [Mpfr.to_string]\n\
    *)\n\
\n\
val print : Format.formatter -> t -> unit\n\
  (** Print a coefficient *)\n\
")
quote(ML,"\
let of_mpq x = Mpqf (Mpqf.of_mpq x)\n\
let of_mpqf x = Mpqf x\n\
let of_mpfr x = Mpfrf (Mpfrf.of_mpfr x)\n\
let of_mpfrf x = Mpfrf x\n\
let of_int x = Mpqf(Mpqf.of_int x)\n\
let of_frac x y = Mpqf(Mpqf.of_frac x y)\n\
let of_float x = Float(x)\n\
let of_infty s = \n\
  if s>0 then Float(Pervasives.infinity)\n\
  else if s<0 then Float(Pervasives.neg_infinity)\n\
  else Float(0.0)\n\
let is_infty scalar =\n\
  match scalar with\n\
  | Mpqf x ->\n\
      let z = Mpqf.get_den x in\n\
      if Mpzf.sgn z <> 0 then 0\n\
      else begin\n\
	let z = Mpqf.get_num x in\n\
	let sgn = Mpzf.sgn z in\n\
	if sgn > 0 then 1 else if sgn < 0 then -1 else 0\n\
      end\n\
  | Mpfrf x ->\n\
      if Mpfrf.inf_p x then\n\
	if Mpfrf.sgn x > 0 then 1 else -1\n\
      else 0\n\
  | Float x ->\n\
      if x = Pervasives.infinity then 1\n\
      else if x = Pervasives.neg_infinity then -1\n\
      else 0\n\
let sgn scalar =\n\
  match scalar with\n\
  | Mpqf x -> Mpqf.sgn x\n\
  | Mpfrf x -> Mpfrf.sgn x\n\
  | Float x -> if x > 0.0+.0.0 then 1 else if x < -.0.0 then -1 else 0\n\
let to_mpqf = function\n\
  | Mpqf x -> x\n\
  | Mpfrf x -> Mpfrf.to_mpqf x\n\
  | Float x -> Mpqf.of_float x\n\
let cmp c1 c2 =\n\
  let s1 = is_infty c1 in\n\
  let s2 = is_infty c2 in\n\
  if s1>s2 then 1\n\
  else if s1<s2 then -1\n\
  else if s1 != 0 then 0\n\
  else begin\n\
    match (c1,c2) with\n\
    | (Mpqf x1, Mpqf x2) -> Mpqf.cmp x1 x2\n\
    | (Mpfrf x1, Mpfrf x2) -> Mpfrf.cmp x1 x2\n\
    | (Float x1, Float x2) -> if x1>x2 then 1 else if x1<x2 then -1 else 0\n\
    | x1, x2 -> Mpqf.cmp (to_mpqf x1) (to_mpqf x2)\n\
  end\n\
let equal c1 c2 =\n\
  let s1 = is_infty c1 in\n\
  let s2 = is_infty c2 in\n\
  if s1!=s2 then false\n\
  else if s1!=0 then true\n\
  else begin\n\
    match (c1,c2) with\n\
    | (Mpqf x1, Mpqf x2) -> Mpqf.equal x1 x2\n\
    | (Mpfrf x1, Mpfrf x2) -> Mpfrf.cmp x1 x2 = 0\n\
    | (Float x1, Float x2) -> x1 = x2\n\
    | x1, x2 -> Mpqf.equal (to_mpqf x1) (to_mpqf x2)\n\
  end\n\
let cmp_int scalar n =\n\
  match scalar with\n\
  | Mpqf x -> Mpqf.cmp_int x n\n\
  | Mpfrf x -> Mpfrf.cmp_int x n\n\
  | Float x -> Pervasives.compare x (float_of_int n)\n\
let equal_int scalar n =\n\
  match scalar with\n\
  | Mpqf x -> (Mpqf.cmp_int x n)=0\n\
  | Mpfrf x -> (Mpfrf.cmp_int x n)=0\n\
  | Float x -> x=(float_of_int n)\n\
let neg scalar =\n\
  match scalar with\n\
  | Mpqf x -> Mpqf(Mpqf.neg x)\n\
  | Mpfrf x ->\n\
     let y = Mpfr.init2 (Mpfr.get_prec x) in\n\
     ignore (Mpfr.neg y x Mpfr.Up);\n\
     Mpfrf(Mpfrf.mpfrf y)\n	     \
  | Float x -> Float(-. x)\n\
let to_string scalar =\n\
  match scalar with\n\
  | Mpqf x -> Mpqf.to_string x\n\
  | Mpfrf x -> Mpfrf.to_string x\n\
  | Float x -> string_of_float x\n\
let print fmt scalar =\n\
  Format.pp_print_string fmt (to_string scalar)\n\
")