* Added truncate and fltruncate

src/ikarus.numerics.ss

@@ -297,7 +297,7 @@
           modulo even? odd?
           positive? negative? expt gcd lcm numerator denominator exact-integer-sqrt
           quotient+remainder number->string string->number min max
-          abs
+          abs truncate fltruncate
           exact->inexact inexact floor ceiling round log fl=? fl<? fl<=? fl>?
           fl>=? fl+ fl- fl* fl/ flsqrt flmin flzero? flnegative?
           sin cos tan asin acos atan sqrt
@@ -318,7 +318,7 @@
             exact-integer-sqrt min max abs
             fl=? fl<? fl<=? fl>? fl>=? fl+ fl- fl* fl/ flsqrt flmin
             flzero? flnegative?
-            sin cos tan asin acos atan sqrt
+            sin cos tan asin acos atan sqrt truncate fltruncate
             flround flmax random))
 
 ;    (foreign-call "ikrt_fixnum_to_flonum" x))
@@ -1857,6 +1857,11 @@
                   [else
                    (if (even? q) q (- q 1))])))))))
 
+
+  (define ($ratnum-truncate x)
+    (let ([n ($ratnum-n x)] [d ($ratnum-d x)])
+      (quotient n d)))
+
   ;(define ($flround x)
   ;  (foreign-call "ikrt_fl_round" x ($make-flonum)))
 
@@ -1874,8 +1879,6 @@
              [else x]))
         (error 'flround "~s is not a flonum" x)))
 
-
-
   (define (round x)
     (cond
       [(flonum? x) 
@@ -1888,6 +1891,26 @@
       [(or (fixnum? x) (bignum? x)) x]
       [else (error 'round "~s is not a number" x)]))
 
+  (define (truncate x)
+    (cond
+      [(flonum? x) 
+       (let ([e (or ($flonum->exact x) 
+                    (error 'truncate "~s has no real value" x))])
+         (cond
+           [(ratnum? e) (exact->inexact ($ratnum-truncate e))]
+           [else x]))]
+      [(ratnum? x) ($ratnum-truncate x)]
+      [(or (fixnum? x) (bignum? x)) x]
+      [else (error 'truncate "~s is not a number" x)]))
+  
+  (define (fltruncate x)
+    (unless (flonum? x)
+      (error 'fltruncate "~s is not a flonum" x))
+    (let ([v ($flonum->exact x)])
+      (cond
+        [(ratnum? v) (exact->inexact ($ratnum-truncate x))]
+        [else x])))
+
   (define log
     (lambda (x)
       (cond

src/makefile.ss

@@ -478,6 +478,7 @@
     [flfloor                 i rfl]
     [flround                 i rfl]
     [flceiling               i rfl]
+    [fltruncate              i rfl]
     [flnumerator             i rfl]
     [fldenominator           i rfl]
     [flexp                   i rfl]
@@ -543,6 +544,7 @@
     [floor                   i r]
     [ceiling                 i r]
     [round                   i r]
+    [truncate                i r]
     [exact-integer-sqrt      i r]
     [exact->inexact          i r]
     [inexact->exact          i r]

src/todo-r6rs.ss

@@ -220,7 +220,7 @@
     [symbol=?                                   C ba]
     [symbol?                                    C ba se]
     [tan                                        C ba se]
-    [truncate                                   S ba se]
+    [truncate                                   C ba se]
     [values                                     C ba se]
     [vector                                     C ba se]
     [vector->list                               C ba se]
@@ -341,7 +341,7 @@
     [flsin                                      C fl]
     [flsqrt                                     C fl]
     [fltan                                      C fl]
-    [fltruncate                                 S fl]
+    [fltruncate                                 C fl]
     [flzero?                                    C fl]
     [real->flonum                               D fl]
     [make-no-infinities-violation               D fl]