source: project/release/2/gmp/gmp_rational.scm @ 8742

Last change on this file since 8742 was 8742, checked in by felix winkelmann, 12 years ago

moved eggs partially to rrb2

File size: 5.2 KB
Line 
1(include "gmp_types.scm")
2(require 'gmp_utils)
3
4(declare
5        (foreign-declare "#include <gmp.h>"))
6
7
8;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9;; Scheme Construction Function for the Rational Variable Type mpq_t
10;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11
12;; uses a finalizer to free the memory during gc
13(define make-mpq_t
14        (let (  (alloc (foreign-lambda* mpq_t () 
15                                                "return (malloc(sizeof(mpq_t)));"))
16                        (dealloc (foreign-lambda void "free" c-pointer)))
17                (lambda ()
18                        (let ((m (alloc)))
19                                (set-finalizer! m dealloc)
20                                m))))
21
22;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23;; Rational Canonicalization Functions
24;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25
26(define mpq_canonicalize
27        (foreign-lambda void "mpq_canonicalize" mpq_t))
28
29;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30;; Rational Initialization and Assignment Functions
31;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32
33(define mpq_init
34        (foreign-lambda void "mpq_init" mpq_t))
35
36(define mpq_clear
37        (foreign-lambda void "mpq_clear" mpq_t))
38
39(define mpq_set
40        (foreign-lambda void "mpq_set" mpq_t mpq_t))
41
42(define mpq_set_z
43        (foreign-lambda void "mpq_set_z" mpq_t mpz_t))
44
45(define mpq_set_ui
46        (foreign-lambda void "mpq_set_ui" mpq_t unsigned-long unsigned-long))
47
48(define mpq_set_si
49        (foreign-lambda void "mpq_set_si" mpq_t long long))
50
51(define mpq_set_str
52        (foreign-lambda int "mpq_set_str" mpq_t c-string int))
53
54(define mpq_swap
55        (foreign-lambda void "mpq_swap" mpq_t mpq_t))
56
57;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
58;; Rational Conversion Functions
59;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
60
61(define mpq_get_d
62        (foreign-lambda double "mpq_get_d" mpq_t))
63
64(define mpq_set_d
65        (foreign-lambda void "mpq_set_d" mpq_t double))
66
67(define mpq_set_f
68        (foreign-lambda void "mpq_set_f" mpq_t mpf_t))
69
70;; if there is a return char *, then manually copy it into a c-string, and
71;; free the real c-pointer returned by the function. This should make garbage
72;; collection happy.
73(define mpq_get_str
74        (let (  (alloc (foreign-lambda c-pointer "mpq_get_str" c-pointer int mpq_t))
75                        (free (foreign-lambda void "free" c-pointer)))
76        (lambda (ptr base mpq)
77                (let ((c-ptr (alloc ptr base mpq)))
78                        (if (not ptr)
79                                (let ((str (c-pointer->c-string c-ptr))) ;; copy the string...
80                                        (free c-ptr) ;; remove the mem alloced by mpz_get_str
81                                        str)
82                                ptr)))))
83
84;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
85;; Rational Arithmetic Functions
86;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
87
88(define mpq_add
89        (foreign-lambda void "mpq_add" mpq_t mpq_t mpq_t))
90
91(define mpq_sub
92        (foreign-lambda void "mpq_sub" mpq_t mpq_t mpq_t))
93
94(define mpq_mul
95        (foreign-lambda void "mpq_mul" mpq_t mpq_t mpq_t))
96
97(define mpq_mul_2exp
98        (foreign-lambda void "mpq_mul_2exp" mpq_t mpq_t unsigned-long))
99
100(define mpq_div
101        (foreign-lambda void "mpq_div" mpq_t mpq_t mpq_t))
102
103(define mpq_div_2exp
104        (foreign-lambda void "mpq_div_2exp" mpq_t mpq_t unsigned-long))
105
106(define mpq_neg
107        (foreign-lambda void "mpq_neg" mpq_t mpq_t))
108
109(define mpq_abs
110        (foreign-lambda void "mpq_abs" mpq_t mpq_t))
111
112(define mpq_inv
113        (foreign-lambda void "mpq_inv" mpq_t mpq_t))
114
115;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
116;; Rational Comparison Functions
117;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
118
119(define mpq_cmp
120        (foreign-lambda int "mpq_cmp" mpq_t mpq_t))
121
122(define mpq_cmp_ui
123        (foreign-lambda* int ((mpq_t op1) (unsigned-long num2) (unsigned-long den2))
124                "return(mpq_cmp_ui(op1, num2, den2));"))
125
126(define mpq_cmp_si
127        (foreign-lambda* int ((mpq_t op1) (long num2) (unsigned-long den2))
128                "return(mpq_cmp_si(op1, num2, den2));"))
129
130(define mpq_sgn
131        (foreign-lambda* int ((mpq_t mpq))
132                "return(mpq_sgn(mpq));"))
133
134(define mpq_equal
135        (foreign-lambda int "mpq_equal" mpq_t mpq_t))
136
137;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
138;; Applying Integer Funtions to Rationals
139;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
140
141(define mpq_numref
142        (foreign-lambda* mpz_t ((mpq_t op))
143                "return(mpq_numref(op));"))
144
145(define mpq_denref
146        (foreign-lambda* mpz_t ((mpq_t op))
147                "return(mpq_denref(op));"))
148
149(define mpq_get_num
150        (foreign-lambda void "mpq_get_num" mpz_t mpq_t))
151
152(define mpq_get_den
153        (foreign-lambda void "mpq_get_den" mpz_t mpq_t))
154
155(define mpq_set_num
156        (foreign-lambda void "mpq_set_num" mpq_t mpz_t))
157
158(define mpq_set_den
159        (foreign-lambda void "mpq_set_den" mpq_t mpz_t))
160
161;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
162;; Rational Input and Output Functions
163;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
164
165(define mpq_out_str
166        (lambda (port-var int-var mpq_t-var)
167                (let (  (mos (foreign-lambda size_t "mpq_out_str" c-pointer int mpq_t))
168                                (fp (port->file* port-var)))
169                        (mos fp int-var mpq_t-var))))
170
171(define mpq_inp_str
172        (lambda (mpq_t-var port-var int-var)
173                (let (  (mos (foreign-lambda size_t "mpq_inp_str" mpq_t c-pointer int))
174                                (fp (port->file* port-var)))
175                        (mos mpq_t-var fp int-var))))
176
177
178
179
180
181
182
Note: See TracBrowser for help on using the repository browser.