/usr/lib/ocaml/creal/cr.mli is in libcreal-ocaml-dev 0.7-6build8.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | (*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
|