From 5c468c1ea306359678c7a2cf32091ae8cf1eac32 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 11 Feb 2001 00:08:16 +0000 Subject: [PATCH] Implement ->FLONUM operation to coerce real numbers to flonums. --- v7/src/runtime/fixart.scm | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/v7/src/runtime/fixart.scm b/v7/src/runtime/fixart.scm index 7d172ca66..1a4b62239 100644 --- a/v7/src/runtime/fixart.scm +++ b/v7/src/runtime/fixart.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: fixart.scm,v 1.5 2000/03/16 17:13:29 cph Exp $ +$Id: fixart.scm,v 1.6 2001/02/11 00:08:16 cph Exp $ -Copyright (c) 1988-2000 Massachusetts Institute of Technology +Copyright (c) 1988-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -23,7 +23,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; package: () (declare (usual-integrations)) - + (define-primitives (fix:fixnum? fixnum? 1) (fixnum? fixnum? 1) @@ -99,12 +99,11 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (flo:ceiling->exact flonum-ceiling->exact 1) (flo:truncate->exact flonum-truncate->exact 1) (flo:round->exact flonum-round->exact 1) - (flo:vector-cons floating-vector-cons 1) (flo:vector-length floating-vector-length 1) (flo:vector-ref floating-vector-ref 2) (flo:vector-set! floating-vector-set! 3)) - + (define-integrable (fix:<= x y) (not (fix:> x y))) @@ -136,4 +135,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (if (flo:< n m) n m)) (define (flo:max n m) - (if (flo:> n m) n m)) \ No newline at end of file + (if (flo:> n m) n m)) + +(define (->flonum x) + (if (not (real? x)) + (error:wrong-type-argument x "real number" '->FLONUM)) + (exact->inexact (real-part x))) \ No newline at end of file -- 2.25.1