~ chicken-core (chicken-5) 1f91b0b79e562bd0881b1589b1f375a5fc712de0

commit 1f91b0b79e562bd0881b1589b1f375a5fc712de0
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Jun 15 14:36:27 2010 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Jun 15 14:36:27 2010 +0200

    don't rewrite hooks for exactness-conversion; optimized some uses

diff --git a/c-platform.scm b/c-platform.scm
index ddc039f9..a1d0c5f7 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -720,7 +720,6 @@
 (rewrite '##sys#vector-length 2 1 "C_i_vector_length" #t)
 (rewrite 'string-length 2 1 "C_i_string_length" #t)
 (rewrite 'inexact->exact 2 1 "C_i_inexact_to_exact" #t)
-(rewrite '##sys#inexact->exact 2 1 "C_i_inexact_to_exact" #t)
 
 (rewrite '##sys#check-exact 2 1 "C_i_check_exact" #t)
 (rewrite '##sys#check-number 2 1 "C_i_check_number" #t)
@@ -799,7 +798,6 @@
 (rewrite '<= 13 "C_less_or_equal_p" #t)
 
 (rewrite 'exact->inexact 13 "C_exact_to_inexact" #t)
-(rewrite '##sys#exact->inexact 13 "C_exact_to_inexact" #t)
 (rewrite 'string->number 13 "C_string_to_number" #t)
 (rewrite 'number->string 13 "C_number_to_string" #t)
 (rewrite '##sys#call-with-current-continuation 13 "C_call_cc" #t)
diff --git a/library.scm b/library.scm
index fed10809..33b204fa 100644
--- a/library.scm
+++ b/library.scm
@@ -913,9 +913,11 @@ EOF
 	((< n 0) (if (##sys#exact? n) -1 -1.0))
 	(else (if (##sys#exact? n) 0 0.0) ) ) )
 
+;; hooks for numbers
 (define ##sys#exact->inexact (##core#primitive "C_exact_to_inexact"))
-(define exact->inexact ##sys#exact->inexact)
 (define (##sys#inexact->exact n) (##core#inline "C_i_inexact_to_exact" n))
+
+(define exact->inexact ##sys#exact->inexact)
 (define inexact->exact ##sys#inexact->exact)
 
 (define (floor x)
diff --git a/srfi-18.scm b/srfi-18.scm
index 9fcd5497..35f137c2 100644
--- a/srfi-18.scm
+++ b/srfi-18.scm
@@ -45,12 +45,19 @@
 
 ;;; Helper routines:
 
+(define-inline (exactify n)
+  (if (##sys#immediate? x)
+      n
+      (##core#inline "C_i_inexact_to_exact" n)))
+
 (define ##sys#compute-time-limit
   (let ([truncate truncate])
     (lambda (tm)
       (and tm
 	   (cond [(##sys#structure? tm 'time) (##sys#slot tm 1)]
-		 [(number? tm) (fx+ (##sys#fudge 16) (inexact->exact (truncate (* tm 1000))))]
+		 [(number? tm) 
+		  (fx+ (##sys#fudge 16) 
+		       (exactify (truncate (* tm 1000))))]
 		 [else (##sys#signal-hook #:type-error "invalid timeout argument" tm)] ) ) ) ) )
 
 
@@ -73,7 +80,7 @@ EOF
 	 [ms C_ms] )
     (##sys#make-structure
      'time
-     (inexact->exact (truncate (+ (* (- s ss) 1000) C_ms)))
+     (exactify (truncate (+ (* (- s ss) 1000) C_ms)))
      s
      C_ms) ) )
 
@@ -85,7 +92,7 @@ EOF
 
 (define (time->milliseconds tm)
   (##sys#check-structure tm 'time 'time->milliseconds)
-  (+ (inexact->exact (* (- (##sys#slot tm 2) C_startup_time_seconds) 1000))
+  (+ (exactify (* (- (##sys#slot tm 2) C_startup_time_seconds) 1000))
      (##sys#slot tm 3) ) )
 
 (define (seconds->time n)
@@ -94,8 +101,8 @@ EOF
 	 [ms (truncate 
 	      (* 1000
 		 (##sys#flonum-fraction (##sys#exact->inexact n))))] ; milliseconds
-	 [n3 (inexact->exact (truncate (+ (* n2 1000) ms)))] ) ; milliseconds since startup
-    (##sys#make-structure 'time n3 (truncate n) (inexact->exact ms)) ) )
+	 [n3 (exactify (truncate (+ (* n2 1000) ms)))] ) ; milliseconds since startup
+    (##sys#make-structure 'time n3 (truncate n) (exactify ms)) ) )
 
 (define (milliseconds->time nms)
   (##sys#check-exact nms 'milliseconds->time)
diff --git a/srfi-69.scm b/srfi-69.scm
index 5225eab9..5398de66 100644
--- a/srfi-69.scm
+++ b/srfi-69.scm
@@ -607,8 +607,8 @@
         [min-load (##sys#slot ht 5)]
         [max-load (##sys#slot ht 6)] )
     (let ([len (##sys#size vec)] )
-      (let ([min-load-len (inexact->exact (floor (* len min-load)))]
-            [max-load-len (inexact->exact (floor (* len max-load)))] )
+      (let ([min-load-len (exactify (floor (* len min-load)))]
+            [max-load-len (exactify (floor (* len max-load)))] )
         (if (and (fx< len hash-table-max-length)
                  (fx<= min-load-len newsiz) (fx<= newsiz max-load-len))
           (hash-table-resize! ht vec len) ) ) ) ) )