File: number.ml

package info (click to toggle)
sks 1.1.6-14
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 2,296 kB
  • sloc: ml: 15,228; ansic: 1,069; sh: 358; makefile: 347
file content (180 lines) | stat: -rw-r--r-- 5,295 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
(***********************************************************************)
(* number.ml - Basic operations and definitions for multi-precision    *)
(*             integers                                                *)
(*                                                                     *)
(* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *)
(*               2011, 2012, 2013  Yaron Minsky and Contributors       *)
(*                                                                     *)
(* This file is part of SKS.  SKS is free software; you can            *)
(* redistribute it and/or modify it under the terms of the GNU General *)
(* Public License as published by the Free Software Foundation; either *)
(* version 2 of the License, or (at your option) any later version.    *)
(*                                                                     *)
(* 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   *)
(* General Public License for more details.                            *)
(*                                                                     *)
(* You should have received a copy of the GNU General Public License   *)
(* along with this program; if not, write to the Free Software         *)
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
(* USA or see <http://www.gnu.org/licenses/>.                          *)
(***********************************************************************)

open Big_int
open StdLabels
open MoreLabels
open Printf
open Common

type z = Big_int.big_int

module Infix =
struct
  let two = big_int_of_int 2
  let one = unit_big_int
  let zero = zero_big_int
  let neg_one = big_int_of_int (-1)

  let ( *! ) = mult_big_int
  let ( +! ) = add_big_int
  let ( -! ) = sub_big_int
  let ( %! ) = mod_big_int
  let ( /! ) = div_big_int
  let ( **! ) = power_big_int_positive_int
  let ( <>! ) x y = not (eq_big_int x y)
  let ( =! ) = eq_big_int
  let ( <! ) = lt_big_int
  let ( >! ) = gt_big_int
  let ( <=! ) = le_big_int
  let ( >=! ) = ge_big_int
end

open Infix

let int_mult = mult_int_big_int
let int_posint_power = power_int_positive_int

let width = 8
let width_pow = power_int_positive_int 2 width

let revstring s =
  let len = String.length s in
  let copy = Bytes.create len in
  for i = 0 to len - 1 do
    Bytes.set copy i s.[len - 1 - i]
  done;
  copy

let revstring_inplace s =
  let len = String.length s in
  for i = 0 to (len - 2)/2 do
    let j = len - 1 - i in
    let tmp = s.[i] in
    Bytes.set s i s.[j];
    Bytes.set s j tmp
  done

let to_bytes ~nbytes n =
  if sign_big_int n = -1
  then raise (Invalid_argument "N.to_bytes: negative argument");
  let string = Bytes.create nbytes in
  let rec loop n i =
    if i < 0 then string
    else
      let (a,b) = quomod_big_int n width_pow in
      Bytes.set string i (char_of_int (int_of_big_int b));
      loop a (i - 1)
  in
  let str = loop n (nbytes - 1) in
  revstring_inplace str;
  str

let of_bytes str =
  let str = revstring str in
  let nbytes = String.length str in
  let rec loop n i =
    if i >= nbytes then n
    else
      let m = big_int_of_int (int_of_char str.[i]) in
      loop (n *! width_pow +! m) (i+1)
  in
  loop zero 0



open Big_int
open Nat

let nbits_slow x =
  let rec loop i two_to_i =
    if two_to_i >! x then i
    else loop (succ i) (two *! two_to_i)
  in
  if x =! zero then 1 else loop 1 two

let nbits_less_slow x =
  let nwords = num_digits_big_int x in
  let wsize = Sys.word_size in
  let lowbits = (nwords - 1) * wsize in
  let lastword = x /! two **! lowbits in
  nbits_slow lastword + (nwords - 1) * wsize

(** returns the number of bits required to represent the number, i.e.,
  the index (starting from 1) of the most significant non-zero bit *)
let nbits x =
 let nat = nat_of_big_int (abs_big_int x) in
 let nwords = num_digits_nat nat 0 (length_nat nat) in
 Sys.word_size * nwords - num_leading_zero_bits_in_digit nat (nwords - 1)

let nth_bit x n =
  one =! ( x /! (two **! n)) %! two

let print_bits x =
  for i = nbits x - 1 downto 0 do
    if nth_bit x i then print_string "1" else print_string "0"
  done

let squaremod x m =
  (x *! x) %! m

let rec powmod x y m =
  if y =! zero then one
  else
    let base = squaremod (powmod x ( y /! two) m) m in
    if y %! two =! zero then base
    else (base *! x) %! m

let dumb_powmod x y m =
  (x **! int_of_big_int y) %! m

let rec gcd_ex' a b =
  if b =! zero then (one,zero,a)
  else
    let (q,r) = quomod_big_int a b in
    let (u',v',gcd) = gcd_ex' b r in
    (v',u' -! v' *! q, gcd)

let gcd_ex a b =
  if b <=! a then gcd_ex' a b
  else
    let (u,v,gcd) = gcd_ex' b a in
    (v,u,gcd)

let gcd_ex_test a b =
     let (a,b) = (big_int_of_int a,big_int_of_int b) in
     let (u,v,gcd) = gcd_ex a b in
     if (u *! a +! v *! b <>! gcd)
     then failwith (sprintf "gcd_ex failed on %s and %s"
                      (string_of_big_int a) (string_of_big_int b))


(** conversion functions *)

let of_int = big_int_of_int
let to_int = int_of_big_int
let to_string = string_of_big_int
let of_string = big_int_of_string
let compare = compare_big_int