1package provide Gmpq 2.0
2package require Gmpz 2.0
3
4#
5# interface to arbitrary precison rational arithmetic
6#
7namespace eval ::gmp:: {
8    namespace export qadd qsub qmul qdiv qgcd qcmp qinv qneg qcvt qcanonicalize
9}
10
11proc ::gmp::qinit_set_str {qname str radix} {
12    upvar $qname mpq
13    foreach {num den} [split $str /] break
14    if {[string length $den] == 0} { set den 1 }
15    set mpz_num [binary format x[::ffidl::info sizeof mpz_struct]]
16    set mpz_den [binary format x[::ffidl::info sizeof mpz_struct]]
17    mpz_init_set_str mpz_num $num $radix
18    mpz_init_set_str mpz_den $den $radix
19    mpq_set_num mpq $mpz_num
20    mpq_set_den mpq $mpz_den
21    mpz_clear mpz_num
22    mpz_clear mpz_den
23    mpq_canonicalize mpq
24}
25proc ::gmp::qget_num {mpq} {
26    set mpz [binary format x[::ffidl::info sizeof mpz_struct]]
27    mpq_get_num mpz $mpq
28    set mpz
29}
30proc ::gmp::qget_den {mpq} {
31    set mpz [binary format x[::ffidl::info sizeof mpz_struct]]
32    mpq_get_den mpz $mpq
33    set mpz
34}
35proc ::gmp::qget_str {rad mpq} {
36    if {$rad < 2 || $rad > 36} {
37	error "radix $rad out of bounds, min 2, max 36"
38    }
39    set num [qget_num $mpq]
40    set den [qget_den $mpq]
41    set znum [zget_str $rad $num]
42    set zden [zget_str $rad $den]
43    mpz_clear num
44    mpz_clear den
45    if {[string compare $zden 1] == 0} {
46	set r $znum
47    }  else {
48	set r $znum/$zden
49    }
50    set r
51}
52proc ::gmp::qunary {fn q1} {
53    set mpq1 [binary format x[::ffidl::info sizeof mpq_struct]]
54    set mpq2 [binary format x[::ffidl::info sizeof mpq_struct]]
55    qinit_set_str mpq1 $q1 10
56    mpq_init mpq2
57    $fn mpq2 $mpq1
58    set r [qget_str 10 $mpq2]
59    mpq_clear mpq1
60    mpq_clear mpq2
61    set r
62}
63proc ::gmp::qbinary {fn q1 q2} {
64    set mpq1 [binary format x[::ffidl::info sizeof mpq_struct]]
65    set mpq2 [binary format x[::ffidl::info sizeof mpq_struct]]
66    set mpq3 [binary format x[::ffidl::info sizeof mpq_struct]]
67    qinit_set_str mpq1 $q1 10
68    qinit_set_str mpq2 $q2 10
69    mpq_init mpq3
70    $fn mpq3 $mpq1 $mpq2
71    set r [qget_str 10 $mpq3]
72    mpq_clear mpq1
73    mpq_clear mpq2
74    mpq_clear mpq3
75    set r
76}
77proc ::gmp::qbinaryi {fn q1 q2} {
78    set mpq1 [binary format x[::ffidl::info sizeof mpq_struct]]
79    set mpq2 [binary format x[::ffidl::info sizeof mpq_struct]]
80    qinit_set_str mpq1 $q1 10
81    qinit_set_str mpq2 $q2 10
82    set r [$fn $mpq1 $mpq2]
83    mpq_clear mpq1
84    mpq_clear mpq2
85    set r
86}
87proc ::gmp::qadd {i1 i2} { qbinary mpq_add $i1 $i2 }
88proc ::gmp::qsub {i1 i2} { qbinary mpq_sub $i1 $i2 }
89proc ::gmp::qmul {i1 i2} { qbinary mpq_mul $i1 $i2 }
90proc ::gmp::qdiv {i1 i2} { qbinary mpq_div $i1 $i2 }
91proc ::gmp::qcmp {i1 i2} { qbinaryi mpq_cmp $i1 $i2 }
92proc ::gmp::qeq {i1 i2} { qbinaryi mpq_eq $i1 $i2 }
93proc ::gmp::qneg {i1} { qunary mpq_neg $i1 }
94proc ::gmp::qcvt {i1 rad1 rad2} {
95    set mpq1 [binary format x[::ffidl::info sizeof mpq_struct]]
96    qinit_set_str mpq1 $i1 $rad1
97    set r [get_str $rad2 $mpq1]
98    mpq_clear mpq1
99    set r
100}
101