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