mlgmp-20021123/0000755000175000017500000000000010035616151013370 5ustar furrmfurrm00000000000000mlgmp-20021123/Makefile0000640000175000017500000000445207567726700015053 0ustar furrmfurrm00000000000000# Use GNU Make ! RANLIB= ranlib OCAML_LIBDIR:= $(shell ocamlc -where) GMP_INCLUDES= -I/opt/gmp/include -I/users/absint2/local/include -I$(HOME)/packages/gmp/include GMP_LIBDIR=/opt/gmp/lib DESTDIR= $(OCAML_LIBDIR)/gmp RLIBFLAGS= -cclib "-Wl,-rpath $(GMP_LIBDIR)" # Linux, FreeBSD #RLIBFLAGS= -cclib "-Wl,-R $(GMP_LIBDIR)" # Solaris # RLIBFLAGS= # MacOS X LIBFLAGS= -cclib -L. -cclib -L$(GMP_LIBDIR) $(RLIBFLAGS) \ -cclib -lmpfr -cclib -lgmp -cclib -L$(DESTDIR) CC= gcc CFLAGS_MISC= -Wall -Wno-unused -g -O3 #CFLAGS_MISC= CFLAGS_INCLUDE= -I $(OCAML_LIBDIR) $(GMP_INCLUDES) CFLAGS= $(CFLAGS_MISC) $(CFLAGS_INCLUDE) OCAMLC= ocamlc -g OCAMLOPT= ocamlopt OCAMLFLAGS= CMODULES= mlgmp_z.c mlgmp_q.c mlgmp_f.c mlgmp_fr.c mlgmp_random.c mlgmp_misc.c CMODULES_O= $(CMODULES:%.c=%.o) LIBS= libmlgmp.a gmp.a gmp.cma gmp.cmxa gmp.cmi PROGRAMS= test_creal test_creal.opt essai essai.opt toplevel\ test_suite test_suite.opt TESTS= test_suite test_suite.opt all: $(LIBS) tests install: all -mkdir $(DESTDIR) cp $(LIBS) gmp.mli $(DESTDIR) tests: $(LIBS) $(TESTS) ./test_suite ./test_suite.opt %.i: %.c $(CC) $(CFLAGS) -E $*.c > $*.i %.cmo: %.ml %.cmi $(OCAMLC) $(OCAMLFLAGS) -c $*.ml %.cmx: %.ml %.cmi $(OCAMLOPT) $(OCAMLFLAGS) -c $*.ml %.cmo: %.ml $(OCAMLC) $(OCAMLFLAGS) -c $*.ml %.cmx: %.ml $(OCAMLOPT) $(OCAMLFLAGS) -c $*.ml %.cmi: %.mli $(OCAMLC) $(OCAMLFLAGS) -c $*.mli $(CMODULES_O): conversions.c config.h libmlgmp.a: $(CMODULES_O) $(AR) -rc $@ $+ $(RANLIB) $@ gmp.cma: gmp.cmo libmlgmp.a $(OCAMLC) $(OCAMLFLAGS) -a gmp.cmo -cclib -lmlgmp $(LIBFLAGS) -o $@ gmp.a gmp.cmxa: gmp.cmx libmlgmp.a $(OCAMLOPT) $(OCAMLFLAGS) -a gmp.cmx -cclib -lmlgmp $(LIBFLAGS) -o $@ pretty_gmp.cmo: pretty_gmp.cmi gmp.cmo toplevel: gmp.cma creal.cmo pretty_gmp.cmo install_pp.cmo creal_pp.cmo install_creal_pp.cmo ocamlmktop -custom $+ -o $@ essai: gmp.cma essai.cmo $(OCAMLC) -custom $+ -o $@ essai.opt: gmp.cmxa essai.cmx $(OCAMLOPT) $+ -o $@ test_creal: gmp.cma creal.cmo test_creal.cmo $(OCAMLC) -custom $+ -o $@ test_creal.opt: gmp.cmxa creal.cmx test_creal.cmx $(OCAMLOPT) $+ -o $@ test_suite: gmp.cma test_suite.cmo $(OCAMLC) -custom $+ -o $@ test_suite.opt: gmp.cmxa test_suite.cmx $(OCAMLOPT) $+ -o $@ clean: rm -f *.o *.cm* $(PROGRAMS) *.a depend: ocamldep *.ml *.mli > depend .PHONY: clean include depend mlgmp-20021123/mlgmp_fr.c0000644000175000017500000002314707521366140015354 0ustar furrmfurrm00000000000000#include #include #include #include #include #include #include #include #include "config.h" #include "mlgmp.h" #include "conversions.c" #define MODULE "Gmp.FR." #define unimplemented(message) \ raise_unimplemented("Gmp.FR." #message); /*** Allocation functions */ void _mlgmp_fr_finalize(value r) { #ifdef USE_MPFR mpfr_clear(*mpfr_val(r)); #endif } int _mlgmp_fr_custom_compare(value a, value b); void _mlgmp_fr_serialize(value v, unsigned long * wsize_32, unsigned long * wsize_64); unsigned long _mlgmp_fr_deserialize(void * dst); struct custom_operations _mlgmp_custom_fr = { field(identifier) "Gmp.F.t", field(finalize) &_mlgmp_fr_finalize, field(compare) &_mlgmp_fr_custom_compare, field(hash) custom_hash_default, #if defined(SERIALIZE) && defined(USE_MPFR) field(serialize) &_mlgmp_fr_serialize, field(deserialize) &_mlgmp_fr_deserialize #else field(serialize) custom_serialize_default, field(deserialize) custom_deserialize_default #endif }; value _mlgmp_fr_create(value prec, value dummy) { #ifdef USE_MPFR CAMLparam2(prec, dummy); CAMLreturn(alloc_init_mpfr(prec)); #else unimplemented(create); #endif } value _mlgmp_fr_from_z(value prec, value mode, value a) { #ifdef USE_MPFR CAMLparam2(prec, a); CAMLlocal1(r); r=alloc_init_mpfr(prec); mpfr_set_z(*mpfr_val(r), *mpz_val(a), Mode_val(mode)); CAMLreturn(r); #else unimplemented(from_z); #endif } value _mlgmp_fr_from_q(value prec, value mode, value a) { #ifdef USE_MPFR CAMLparam2(prec, a); CAMLlocal1(r); r=alloc_init_mpfr(prec); mpfr_set_q(*mpfr_val(r), *mpq_val(a), Mode_val(mode)); CAMLreturn(r); #else unimplemented(from_q); #endif } value _mlgmp_fr_from_si(value prec, value mode, value a) { #ifdef USE_MPFR CAMLparam2(prec, a); CAMLlocal1(r); r=alloc_init_mpfr(prec); mpfr_set_si(*mpfr_val(r), Int_val(a), Mode_val(mode)); CAMLreturn(r); #else unimplemented(from_si); #endif } value _mlgmp_fr_from_float(value prec, value mode, value v) { #ifdef USE_MPFR CAMLparam2(prec, v); CAMLlocal1(r); r=alloc_init_mpfr(prec); mpfr_set_d(*mpfr_val(r), Double_val(v), Mode_val(mode)); CAMLreturn(r); #else unimplemented(from_float); #endif } /*** Conversions */ value _mlgmp_fr_to_float(value mode, value v) { #ifdef USE_MPFR CAMLparam1(v); CAMLlocal1(r); r = copy_double(mpfr_get_d(*mpfr_val(v), Mode_val(mode))); CAMLreturn(r); #else unimplemented(to_float); #endif } value _mlgmp_fr_to_z_exp(value v) { #ifdef USE_MPFR CAMLparam1(v); CAMLlocal2(r, z); r = alloc_tuple(2); z = alloc_init_mpz(); Store_field(r, 0, z); Store_field(r, 1, Val_int(mpfr_get_z_exp(*mpz_val(z), *mpfr_val(v)))); CAMLreturn(r); #else unimplemented(to_z_exp); #endif } value _mlgmp_fr_to_string_exp_base_digits(value mode, value base, value digits, value val) { #ifdef USE_MPFR CAMLparam4(mode, base, digits, val); CAMLlocal2(r, rs); mp_exp_t exponent; char *s= mpfr_get_str(NULL, &exponent, Int_val(base), Int_val(digits), *mpfr_val(val), Mode_val(mode)); rs=alloc_string(strlen(s)); strcpy(String_val(rs), s); free(s); r=alloc_tuple(2); Store_field(r, 0, rs); Store_field(r, 1, Val_int(exponent)); CAMLreturn(r); #else unimplemented(to_string); #endif } value _mlgmp_fr_from_string(value prec, value mode, value base, value str) { #ifdef USE_MPFR CAMLparam4(prec, mode, base, str); CAMLlocal1(r); r=alloc_init_mpfr(prec); mpfr_set_str(*mpfr_val(r), String_val(str), Int_val(base), Mode_val(mode)); CAMLreturn(r); #else unimplemented(from_string); #endif } /*** Operations */ /**** Arithmetic */ #ifdef USE_MPFR #define fr_binary_op_mpfr(op) \ value _mlgmp_fr_##op(value prec, value mode, value a, value b) \ { \ CAMLparam3(prec, a, b); \ CAMLlocal1(r); \ r=alloc_init_mpfr(prec); \ mpfr_##op(*mpfr_val(r), *mpfr_val(a), *mpfr_val(b), Mode_val(mode)); \ CAMLreturn(r); \ } #define fr_binary_op_ui(op) \ value _mlgmp_fr_##op(value prec, value mode, value a, value b) \ { \ CAMLparam3(prec, a, b); \ CAMLlocal1(r); \ r=alloc_init_mpfr(prec); \ mpfr_##op(*mpfr_val(r), *mpfr_val(a), Int_val(b), Mode_val(mode)); \ CAMLreturn(r); \ } #define fr_binary_ui_op(op) \ value _mlgmp_fr_##op(value prec, value mode, value a, value b) \ { \ CAMLparam3(prec, a, b); \ CAMLlocal1(r); \ r=alloc_init_mpfr(prec); \ mpfr_##op(*mpfr_val(r), Int_val(a), *mpfr_val(b), Mode_val(mode)); \ CAMLreturn(r); \ } #define fr_unary_op(op) \ value _mlgmp_fr_##op(value prec, value mode, value a) \ { \ CAMLparam2(prec, a); \ CAMLlocal1(r); \ r=alloc_init_mpfr(prec); \ mpfr_##op(*mpfr_val(r), *mpfr_val(a), Mode_val(mode)); \ CAMLreturn(r); \ } #define fr_rounding_op(op) \ value _mlgmp_fr_##op(value prec, value a) \ { \ CAMLparam2(prec, a); \ CAMLlocal1(r); \ r=alloc_init_mpfr(prec); \ mpfr_##op(*mpfr_val(r), *mpfr_val(a)); \ CAMLreturn(r); \ } #else #define fr_binary_op_mpfr(op) \ value _mlgmp_fr_##op(value prec, value mode, value a, value b) \ { \ unimplemented(op) \ } #define fr_binary_op_ui(op) \ value _mlgmp_fr_##op(value prec, value mode, value a, value b) \ { \ unimplemented(op) \ } #define fr_binary_ui_op(op) \ value _mlgmp_fr_##op(value prec, value mode, value a, value b) \ { \ unimplemented(op) \ } #define fr_unary_op(op) \ value _mlgmp_fr_##op(value prec, value mode, value a) \ { \ unimplemented(op) \ } #define fr_rounding_op(op) \ value _mlgmp_fr_##op(value prec, value mode, value a) \ { \ unimplemented(op) \ } #endif #define fr_binary_op(op) \ fr_binary_op_ui(op##_ui) \ fr_binary_op_mpfr(op) fr_binary_op(add) fr_binary_op(sub) fr_binary_op(mul) fr_binary_op(div) fr_binary_ui_op(ui_sub) fr_binary_ui_op(ui_div) fr_unary_op(neg) fr_unary_op(abs) fr_rounding_op(ceil) fr_rounding_op(floor) fr_rounding_op(trunc) /*** Compare */ int _mlgmp_fr_custom_compare(value a, value b) { #ifdef USE_MPFR CAMLparam2(a, b); CAMLreturn(mpfr_cmp(*mpfr_val(a), *mpfr_val(b))); #else unimplemented(create); #endif } value _mlgmp_fr_cmp(value a, value b) { #ifdef USE_MPFR CAMLparam2(a, b); CAMLreturn(Val_int(mpfr_cmp(*mpfr_val(a), *mpfr_val(b)))); #else unimplemented(create); #endif } value _mlgmp_fr_cmp_si(value a, value b) { #ifdef USE_MPFR CAMLparam2(a, b); CAMLreturn(Val_int(mpfr_cmp_si(*mpfr_val(a), Int_val(b)))); #else unimplemented(create); #endif } value _mlgmp_fr_sgn(value a) { #ifdef USE_MPFR CAMLparam1(a); CAMLreturn(Val_int(mpfr_sgn(*mpfr_val(a)))); #else unimplemented(create); #endif } value _mlgmp_fr_is_nan(value a) { #ifdef USE_MPFR CAMLparam1(a); CAMLreturn(mpfr_nan_p(*mpfr_val(a)) ? Val_true : Val_false); #else unimplemented(create); #endif } value _mlgmp_fr_eq(value a, value b, value nbits) { #ifdef USE_MPFR CAMLparam3(a, b, nbits); CAMLreturn(mpfr_eq(*mpfr_val(a), *mpfr_val(b), Int_val(nbits)) ? Val_true : Val_false); #else unimplemented(create); #endif } fr_binary_op_mpfr(reldiff) /*** Random */ value _mlgmp_fr_urandomb(value prec, value state) { #ifdef USE_MPFR CAMLparam2(prec, state); CAMLlocal1(r); r = alloc_init_mpfr(prec); mpfr_urandomb(*mpfr_val(r), *randstate_val(state)); CAMLreturn(r); #else unimplemented(urandomb); #endif } value _mlgmp_fr_random(value prec) { #ifdef USE_MPFR CAMLparam1(prec); CAMLlocal1(r); r = alloc_init_mpfr(prec); mpfr_random(*mpfr_val(r)); CAMLreturn(r); #else unimplemented(urandomb); #endif } /* Old MPFR -no longer exists in 20011026 value _mlgmp_fr_srandom(value seed) { #ifdef USE_MPFR mpfr_srandom(Int_val(seed)); return Val_unit; #else unimplemented(urandomb); #endif } */ value _mlgmp_fr_random2(value prec, value nlimbs, value max_exp) { #ifdef USE_MPFR CAMLparam3(prec, nlimbs, max_exp); CAMLlocal1(r); r = alloc_init_mpfr(prec); mpfr_random2(*mpfr_val(r), Int_val(nlimbs), Int_val(max_exp)); CAMLreturn(r); #else unimplemented(urandomb); #endif } /*** Serialization */ value _mlgmp_fr_initialize(void) { #ifdef USE_MPFR CAMLparam0(); register_custom_operations(& _mlgmp_custom_f); CAMLreturn(Val_unit); #endif } #if defined(SERIALIZE) && defined(USE_MPFR) void _mlgmp_fr_serialize(value v, unsigned long * wsize_32, unsigned long * wsize_64) { CAMLparam1(v); char *s; int len; mp_exp_t exponent; char exponent_buf[10]; *wsize_32 = MPFR_SIZE_ARCH32; *wsize_64 = MPFR_SIZE_ARCH64; serialize_int_4(mpfr_get_prec(*mpfr_val(v))); s = mpfr_get_str (NULL, &exponent, 16, 0, *mpfr_val(v), GMP_RNDN); len = strlen(s); serialize_int_4(len + 11); serialize_block_1("0.", 2); serialize_block_1(s, len); free(s); sprintf(exponent_buf, "@%08lx", (exponent & 0xFFFFFFFFUL)); serialize_block_1(exponent_buf, 9); CAMLreturn0; } unsigned long _mlgmp_fr_deserialize(void * dst) { char *s; int len; mpfr_init2(*((mpfr_t*) dst), deserialize_uint_4()); len = deserialize_uint_4(); s = malloc(len+1); deserialize_block_1(s, len); s[len] = 0; mpfr_set_str (*((mpfr_t*) dst), s, 16, GMP_RNDN); free(s); return sizeof(mpfr_t); } #endif mlgmp-20021123/pretty_gmp.ml0000640000175000017500000000427707414025732016130 0ustar furrmfurrm00000000000000(* * 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. *) open Gmp;; open Format;; let base = ref 10;; let precision = ref 10;; let z formatter x = pp_print_string formatter (Z.to_string_base ~base: !base x);; let q formatter x = pp_open_hvbox formatter 8; z formatter (Q.get_num x); pp_close_box formatter (); pp_open_hbox formatter (); pp_print_string formatter " / "; pp_open_hvbox formatter 8; z formatter (Q.get_den x); pp_close_box formatter ();; let f formatter x = pp_print_string formatter (F.to_string_base_digits ~base: !base ~digits: !precision x);; let fr formatter x = pp_print_string formatter (FR.to_string_base_digits ~mode: GMP_RNDN ~base: !base ~digits: !precision x);; mlgmp-20021123/FAQ.txt0000644000175000017500000000103507417250570014550 0ustar furrmfurrm00000000000000Some usual problems: *** COMPILATION **** On my Ultra Sparc, ML GMP won't link with GNU MP. On the Ultra Sparc under Solaris, GNU MP tries to use Sun's proprietary compiler cc with option -xtarget=v9 to generate code optimised for the Ultra Sparc. This unfortunately generates 64-bit code, which cannot be linked with 32-bit code. As of version 3.04, Objective Caml cannot be compiled for 64-bit Ultra Sparc, at least because of some forbidden constructs in some assembler support files. The solution is to configure GNU MP with ABI=32. mlgmp-20021123/README0000640000175000017500000000476107521366137014270 0ustar furrmfurrm00000000000000This directory contains two separate programs: *** Creal v0.1 Copyright (C) 2000 Jean-Christophe Filliâtre. This module consists in the files containing the name "creal" and carrying J.C. Filliâtre's copyright. 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 This module was adapted for correct linking with the current version of ML GMP by D. Monniaux. *** ML GMP 2002/07/29 Copyright (c) 2001,2002 David Monniaux This package provides an interface between Objective Caml (http://www.inria.fr) and - the GNU MP (http://www.swox.com/gmp/) library - the MPFR (http://www.mpfr.org) library The current version is meant for - Objective Caml 3.04 - GNU MP 4.1 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, or any more recent version published by the Free Software Foundation, at your choice. 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.txt). 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 the author, 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. mlgmp-20021123/mlgmp_random.c0000644000175000017500000000175707406077431016234 0ustar furrmfurrm00000000000000#include #include #include #include #include #include #include #include #include "config.h" #define MODULE "Gmp.Random." /*** Allocation functions */ void _mlgmp_random_finalize(value r) { gmp_randclear(Data_custom_val(r)); } struct custom_operations _mlgmp_custom_random = { field(identifier) "Gmp.Random.randstate_t", field(finalize) &_mlgmp_random_finalize, field(compare) custom_compare_default, field(hash) custom_hash_default, field(serialize) custom_serialize_default, field(deserialize) custom_deserialize_default }; #undef field value _mlgmp_randinit_lc(value n) { CAMLparam1(n); CAMLlocal1(r); r = alloc_custom(&_mlgmp_custom_random, sizeof(gmp_randstate_t), 4, 1000000); gmp_randinit(*((gmp_randstate_t*) Data_custom_val(r)), GMP_RAND_ALG_LC, Int_val(n)); CAMLreturn(r); } mlgmp-20021123/mlgmp_f.c0000644000175000017500000001615307417242251015171 0ustar furrmfurrm00000000000000#include #include #include #include #include #include #include #include #include "config.h" #include "mlgmp.h" #include "conversions.c" #define MODULE "Gmp.F." /*** Allocation functions */ void _mlgmp_f_finalize(value r) { mpf_clear(*mpf_val(r)); } int _mlgmp_f_custom_compare(value a, value b); void _mlgmp_f_serialize(value v, unsigned long * wsize_32, unsigned long * wsize_64); unsigned long _mlgmp_f_deserialize(void * dst); struct custom_operations _mlgmp_custom_f = { field(identifier) "Gmp.F.t", field(finalize) &_mlgmp_f_finalize, field(compare) &_mlgmp_f_custom_compare, field(hash) custom_hash_default, #ifdef SERIALIZE field(serialize) &_mlgmp_f_serialize, field(deserialize) &_mlgmp_f_deserialize #else field(serialize) custom_serialize_default, field(deserialize) custom_deserialize_default #endif }; value _mlgmp_f_create(value prec) { CAMLparam1(prec); CAMLreturn(alloc_init_mpf(prec)); } value _mlgmp_f_from_z(value prec, value a) { CAMLparam2(prec, a); CAMLlocal1(r); r=alloc_init_mpf(prec); mpf_set_z(*mpf_val(r), *mpz_val(a)); CAMLreturn(r); } value _mlgmp_f_from_q(value prec, value a) { CAMLparam2(prec, a); CAMLlocal1(r); r=alloc_init_mpf(prec); mpf_set_q(*mpf_val(r), *mpq_val(a)); CAMLreturn(r); } value _mlgmp_f_from_si(value prec, value a) { CAMLparam2(prec, a); CAMLlocal1(r); r=alloc_init_mpf(prec); mpf_set_si(*mpf_val(r), Int_val(a)); CAMLreturn(r); } value _mlgmp_f_from_float(value prec, value v) { CAMLparam2(prec, v); CAMLlocal1(r); r=alloc_init_mpf(prec); mpf_set_d(*mpf_val(r), Double_val(v)); CAMLreturn(r); } /*** Conversions */ value _mlgmp_f_to_float(value v) { CAMLparam1(v); CAMLlocal1(r); r = copy_double(mpf_get_d(*mpf_val(v))); CAMLreturn(r); } value _mlgmp_f_to_string_exp_base_digits(value base, value digits, value val) { CAMLparam3(base, digits, val); CAMLlocal2(r, rs); mp_exp_t exponent; char *s= mpf_get_str(NULL, &exponent, Int_val(base), Int_val(digits), *mpf_val(val)); rs=alloc_string(strlen(s)); strcpy(String_val(rs), s); free(s); r=alloc_tuple(2); Store_field(r, 0, rs); Store_field(r, 1, Val_int(exponent)); CAMLreturn(r); } value _mlgmp_f_from_string(value prec, value base, value str) { CAMLparam3(prec, base, str); CAMLlocal1(r); r=alloc_init_mpf(prec); mpf_set_str(*mpf_val(r), String_val(str), Int_val(base)); CAMLreturn(r); } /*** Operations */ /**** Arithmetic */ #define f_binary_op_mpf(op) \ value _mlgmp_f_##op(value prec, value a, value b) \ { \ CAMLparam3(prec, a, b); \ CAMLlocal1(r); \ r=alloc_init_mpf(prec); \ mpf_##op(*mpf_val(r), *mpf_val(a), *mpf_val(b)); \ CAMLreturn(r); \ } #define f_binary_op_ui(op) \ value _mlgmp_f_##op(value prec, value a, value b) \ { \ CAMLparam3(prec, a, b); \ CAMLlocal1(r); \ r=alloc_init_mpf(prec); \ mpf_##op(*mpf_val(r), *mpf_val(a), Int_val(b)); \ CAMLreturn(r); \ } #define f_binary_ui_op(op) \ value _mlgmp_f_##op(value prec, value a, value b) \ { \ CAMLparam3(prec, a, b); \ CAMLlocal1(r); \ r=alloc_init_mpf(prec); \ mpf_##op(*mpf_val(r), Int_val(a), *mpf_val(b)); \ CAMLreturn(r); \ } #define f_binary_op(op) \ f_binary_op_ui(op##_ui) \ f_binary_op_mpf(op) #define f_unary_op(op) \ value _mlgmp_f_##op(value prec, value a) \ { \ CAMLparam2(prec, a); \ CAMLlocal1(r); \ r=alloc_init_mpf(prec); \ mpf_##op(*mpf_val(r), *mpf_val(a)); \ CAMLreturn(r); \ } f_binary_op(add) f_binary_op(sub) f_binary_op(mul) value _mlgmp_f_div(value prec, value n, value d) { CAMLparam3(prec, n, d); CAMLlocal1(r); if (! mpf_sgn(*mpf_val(d))) division_by_zero(); /* is it ok to launch the exception here? */ r = alloc_init_mpf(prec); mpf_div(*mpf_val(r), *mpf_val(n), *mpf_val(d)); CAMLreturn(r); } value _mlgmp_f_div_ui(value prec, value n, value d) { int real_d; CAMLparam3(prec, n, d); CAMLlocal1(r); real_d = Int_val(d); if (! real_d) division_by_zero(); /* is it ok to launch the exception here? */ r = alloc_init_mpf(prec); mpf_div_ui(*mpf_val(r), *mpf_val(n), real_d); CAMLreturn(r); } value _mlgmp_f_ui_div(value prec, value n, value d) { int real_d; CAMLparam3(prec, n, d); CAMLlocal1(r); if (! mpf_sgn(*mpf_val(d))) division_by_zero(); /* is it ok to launch the exception here? */ r = alloc_init_mpf(prec); mpf_ui_div(*mpf_val(r), Int_val(n), *mpf_val(d)); CAMLreturn(r); } f_binary_ui_op(ui_sub) f_unary_op(neg) f_unary_op(abs) f_unary_op(ceil) f_unary_op(floor) f_unary_op(trunc) /*** Compare */ int _mlgmp_f_custom_compare(value a, value b) { CAMLparam2(a, b); CAMLreturn(mpf_cmp(*mpf_val(a), *mpf_val(b))); } value _mlgmp_f_cmp(value a, value b) { CAMLparam2(a, b); CAMLreturn(Val_int(mpf_cmp(*mpf_val(a), *mpf_val(b)))); } value _mlgmp_f_cmp_si(value a, value b) { CAMLparam2(a, b); CAMLreturn(Val_int(mpf_cmp_si(*mpf_val(a), Int_val(b)))); } value _mlgmp_f_sgn(value a) { CAMLparam1(a); CAMLreturn(Val_int(mpf_sgn(*mpf_val(a)))); } value _mlgmp_f_eq(value a, value b, value nbits) { CAMLparam3(a, b, nbits); CAMLreturn(mpf_eq(*mpf_val(a), *mpf_val(b), Int_val(nbits)) ? Val_true : Val_false); } f_binary_op_mpf(reldiff) /*** Random */ value _mlgmp_f_urandomb(value prec, value state, value nbits) { CAMLparam3(prec, state, nbits); CAMLlocal1(r); r = alloc_init_mpf(prec); mpf_urandomb(*mpf_val(r), *randstate_val(state), Int_val(nbits)); CAMLreturn(r); } value _mlgmp_f_random2(value prec, value nlimbs, value max_exp) { CAMLparam3(prec, nlimbs, max_exp); CAMLlocal1(r); r = alloc_init_mpf(prec); mpf_random2(*mpf_val(r), Int_val(nlimbs), Int_val(max_exp)); CAMLreturn(r); } /*** Serialization */ value _mlgmp_f_initialize() { CAMLparam0(); register_custom_operations(& _mlgmp_custom_f); CAMLreturn(Val_unit); } #ifdef SERIALIZE void _mlgmp_f_serialize(value v, unsigned long * wsize_32, unsigned long * wsize_64) { CAMLparam1(v); char *s; int len; mp_exp_t exponent; char exponent_buf[10]; *wsize_32 = MPF_SIZE_ARCH32; *wsize_64 = MPF_SIZE_ARCH64; serialize_int_4(mpf_get_prec(*mpf_val(v))); s = mpf_get_str (NULL, &exponent, 16, 0, *mpf_val(v)); len = strlen(s); serialize_int_4(len + 11); serialize_block_1("0.", 2); serialize_block_1(s, len); free(s); sprintf(exponent_buf, "@%08lx", (exponent & 0xFFFFFFFFUL)); serialize_block_1(exponent_buf, 9); CAMLreturn0; } unsigned long _mlgmp_f_deserialize(void * dst) { char *s; int len; mpf_init2(*((mpf_t*) dst), deserialize_uint_4()); len = deserialize_uint_4(); s = malloc(len+1); deserialize_block_1(s, len); s[len] = 0; mpf_set_str (*((mpf_t*) dst), s, 16); free(s); return sizeof(mpf_t); } #endif mlgmp-20021123/mlgmp_q.c0000644000175000017500000001157407417246606015216 0ustar furrmfurrm00000000000000#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); } mlgmp-20021123/mlgmp_z.c0000644000175000017500000004574407567737450015245 0ustar furrmfurrm00000000000000#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); } mlgmp-20021123/essai.ml0000644000175000017500000001027707423563752015054 0ustar furrmfurrm00000000000000open Gmp;; for a = -10 to 10 do for b = -10 to 10 do (if (compare (Z.neg (Z.add (Z.from_int a) (Z.from_int b))) (Z.from_int (- (a + b)))) <> 0 then Printf.fprintf stderr "A: %d + %d\n" a b) done done;; for a = -10 to 10 do for b = 0 to 10 do (if (compare (Z.neg (Z.add_ui (Z.from_int a) b)) (Z.from_int (- (a + b)))) <> 0 then Printf.fprintf stderr "B: %d + %d\n" a b) done done;; for a = -100 to 100 do for b = -100 to 100 do if (b <> 0) then (let (q, r) = Z.cdiv_qr (Z.from_int a) (Z.from_int b) in (if (compare (Z.add (Z.mul q (Z.from_int b)) r) (Z.from_int a)) <> 0 then Printf.fprintf stderr "C: cdiv_qr %d %d\n" a b); (let q' = Z.cdiv_q (Z.from_int a) (Z.from_int b) in if (Z.compare q q') <> 0 then Printf.fprintf stderr "C: cdiv_q %d %d\n" a b); (let r' = Z.cdiv_r (Z.from_int a) (Z.from_int b) in if (Z.compare r r') <> 0 then Printf.fprintf stderr "C: cdiv_r %d %d\n" a b)) done done;; (if not (Z.equal (Z.mul_2exp (Z.from_int 5) 3) (Z.from_string "40")) then Printf.fprintf stderr "E: mul_2exp\n");; (if not (Z.equal_int (Z.fdiv_q_2exp (Z.from_string "-41") 3) ( -6)) then Printf.fprintf stderr "F: fdiv_q_2exp\n");; (if (Z.sqrtrem (Z.pow_ui (Z.from_string_base ~base: 8 "23") 2)) <> ((Z.from_int 19), (Z.from_int 0)) then Printf.fprintf stderr "G: pow_ui, sqrtrem\n");; (if (Z.root (Z.pow_ui (Z.from_float 17.) 3) 3) <> (Z.from_int 17) then Printf.fprintf stderr "H: pow_ui, root\n");; (if (Z.perfect_power_p (Z.from_int 179199)) || not (Z.perfect_square_p (Z.from_int 4225)) then Printf.fprintf stderr "I: perfect powers\n");; (let a = (Z.from_int 4935) and b = (Z.from_int 2563) in let (g, s, t) = (Z.gcdext a b) in if g <> (Z.add (Z.mul a s) (Z.mul b t)) then Printf.fprintf stderr "J: gcdext\n");; (let modulus = Z.from_string "4098969870980986751" and x = Z.from_string "1657867867854181" in let (Some y) = Z.inverse x modulus in if (Z.modulo (Z.mul x y) modulus) <> Z.one then Printf.fprintf stderr "K: inverse\n");; (let prime = Z.nextprime (Z.from_string "109897328754895897328732816617973") in if not (Z.is_prime prime) then Printf.fprintf stderr "L: primes\n");; (if (Z.remove (Z.from_int 16132319) (Z.from_int 7)) <> ((Z.from_int 6719), 4) then Printf.fprintf stderr "M: remove factor\n");; let fibo = let rec fib a b n = if n <= 1 then a else fib b (a + b) (pred n) in fib 1 1;; (let n=14 in if (Z.to_int (Z.fib_ui n)) <> (fibo n) then Printf.fprintf stderr "N: Fibonacci\n");; let fact = let rec fac x n = if n <= 1 then x else fac (x * n) (pred n) in fac 1;; (let n=8 in if (Z.to_int (Z.fac_ui n)) <> (fact n) then Printf.fprintf stderr "N: Factorial\n");; (let n=13 and k=4 in if (Z.to_float (Z.bin_ui ~n: (Z.from_int n) ~k: k)) <> 715.0 then Printf.fprintf stderr "N: Binomial\n");; (if (Z.sgn (Z.sub (Z.from_int 10) (Z.from_int 13))) >= 0 then Printf.fprintf stderr "O: Sign\n");; (if (Z.bior (Z.from_int 17) (Z.from_int 5)) <> (Z.from_int 21) then Printf.fprintf stderr "P: Binary ops\n");; (if (Z.scan0 (Z.from_int 87) 0) <> 3 || (Z.scan1 (Z.from_int 0x1562) 9) <> 10 then Printf.fprintf stderr "Q: Scan\n");; (let max = Z.from_int 5000000 and rand_state = RNG.randinit (RNG.GMP_RAND_ALG_LC 100) and n = 100000 and sum = ref Z.zero in for i=1 to n do sum := Z.add !sum (Z.urandomm rand_state max) done; let ecart = Z.abs (Z.sub (Z.fdiv_q_ui !sum n) (Z.fdiv_q_2exp max 1)) in if (Z.cmp ecart (Z.from_int 100000)) > 0 then Printf.fprintf stderr "R: Zrandom %a\n" Z.output ecart);; (let q1 = Q.from_si 1 2 and q2 = Q.from_si 1 3 and q3 = Q.div (Q.from_z (Z.from_int 1)) (Q.from_z (Z.from_int 6)) in if (not (Q.equal (Q.sub q1 q2) q3)) || (Q.mul q1 q2) <> q3 || (Q.to_string (Q.div q1 q2)) <> "3/2" then Printf.fprintf stderr "S: rationals\n");; let marshal_identity (x : 'a) = ((Marshal.from_string (Marshal.to_string x []) 0) : 'a);; let test_marshal equal x = not (equal (marshal_identity x) x);; (if (test_marshal Z.equal (Z.from_string "190709907897091")) || (test_marshal Q.equal (Q.from_ints 1688781 173)) || (test_marshal F.equal (F.from_string "580967.1347")) then Printf.fprintf stderr "T: marshalling\n");; mlgmp-20021123/mlgmp.h0000644000175000017500000000013007407325316014660 0ustar furrmfurrm00000000000000void division_by_zero(void) noreturn; void raise_unimplemented(const char *s) noreturn; mlgmp-20021123/mlgmp_misc.c0000644000175000017500000000204107417246603015673 0ustar furrmfurrm00000000000000#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); } mlgmp-20021123/config.h0000644000175000017500000000301307521366140015011 0ustar furrmfurrm00000000000000#define SERIALIZE #define 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 */ mlgmp-20021123/gmp.ml0000640000175000017500000005176307567677421014544 0ustar furrmfurrm00000000000000(* * 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 RNG = struct type randstate_t;; type randalg_t = GMP_RAND_ALG_LC of int;; external randinit_lc: int->randstate_t = "_mlgmp_randinit_lc";; let randinit = function GMP_RAND_ALG_LC(n) -> (if n>128 || n<1 then raise (Invalid_argument "Gmp.Random.randinit")); randinit_lc n let default = randinit (GMP_RAND_ALG_LC 128) end;; 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 *) external urandomb: state: RNG.randstate_t->nbits: int->t = "_mlgmp_z_urandomb";; external urandomm: state: RNG.randstate_t->n: t->t = "_mlgmp_z_urandomm";; external rrandomb: state: RNG.randstate_t->nbits: int->t = "_mlgmp_z_rrandomb";; 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;; module F = struct external f_initialize : unit->unit = "_mlgmp_f_initialize";; f_initialize ();; type t;; external create: unit->t = "_mlgmp_f_create";; let default_prec = ref 120 external from_z_prec : prec: int->Z.t->t = "_mlgmp_f_from_z";; external from_q_prec : prec: int->Z.t->t = "_mlgmp_f_from_q";; external from_si_prec : prec: int->int->t = "_mlgmp_f_from_si";; external from_float_prec : prec: int->float->t = "_mlgmp_f_from_float";; external from_string_prec_base : prec: int->base: int->string->t = "_mlgmp_f_from_string";; external float_from : t->float = "_mlgmp_f_to_float";; external to_float : t->float = "_mlgmp_f_to_float";; external to_string_exp_base_digits : base: int-> digits: int->t->string*int = "_mlgmp_f_to_string_exp_base_digits" external add_prec : prec: int->t->t->t = "_mlgmp_f_add";; external sub_prec : prec: int->t->t->t = "_mlgmp_f_sub";; external mul_prec : prec: int->t->t->t = "_mlgmp_f_mul";; external div_prec : prec: int->t->t->t = "_mlgmp_f_div";; external add_prec_ui : prec: int->t->int->t = "_mlgmp_f_add_ui";; external sub_prec_ui : prec: int->t->int->t = "_mlgmp_f_sub_ui";; external mul_prec_ui : prec: int->t->int->t = "_mlgmp_f_mul_ui";; external div_prec_ui : prec: int->t->int->t = "_mlgmp_f_div_ui";; external neg_prec : prec: int->t->t = "_mlgmp_f_neg";; external abs_prec : prec: int->t->t = "_mlgmp_f_abs";; external inv_prec : prec: int->t->t = "_mlgmp_f_div";; external reldiff_prec : prec: int->t->t = "_mlgmp_f_reldiff";; external floor_prec : prec: int->t->t = "_mlgmp_f_floor";; external ceil_prec : prec: int->t->t = "_mlgmp_f_ceil";; external trunc_prec : prec: int->t->t = "_mlgmp_f_trunc";; let default f x = f ~prec: !default_prec x let from_z = default from_z_prec let from_q = default from_q_prec let from_si = default from_si_prec let from_int = from_si let from_float = default from_float_prec let from_string_base = from_string_prec_base ~prec: !default_prec let from_string = from_string_base ~base: 10 let zero = from_int 0 let add = default add_prec let sub = default sub_prec let mul = default mul_prec let div = default div_prec let reldiff = default reldiff_prec let add_ui = default add_prec_ui let sub_ui = default sub_prec_ui let mul_ui = default mul_prec_ui let div_ui = default div_prec_ui let neg = default neg_prec let abs = default abs_prec let inv = default inv_prec let floor = default floor_prec let ceil = default ceil_prec let trunc = default trunc_prec external cmp : t->t->int = "_mlgmp_f_cmp";; external compare : t->t->int = "_mlgmp_f_cmp";; external sgn : t->int = "_mlgmp_f_sgn";; external eq : t->t-> prec: int->bool = "_mlgmp_f_eq";; external urandomb_prec : prec: int -> state: RNG.randstate_t -> nbits: int -> t = "_mlgmp_f_urandomb" external random2 : prec: int -> nlimbs: int -> max_exp: int -> t = "_mlgmp_f_random2" let urandomb ~state: state ~nbits: bits = urandomb_prec ~prec: bits ~state: state ~nbits: bits let equal x y = eq x y ~prec: 90;; let to_string_base_digits ~base: base ~digits: digits x = let mantissa, exponent = to_string_exp_base_digits ~base: base ~digits: digits (abs x) in let sign = sgn x in if sign = 0 then "0" else ((if sign < 0 then "-" else "") ^ (let lm=String.length mantissa in if lm > 1 then let tmp = String.create (succ lm) in String.blit mantissa 0 tmp 0 1; String.blit mantissa 1 tmp 2 (pred lm); String.set tmp 1 '.'; tmp else mantissa) ^ (if base <= 10 then "E" else "@") ^ (string_of_int (pred exponent)));; let to_string = to_string_base_digits ~base: 10 ~digits: 10;; (* It seems that marshalling for F.t is not accurate. *) end;; module FR = struct external fr_initialize : unit->unit = "_mlgmp_fr_initialize";; fr_initialize ();; type t;; let default_prec = ref 120 external create_prec: prec: int->unit->t = "_mlgmp_fr_create";; let create = create_prec ~prec: !default_prec external from_z_prec : prec: int -> mode: rounding_mode -> Z.t->t = "_mlgmp_fr_from_z";; external from_q_prec : prec: int -> mode: rounding_mode -> Z.t->t = "_mlgmp_fr_from_z";; external from_si_prec : prec: int -> mode: rounding_mode -> int->t = "_mlgmp_fr_from_si";; external from_float_prec : prec: int -> mode: rounding_mode -> float->t = "_mlgmp_fr_from_float";; external from_string_prec_base : prec: int-> mode: rounding_mode -> base: int->string->t = "_mlgmp_fr_from_string";; external to_string_exp_base_digits : mode: rounding_mode -> base: int-> digits: int->t->string*int = "_mlgmp_fr_to_string_exp_base_digits" external add_prec : prec: int -> mode: rounding_mode -> t->t->t = "_mlgmp_fr_add";; external sub_prec : prec: int -> mode: rounding_mode -> t->t->t = "_mlgmp_fr_sub";; external mul_prec : prec: int -> mode: rounding_mode -> t->t->t = "_mlgmp_fr_mul";; external div_prec : prec: int -> mode: rounding_mode -> t->t->t = "_mlgmp_fr_div";; external add_prec_ui : prec: int -> mode: rounding_mode -> t->int->t = "_mlgmp_fr_add_ui";; external sub_prec_ui : prec: int -> mode: rounding_mode -> t->int->t = "_mlgmp_fr_sub_ui";; external mul_prec_ui : prec: int -> mode: rounding_mode -> t->int->t = "_mlgmp_fr_mul_ui";; external div_prec_ui : prec: int -> mode: rounding_mode -> t->int->t = "_mlgmp_fr_div_ui";; external neg_prec : prec: int -> mode: rounding_mode -> t->t = "_mlgmp_fr_neg";; external abs_prec : prec: int -> mode: rounding_mode -> t->t = "_mlgmp_fr_abs";; external inv_prec : prec: int -> mode: rounding_mode -> t->t = "_mlgmp_fr_div";; external reldiff_prec : prec: int -> mode: rounding_mode -> t->t = "_mlgmp_fr_reldiff";; external float_from : t->float = "_mlgmp_fr_to_float";; external to_float_mode : mode: rounding_mode -> t -> float = "_mlgmp_fr_to_float";; external to_z_exp : t->Z.t*int = "_mlgmp_fr_to_z_exp";; external ceil_prec : prec: int -> t -> t = "_mlgmp_fr_ceil";; external floor_prec : prec: int -> t -> t = "_mlgmp_fr_floor";; external trunc_prec : prec: int -> t -> t = "_mlgmp_fr_trunc";; external cmp : t->t->int = "_mlgmp_fr_cmp";; external compare : t->t->int = "_mlgmp_fr_cmp";; external sgn : t->int = "_mlgmp_fr_sgn";; external eq : t->t-> prec: int->bool = "_mlgmp_fr_eq";; external is_nan : t->bool = "_mlgmp_fr_is_nan";; external urandomb : prec: int -> state: RNG.randstate_t -> t= "_mlgmp_fr_urandomb";; external random : prec: int -> t = "_mlgmp_fr_random" (* Old MPFR - no longer exists in 20011026 external srandom : int -> unit = "_mlgmp_fr_srandom" *) external random2 : prec: int -> nlimbs: int -> max_exp: int -> t = "_mlgmp_fr_random2" let default f x = f ~prec: !default_prec ~mode: GMP_RNDN x let default_rnd f x = f ~prec: !default_prec x let from_z = default from_z_prec let from_q = default from_q_prec let from_si = default from_si_prec let from_int = from_si let from_float = default from_float_prec let from_string_base = from_string_prec_base ~prec: !default_prec ~mode: GMP_RNDN let from_string = from_string_base ~base: 10 let to_float = to_float_mode ~mode: GMP_RNDN let zero = try from_int 0 with Unimplemented _ -> Obj.magic 0;; let add = default add_prec let sub = default sub_prec let mul = default mul_prec let div = default div_prec let reldiff = default reldiff_prec let add_ui = default add_prec_ui let sub_ui = default sub_prec_ui let mul_ui = default mul_prec_ui let div_ui = default div_prec_ui let neg = default neg_prec let abs = default abs_prec let inv = default inv_prec let floor = default_rnd floor_prec let ceil = default_rnd ceil_prec let trunc = default_rnd trunc_prec let equal x y = eq x y ~prec: 90;; let to_string_base_digits ~mode: mode ~base: base ~digits: digits x = let mantissa, exponent = to_string_exp_base_digits ~mode: mode ~base: base ~digits: digits (abs x) in (if (sgn x) < 0 then "-" else "") ^ (if mantissa = "Inf" then "Inf" else (let lm=String.length mantissa in if lm > 1 then let tmp = String.create (succ lm) in String.blit mantissa 0 tmp 0 1; String.blit mantissa 1 tmp 2 (pred lm); String.set tmp 1 '.'; tmp else mantissa) ^ (if base <= 10 then "E" else "@") ^ (string_of_int (pred exponent)));; let to_string = to_string_base_digits ~mode: GMP_RNDN ~base: 10 ~digits: 10;; external is_available : unit -> bool = "_mlgmp_is_mpfr_available";; let to_z_rounding division x = let sign = sgn x in if sign = 0 then Z.zero else let unsigned_mantissa, exponent = to_z_exp x in let mantissa = if sign<0 then Z.neg unsigned_mantissa else unsigned_mantissa in if exponent < 0 then division mantissa (- exponent) else Z.mul_2exp mantissa exponent;; let to_z_t = to_z_rounding Z.tdiv_q_2exp let to_z_c = to_z_rounding Z.cdiv_q_2exp let to_z_f = to_z_rounding Z.fdiv_q_2exp let to_z = to_z_t let z_from = to_z end;; external get_gmp_runtime_version: unit->string = "_mlgmp_get_runtime_version";; external get_gmp_compile_version: unit->int*int*int = "_mlgmp_get_compile_version";; mlgmp-20021123/conversions.c0000644000175000017500000000704707435254250016124 0ustar furrmfurrm00000000000000/* * 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 mlgmp-20021123/gmp.mli0000640000175000017500000004154107567677422014707 0ustar furrmfurrm00000000000000type rounding_mode = GMP_RNDN | GMP_RNDZ | GMP_RNDU | GMP_RNDD module RNG : sig type randstate_t and randalg_t = GMP_RAND_ALG_LC of int val randinit : randalg_t -> randstate_t val default : randstate_t end 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" external urandomb : state:RNG.randstate_t -> nbits:int -> t = "_mlgmp_z_urandomb" external urandomm : state:RNG.randstate_t -> n:t -> t = "_mlgmp_z_urandomm" external rrandomb : state:RNG.randstate_t -> nbits:int -> t = "_mlgmp_z_rrandomb" 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 module F : sig type t val zero: t external create : unit -> t = "_mlgmp_f_create" val default_prec : int ref external from_z_prec : prec:int -> Z.t -> t = "_mlgmp_f_from_z" external from_q_prec : prec:int -> Z.t -> t = "_mlgmp_f_from_q" external from_si_prec : prec:int -> int -> t = "_mlgmp_f_from_si" external from_float_prec : prec:int -> float -> t = "_mlgmp_f_from_float" external from_string_prec_base : prec:int -> base:int -> string -> t = "_mlgmp_f_from_string" external float_from : t->float = "_mlgmp_f_to_float";; external to_float : t->float = "_mlgmp_f_to_float";; external to_string_exp_base_digits : base:int -> digits:int -> t -> string * int = "_mlgmp_f_to_string_exp_base_digits" external add_prec : prec:int -> t -> t -> t = "_mlgmp_f_add" external sub_prec : prec:int -> t -> t -> t = "_mlgmp_f_sub" external mul_prec : prec:int -> t -> t -> t = "_mlgmp_f_mul" external div_prec : prec:int -> t -> t -> t = "_mlgmp_f_div" external add_prec_ui : prec:int -> t -> int -> t = "_mlgmp_f_add_ui" external sub_prec_ui : prec:int -> t -> int -> t = "_mlgmp_f_sub_ui" external mul_prec_ui : prec:int -> t -> int -> t = "_mlgmp_f_mul_ui" external div_prec_ui : prec:int -> t -> int -> t = "_mlgmp_f_div_ui" external neg_prec : prec:int -> t -> t = "_mlgmp_f_neg" external abs_prec : prec:int -> t -> t = "_mlgmp_f_abs" external inv_prec : prec:int -> t -> t = "_mlgmp_f_div" external reldiff_prec : prec:int -> t -> t = "_mlgmp_f_reldiff" external floor_prec : prec:int -> t -> t = "_mlgmp_f_floor" external ceil_prec : prec:int -> t -> t = "_mlgmp_f_ceil" external trunc_prec : prec:int -> t -> t = "_mlgmp_f_trunc" val from_z : Z.t -> t val from_q : Z.t -> t val from_si : int -> t val from_int : int -> t val from_float : float -> t val from_string_base : base:int -> string -> t val from_string : string -> t val add : t -> t -> t val sub : t -> t -> t val mul : t -> t -> t val div : t -> t -> t val reldiff : t -> t val add_ui : t -> int -> t val sub_ui : t -> int -> t val mul_ui : t -> int -> t val div_ui : t -> int -> t val neg : t -> t val abs : t -> t val inv : t -> t val floor : t -> t val ceil : t -> t val trunc : t -> t external cmp : t -> t -> int = "_mlgmp_f_cmp" external compare : t -> t -> int = "_mlgmp_f_cmp" external sgn : t -> int = "_mlgmp_f_sgn" external eq : t -> t -> prec:int -> bool = "_mlgmp_f_eq" external urandomb_prec : prec:int -> state:RNG.randstate_t -> nbits:int -> t = "_mlgmp_f_urandomb" external random2 : prec:int -> nlimbs:int -> max_exp:int -> t = "_mlgmp_f_random2" val urandomb : state:RNG.randstate_t -> nbits:int -> t val equal : t -> t -> bool val to_string_base_digits : base:int -> digits:int -> t -> string val to_string : t -> string end module FR : sig type t val zero: t external create_prec : prec: int -> unit -> t = "_mlgmp_fr_create" val create: unit -> t val default_prec : int ref external from_z_prec : prec:int -> mode:rounding_mode -> Z.t -> t = "_mlgmp_fr_from_z" external from_q_prec : prec:int -> mode:rounding_mode -> Z.t -> t = "_mlgmp_fr_from_z" external from_si_prec : prec:int -> mode:rounding_mode -> int -> t = "_mlgmp_fr_from_si" external from_float_prec : prec:int -> mode:rounding_mode -> float -> t = "_mlgmp_fr_from_float" external float_from : t->float = "_mlgmp_fr_to_float";; external to_float_mode : mode:rounding_mode -> t -> float = "_mlgmp_fr_to_float";; external from_string_prec_base : prec:int -> mode:rounding_mode -> base:int -> string -> t = "_mlgmp_fr_from_string" external to_string_exp_base_digits : mode:rounding_mode -> base:int -> digits:int -> t -> string * int = "_mlgmp_fr_to_string_exp_base_digits" external add_prec : prec:int -> mode:rounding_mode -> t -> t -> t = "_mlgmp_fr_add" external sub_prec : prec:int -> mode:rounding_mode -> t -> t -> t = "_mlgmp_fr_sub" external mul_prec : prec:int -> mode:rounding_mode -> t -> t -> t = "_mlgmp_fr_mul" external div_prec : prec:int -> mode:rounding_mode -> t -> t -> t = "_mlgmp_fr_div" external add_prec_ui : prec:int -> mode:rounding_mode -> t -> int -> t = "_mlgmp_fr_add_ui" external sub_prec_ui : prec:int -> mode:rounding_mode -> t -> int -> t = "_mlgmp_fr_sub_ui" external mul_prec_ui : prec:int -> mode:rounding_mode -> t -> int -> t = "_mlgmp_fr_mul_ui" external div_prec_ui : prec:int -> mode:rounding_mode -> t -> int -> t = "_mlgmp_fr_div_ui" external neg_prec : prec:int -> mode:rounding_mode -> t -> t = "_mlgmp_fr_neg" external abs_prec : prec:int -> mode:rounding_mode -> t -> t = "_mlgmp_fr_abs" external inv_prec : prec:int -> mode:rounding_mode -> t -> t = "_mlgmp_fr_div" external reldiff_prec : prec:int -> mode:rounding_mode -> t -> t = "_mlgmp_fr_reldiff" external ceil_prec : prec:int -> t -> t = "_mlgmp_fr_ceil" external floor_prec : prec:int -> t -> t = "_mlgmp_fr_floor" external trunc_prec : prec:int -> t -> t = "_mlgmp_fr_trunc" external cmp : t -> t -> int = "_mlgmp_fr_cmp" external compare : t -> t -> int = "_mlgmp_fr_cmp" external sgn : t -> int = "_mlgmp_fr_sgn" external eq : t -> t -> prec:int -> bool = "_mlgmp_fr_eq" external is_nan : t -> bool = "_mlgmp_fr_is_nan" external urandomb : prec:int -> state:RNG.randstate_t -> t = "_mlgmp_fr_urandomb" external random : prec:int -> t = "_mlgmp_fr_random" external random2 : prec:int -> nlimbs:int -> max_exp:int -> t = "_mlgmp_fr_random2" val from_z : Z.t -> t val from_q : Z.t -> t val from_si : int -> t val from_int : int -> t val from_float : float -> t val to_float : t -> float val from_string_base : base:int -> string -> t val from_string : string -> t val add : t -> t -> t val sub : t -> t -> t val mul : t -> t -> t val div : t -> t -> t val reldiff : t -> t val add_ui : t -> int -> t val sub_ui : t -> int -> t val mul_ui : t -> int -> t val div_ui : t -> int -> t val neg : t -> t val abs : t -> t val inv : t -> t val floor : t -> t val ceil : t -> t val trunc : t -> t val equal : t -> t -> bool val to_string_base_digits : mode:rounding_mode -> base:int -> digits:int -> t -> string val to_string : t -> string external to_z_exp : t->Z.t*int = "_mlgmp_fr_to_z_exp";; val to_z_t : t->Z.t val to_z_c : t->Z.t val to_z_f : t->Z.t val to_z : t->Z.t val z_from : t->Z.t external is_available : unit -> bool = "_mlgmp_is_mpfr_available" end exception Unimplemented of string external get_gmp_runtime_version : unit -> string = "_mlgmp_get_runtime_version" external get_gmp_compile_version : unit -> int * int * int = "_mlgmp_get_compile_version" mlgmp-20021123/pretty_gmp.mli0000640000175000017500000000061507406646365016305 0ustar furrmfurrm00000000000000(***************************************************** GNU MP interface for Objective CAML v0.14 David.Monniaux@ens.fr *****************************************************) val base : int ref val precision : int ref val z : Format.formatter -> Gmp.Z.t -> unit val q : Format.formatter -> Gmp.Q.t -> unit val f : Format.formatter -> Gmp.F.t -> unit val fr : Format.formatter -> Gmp.FR.t -> unit mlgmp-20021123/creal_pp.ml0000644000175000017500000000014207407325315015514 0ustar furrmfurrm00000000000000 open Format let precision = ref 20;; let pp x = print_string (Creal.to_string x !precision);; mlgmp-20021123/creal.mli0000644000175000017500000000572107407325315015176 0ustar furrmfurrm00000000000000(* * 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.1 2001/12/17 08:20:29 monniaux 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 (*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 sqrt : t -> t (*s Transcendental functions. [log x y] is $\log_x(y)$. *) val ln : t -> t val log : 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 pi_over_2 : 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 (*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 : string -> int -> 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 [p] digits such that $|d - x| < 10^{-p}$. [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 Infix notations. *) val ( +! ) : t -> t -> t val ( -! ) : t -> t -> t val ( *! ) : t -> t -> t val ( /! ) : t -> t -> t mlgmp-20021123/test_creal.ml0000644000175000017500000001163307407325317016065 0ustar furrmfurrm00000000000000 (*s Test program for [Creal]. *) open Printf open Gmp open Creal (*s Options *) let prec = ref 50 let display = ref true let sanity_check = ref true let _ = Arg.parse ["-p", Arg.Int ((:=) prec), "-p n set the precision"; "-silent", Arg.Clear display, "-silent no display"; "-check", Arg.Set sanity_check, "-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_q (Q.from_ints 1 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 pi_over_2) zero let _ = check "sin(0)=0" (sin zero) zero let _ = check "sin(pi/2)=1" (sin pi_over_2) 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 pi_over_2) 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*) mlgmp-20021123/creal.ml0000644000175000017500000005207107407325315015025 0ustar furrmfurrm00000000000000(* * 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.1 2001/12/17 08:20:29 monniaux 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 gauss_round (div_Bexp (Z.add_ui (Z.mul xpx ypy) 1) (px + py - n))) 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 pi_over_2 = 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 let cmp_x1_neg_4 = Z.cmp_si x1 (-4) in let cmp_x1_4 = Z.cmp_si x1 4 in if cmp_x1_neg_4 < 0 then (* $x < -1$ *) neg (pi_over_2 +! arctan_def (inv x)) else if cmp_x1_neg_4 == 0 then (* $x$ close to $-1$ *) neg (pi_over_2 +! arctan_def ((one -! x *! x) /! (two *! x))) /! two else if cmp_x1_4 == 0 then (* $x$ close to 1 *) (pi_over_2 -! arctan_def ((one -! x *! x) /! (two *! x))) /! two else if cmp_x1_4 > 0 then (* $x > 1$ *) pi_over_2 -! arctan_def (inv x) 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 arcsin_def x else pi_over_2 -! arccos_def x let arccos x = let x1 = approx x 1 in if z_le (Z.abs x1) z_two then pi_over_2 -! arcsin_def x else arccos_def 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 = pi_over_2 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 (pi_over_2 -! 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 n -> 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 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) (*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 s base = 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 ~base: base s') (Z.pow_ui_ui base dec)) with Not_found -> of_z (Z.from_string_base ~base: base s) end with Invalid_argument _ -> invalid_arg "Creal.of_string" let flog = Pervasives.log let to_string_aux x p = if p < 0 then invalid_arg "Creal.to_string"; let n = truncate (ceil ((float (p + 2)) *. flog 10. /. flog 4.)) in let a = approx x n in let b = Z.pow_ui_ui 4 n in let d = Z.pow_ui_ui 10 (p + 2) in let z = Z.fdiv_q (Z.mul d (Z.abs a)) b in let i = Z.fdiv_q z d in let f = Z.sub z (Z.mul d i) in let fs = Z.to_string_base ~base: 10 f in let lfs = String.length fs in let fs0 = if lfs <= 2 then String.make p '0' else if lfs < p + 2 then String.make (p - lfs + 2) '0' ^ String.sub fs 0 (lfs - 2) else (* [lfs = p+2] *) String.sub fs 0 p in Z.sgn a, Z.to_string_base ~base: 10 i, fs0 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 mlgmp-20021123/install_pp.ml0000640000175000017500000000344707414025727016105 0ustar furrmfurrm00000000000000(* * 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. *) (* The following code is a hack! *) type t = Lident of string | Ldot of t * string | Lapply of t * t;; List.iter (fun f -> Topdirs.dir_install_printer Format.std_formatter (Obj.magic (Ldot((Lident "Pretty_gmp"), f))) ) ["z"; "q"; "f"; "fr"];; mlgmp-20021123/creal_pp.mli0000644000175000017500000000006207407325316015667 0ustar furrmfurrm00000000000000 val precision : int ref val pp : Creal.t -> unit mlgmp-20021123/INSTALL.txt0000644000175000017500000000026407414417051015246 0ustar furrmfurrm00000000000000INSTALLATION INSTRUCTIONS: Modify Makefile and the beginning of config.h as necessary. Use GNU Make. BSD Make won't work. On BSD systems, GNU Make is often available as "gmake". mlgmp-20021123/benchmarks.txt0000644000175000017500000000305007430155641016253 0ustar furrmfurrm00000000000000Running the "essai" and "essai.opt" programs. INTEL ARCHITECTURE * Intel Pentium II, 400 MHz, PC-133, Linux [orion] essai_static: 2.55 s * Intel Pentium II w/ 512k cache (dual processor), 450 MHz essai_static: 2.30 s * Intel Pentium III, 450 MHz, FreeBSD 4.2 [chaland] essai.opt: 3.10 s * Intel Pentium III, 600 MHz, Linux [pleiades] essai_static: 1.63s * Intel Pentium III, 700 MHz, OpenBSD [espie] essai_static: 1.41s * Intel Pentium III, 1 GHz, FreeBSD 4.4 [airelle] essai: 1.47 s essai.opt: 1.41 s * Intel Celeron, 300 MHz, Linux 2.4.9/glibc 2.2.4 [quatramaran] essai: 3.86 s essai.opt: 4.10 s essai_static: 3.40 s * AMD K7, 500 MHz w/ 512k cache, Linux [efge] essai_static: 1.92s * AMD K7, 600 MHz, Linux [rineau] essai_static: 1.49 s * AMD Athlon, 700 MHz, Linux [apo] essai_static: 1.22 s * AMD Duron, 700 MHz, Linux [lhabert] essai_static: 1.30 s * AMD Duron, 750 MHz (7.5x100), Linux [said] essai_static: 1.20 s * AMD Athlon, 750 MHz, Linux [glouglou, Frisch] essai_static: 1.12 s * AMD Athlon, 850 MHz, Linux 2.4.16/glibc 2.2.4 [picsou] essai: 1.23 s essai.opt: 1.29 s essai_static: 1.12 s * AMD Athlon, 850 MHz, Linux 2.4.16/glibc 2.2.4 [picsou w/ BIOS settings] essai_static: 1.00 s * AMD Athlon, 900 MHz, Linux [ssecem] essai_static: 0.95 s SPARC ARCHITECTURE * UltraSparc IIi, 400 MHz, Solaris 2.8 [basilic] essai: 3.98 s essai.opt: 4.27 s * UltraSparc IIi, 360 MHz, Solaris 2.8 [mezcal] essai: 4.86 s essai.opt: 5.27 s POWERPC ARCHITECTURE * ppc750 "G3", 400 Mhz, MacOS X (Darwin 5.2) [mastorna] essai: 4 s mlgmp-20021123/ChangeLog0000640000175000017500000000150107567726671015164 0ustar furrmfurrm000000000000002002-11-23 * Replaced -ggdb by -g - MacOS X.2 gcc does not generate proper assembly code if -ggdb is used. * Bugfix wrt Achim Blumensath: do not store parameter's mpz_t address into local variables. 2002-11-21 * Fixed Z.legendre and Z.jacobi * More testing for Z * Changed Makefile not to build creal by default. * Changed Makefile to stop if autotest fails. * Added tests for Q. * Changed comparison operators in Q.Infixes to / suffix. 2002-07-29 David Monniaux * Upgraded to GMP 4.1 2002-01-24 David Monniaux * Fixed compilation for MacOS X. * Added hash functions etc... * Fixed lots of bugs. 2001-12-31 David Monniaux * First public release (3.1-3.04-1). mlgmp-20021123/install_creal_pp.ml0000644000175000017500000000044207407325316017246 0ustar furrmfurrm00000000000000 (* 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_install_printer Format.std_formatter (Obj.magic (Ldot (Lident "Creal_pp", "pp")) : 'a) mlgmp-20021123/test_mlgmp.ml0000644000175000017500000000251007416636305016107 0ustar furrmfurrm00000000000000open Gmp open Format let rng=RNG.randinit (RNG.GMP_RAND_ALG_LC 100);; let random_matrix l c = let a = Array.create_matrix l c F.zero in for i=0 to pred l do for j=0 to pred c do a.(i).(j) <- F.urandomb ~state: rng ~nbits: 40 done done; a let matrix_mul a b = let m = Array.length a and l = Array.length a.(0) and l' = Array.length b and n = Array.length b.(0) in assert (l = l'); let c = Array.create_matrix m n F.zero in for i=0 to pred m do for j=0 to pred n do let z = ref F.zero in (* missing in FR *) for k=0 to pred l do z := F.add !z (F.mul a.(i).(k) b.(k).(j)) done; a.(i).(j) <- !z done done; a;; let pp_matrix formatter a = pp_open_vbox formatter 0; for i=0 to pred (Array.length a) do pp_open_hbox formatter (); pp_print_string formatter "[ "; for j=0 to pred (Array.length a.(0)) do pp_print_string formatter ((F.to_string a.(i).(j))^" ") done; pp_print_string formatter " ]"; pp_close_box formatter () done; pp_close_box formatter ();; let n = 1000 in let a = random_matrix n n and b = random_matrix n n in ();; (* MPFR Athlon 850 n t(s) mem(Mb) 100 0.059 250 6 300 1.122 500 6.780 21 1000 97.763 85 GMP PentiumIII 1GHz n t(s) 1000 120 *) mlgmp-20021123/test_suite.ml0000644000175000017500000001136507567150375016141 0ustar furrmfurrm00000000000000open Gmp;; assert ((Z.from_int 578) = (Z.from_string_base ~base: 10 "578")); assert ((Z.from_int 578) = (Z.from_float 578.)); assert ((Z.to_string_base ~base: 10 (Z.from_int 578)) = "578"); assert ((Z.to_int (Z.from_int 578)) = 578); assert ((Z.to_float (Z.from_int 578)) = 578.); assert ((Z.add (Z.from_int 45) (Z.from_int (- 51))) = (Z.from_int (- 6))); assert ((Z.sub (Z.from_int 45) (Z.from_int (- 51))) = (Z.from_int 96)); assert ((Z.mul (Z.from_int 45) (Z.from_int (- 51))) = (Z.from_int (- 2295))); assert ((Z.add_ui (Z.from_int 45) 37) = (Z.from_int 82)); assert ((Z.sub_ui (Z.from_int 45) 37) = (Z.from_int 8)); assert ((Z.to_int (Z.mul_ui (Z.from_int 45) 37)) = 1665); assert ((Z.neg (Z.from_int 45)) = (Z.from_int (- 45))); assert ((Z.abs (Z.from_int (- 45))) = (Z.from_int 45)); assert ((Z.modulo (Z.from_int 6502) (Z.from_int 45)) = (Z.from_int 22)); assert ((Z.mul_2exp (Z.from_int 45) 2) = (Z.from_int 180)); assert ((Z.fdiv_q_2exp (Z.from_int 45) 2) = (Z.from_int 11)); assert ((Z.powm (Z.from_int 3) (Z.from_int 57) (Z.from_int 4)) = (Z.from_int 3)); assert ((Z.powm_ui (Z.from_int 3) 57 (Z.from_int 4)) = (Z.from_int 3)); assert ((Z.cdiv_qr (Z.from_int 3) (Z.from_int 2)) = ((Z.from_int 2), (Z.from_int (-1)))); assert (Z.equal (Z.mul2exp (Z.from_int 3) 2) (Z.from_int 12)); assert (Z.equal (Z.cdiv_q_2exp (Z.from_int 13) 1) (Z.from_int 7)); assert (Z.perfect_power_p (Z.pow_ui (Z.from_int 13) 45)); assert (Z.perfect_square_p ( Z.pow_ui (Z.from_string "134897980976978091") 2)); assert ((Z.legendre (Z.from_int 4) (Z.from_int 23)) = 1); assert ((Z.legendre (Z.from_int 5) (Z.from_int 23)) = -1); assert (Z.is_probab_prime (Z.nextprime (Z.from_string "1348913489791348979809769780980976978097980976978098097980979809809")) 30); (* TODO: the rest of Z is missing *) begin assert ((Q.from_int 578) = (Q.from_z (Z.from_string_base ~base: 10 "578"))); let one = Q.from_int 1 in let two = Q.add one one in let three = Q.add one two in let six = Q.mul two three in let a = Q.inv two and b = Q.div one three in let c = Q.sub a b in assert ((Q.from_float 1.5) = (Q.div three two)); assert ((Q.to_float (Q.div three two)) = 1.5); assert (c = (Q.div one six)); assert ((Q.neg c) = (Q.neg (Q.div one six))); assert ((Q.get_den c) = (Q.get_num six)); assert ((Q.cmp_ui a 1 2) = 0); assert ((Q.compare (Q.inv b) (Q.from_ints 3 1)) = 0); assert ((Q.compare b (Q.from_ints 1 3)) = 0); assert ((Q.sgn a) > 0); assert (not (Q.is_zero a)); assert (Q.is_zero (Q.sub c (Q.from_zs (Z.from_int 1) (Z.from_int 6)))); assert (Z.equal (Q.get_den c) (Z.from_int 6)); assert (Z.equal (Q.get_den c) (Q.get_num six)); assert (Q.equal c (Q.from_ints 1 6)); assert ((Q.to_string one) = "1/1"); assert ((Printf.sprintf "%a" Q.sprintf c) = "1/6"); end; assert ((F.from_int 578) = (F.from_string_base ~base: 10 "578")); assert ((F.from_int 578) = (F.from_float 578.)); assert ((float_of_string (F.to_string (F.from_int 578))) = 578.); assert ((F.to_float (F.from_int 578)) = 578.); assert ((F.add (F.from_int 45) (F.from_int (- 51))) = (F.from_int (- 6))); assert ((F.sub (F.from_int 45) (F.from_int (- 51))) = (F.from_int 96)); assert ((F.mul (F.from_int 45) (F.from_int (- 51))) = (F.from_int (- 2295))); assert ((F.add_ui (F.from_int 45) 37) = (F.from_int 82)); assert ((F.sub_ui (F.from_int 45) 37) = (F.from_int 8)); assert ((F.to_float (F.mul_ui (F.from_int 45) 37)) = 1665.); assert ((F.neg (F.from_int 45)) = (F.from_int (- 45))); assert ((F.abs (F.from_int (- 45))) = (F.from_int 45)); assert ((F.floor (F.from_string "-2.2947E3")) = (F.from_int (- 2295))); assert ((F.compare (F.from_string "478.99") (F.from_float 478.67)) > 0); assert ((F.sgn (F.from_string "-478.99")) < 0); assert (F.eq (F.from_string "478.99") (F.from_float 478.99) ~prec: 6); begin try assert ((FR.from_int 578) = (FR.from_string_base ~base: 10 "578")); assert ((FR.from_int 578) = (FR.from_float 578.)); assert ((float_of_string (FR.to_string (FR.from_int 578))) = 578.); assert ((FR.to_float (FR.from_int 578)) = 578.); assert ((FR.add (FR.from_int 45) (FR.from_int (- 51))) = (FR.from_int (- 6))); assert ((FR.sub (FR.from_int 45) (FR.from_int (- 51))) = (FR.from_int 96)); assert ((FR.mul (FR.from_int 45)(FR.from_int (- 51)))=(FR.from_int (- 2295))); assert ((FR.add_ui (FR.from_int 45) 37) = (FR.from_int 82)); assert ((FR.sub_ui (FR.from_int 45) 37) = (FR.from_int 8)); assert ((FR.to_float (FR.mul_ui (FR.from_int 45) 37)) = 1665.); assert ((FR.neg (FR.from_int 45)) = (FR.from_int (- 45))); assert ((FR.abs (FR.from_int (- 45))) = (FR.from_int 45)); assert ((FR.floor (FR.from_string "-2.2947E3")) = (FR.from_int (- 2295))); assert ((FR.compare (FR.from_string "478.99") (FR.from_float 478.67)) > 0); assert ((FR.sgn (FR.from_string "-478.99")) < 0); assert (FR.eq (FR.from_string "478.99") (FR.from_float 478.99) ~prec: 6) with Unimplemented _ -> () end;; mlgmp-20021123/LGPL.txt0000644000175000017500000006130410035616151014673 0ustar furrmfurrm00000000000000 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 Software 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!