LN_CORE: inline calls to flo and fix (#360)

Also apply macro-flo and macro-fix everywhere in this module to be consistent. Note, that macro-fix and macro-flo are only visible within ln_core.scm, but are much faster. fix and flo are available globally but are much costlier.

Author: 0-8-15

modules/ln_core/color.scm

@@ -44,7 +44,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (define (color-green x) (bitwise-and (arithmetic-shift x -8) #xff))
 (define (color-red x) (bitwise-and x #xff))
 (define (color-rgba r g b a)
-  (let* ((fixr (fix r)) (fixg (fix g)) (fixb (fix b)) (fixa (fix a))
+  (let* ((fixr (macro-fix r)) (fixg (macro-fix g)) (fixb (macro-fix b)) (fixa (macro-fix a))
          (clipr (if (fx> fixr 255) 255 (if (fx< fixr 0) 0 fixr)))
          (clipg (if (fx> fixg 255) 255 (if (fx< fixg 0) 0 fixg)))
          (clipb (if (fx> fixb 255) 255 (if (fx< fixb 0) 0 fixb)))
@@ -275,7 +275,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ;; 0 = totally transparent
 ;; 1 = opaque
 (define (color-fade c f) (color-rgba
-  (color-red c) (color-green c) (color-blue c) (fix (fl* 255. (flo f)))))
+  (color-red c) (color-green c) (color-blue c) (macro-fix (fl* 255. (macro-flo f)))))
 
 
 ;; oscillating alarm colors - flutterbugs :)

modules/ln_core/floatstring.scm

@@ -38,8 +38,8 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ;; formatting of floating numbers
 
 (define (float->string x p)
-  (let* ((pe (flo (expt 10 (min 10 p))))
-         (s (number->string (fl/ (flfloor (fl+ (fl* (flo x) pe) 0.5)) pe)))
+  (let* ((pe (macro-flo (expt 10 (min 10 p))))
+         (s (number->string (fl/ (flfloor (fl+ (fl* (macro-flo x) pe) 0.5)) pe)))
          (sl (string-length s))
          (b (substring s 0 1))
          (e (substring s (- sl 1) sl)))
@@ -85,6 +85,6 @@ static char *double_to_choppedstring(double val, int precision)
 end-of-c-declare
 )
 
-(define (float->choppedstring v p) ((c-lambda (double int) char-string "double_to_choppedstring") (flo v) p))
+(define (float->choppedstring v p) ((c-lambda (double int) char-string "double_to_choppedstring") (macro-flo v) p))
 
 ;; eof

modules/ln_core/flofix.scm

@@ -35,15 +35,15 @@ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 |#
-;; type conversions used throughout to prevent FFI type errors 
+;; type conversions used throughout to prevent FFI type errors
 
 (define fix:fixnum-max-as-flonum (##fixnum->flonum ##max-fixnum))
 
 (define (fix n)
   (declare (not safe))
   (cond
     ((##fixnum? n) n)
-    ((##bignum? n) n) 
+    ((##bignum? n) n)
     ((##flonum? n) (if (##fl< n fix:fixnum-max-as-flonum)
         (##flonum->fixnum n) (##flonum->exact-int n)))
     ((##ratnum? n) (##floor n))
@@ -58,4 +58,23 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
     (else (##exact->inexact n))
   ))
 
+;; Note that macro-fix and macro-flo are only visible within ln_core.scm,
+;; but are much faster. fix and flo are available everywhere but costlier.
+(define-macro (macro-fix n)
+  `(cond
+    ((##fixnum? ,n) ,n)
+    ((##bignum? ,n) ,n)
+    ((##flonum? ,n)
+     (if (##fl< ,n fix:fixnum-max-as-flonum)
+         (##flonum->fixnum ,n) (##flonum->exact-int ,n)))
+    ((##ratnum? ,n) (##floor ,n))
+    (else #f) ;; no complex numbers
+    ))
+
+(define-macro (macro-flo n)
+  `(cond
+    ((##flonum? ,n) ,n)
+    ((##fixnum? ,n) (##fixnum->flonum ,n))
+    (else (##exact->inexact ,n))))
+
 ;; eof

modules/ln_core/list.scm

@@ -78,8 +78,8 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (define (list-interpolate lst x0)
   (let* ((x (max (min x0 1.) 0.))
         (n (- (length lst) 1))
-        (idx1 (fix (floor (* x n))))
-        (idx2 (fix (ceiling (* x n))))
+        (idx1 (macro-fix (floor (* x n))))
+        (idx2 (macro-fix (ceiling (* x n))))
         (v1 (list-ref lst idx1))
         (v2 (list-ref lst idx2)))
    (+ v1 (* (- (* x n) idx1) (- v2 v1)))))

modules/ln_core/time.scm

@@ -1497,17 +1497,17 @@ end-of-c-declare
          (s (srfi19:time-second t))
          (ns (srfi19:time-nanosecond t))
          (t2 (- s (tm:leap-second-delta s)))
-         (tz (if (= (length tz0) 1) (car tz0) (timezone-hours (fix t2))))
+         (tz (if (= (length tz0) 1) (car tz0) (timezone-hours (macro-fix t2))))
          (utc (+ 0.0 (* tz -3600.) t2 (* ns 1.0e-9)))
          ;; timezone-hours assumes t is UTC, this causes issues if one is DST but not both
-         (tz2 (timezone-hours (fix utc)))
+         (tz2 (timezone-hours (macro-fix utc)))
          (tzdiff (- tz tz2))
          (utc2 (if (= tzdiff 0) utc (+ utc (* tzdiff 3600.))))
         )
     utc2))
 
 (define (seconds->string sec0 fmt . tz0)
-  (let* ((tz (if (= (length tz0) 1) (car tz0) (timezone-hours (fix sec0))))
+  (let* ((tz (if (= (length tz0) 1) (car tz0) (timezone-hours (macro-fix sec0))))
          (sec (+ sec0 (* tz 3600.)))
          (s (inexact->exact (floor sec)))
          (ns (inexact->exact (floor (* 1.0e9 (- sec s)))))

modules/ln_core/u8vector-compress.scm

@@ -904,7 +904,7 @@ end-of-c-declare
 (define (u8vector-compress inbuf)
   (if (u8vector? inbuf) 
   (let* ((inlen (u8vector-length inbuf))
-         (outlen (max 66 (fix (* 1.05 inlen))))
+         (outlen (max 66 (macro-fix (* 1.05 inlen))))
          (outbuf (make-u8vector outlen)))
     (if (fx< inlen 16) (u8vector-append (u8vector 0) inbuf) 
       (let ((retval ((c-lambda  (scheme-object int scheme-object) int