Changeset 3645

Timestamp:

09/10/03 01:23:30 (19 years ago)

Author:

piso

Message:

FLOAT-SIGN

Location:

trunk/j/src/org/armedbear/lisp

Files:

• autoloads.lisp (modified) (2 diffs)
• numbers.lisp (modified) (4 diffs)

trunk/j/src/org/armedbear/lisp/autoloads.lisp

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: autoloads.lisp,v 1.17 2003-09-08 02:24:46 piso Exp $
+;;; $Id: autoloads.lisp,v 1.18 2003-09-10 01:23:30 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -74 +74 @@
 (autoload 'make-pathname)
 (autoload '(signum floor ceiling round rem mod ftruncate ffloor fceiling fround
-            rational rationalize gcd isqrt phase)
+            rational rationalize gcd isqrt float-sign phase)
           "numbers.lisp")

trunk/j/src/org/armedbear/lisp/numbers.lisp

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: numbers.lisp,v 1.12 2003-09-08 02:24:05 piso Exp $
+;;; $Id: numbers.lisp,v 1.13 2003-09-10 01:22:57 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -156 +156 @@
          (error 'type-error "wrong type: ~S is not a real number" x))))
 
+
 ;;; FIXME
 (defun rationalize (x)
   (rational x))
-
-(when (and (find-package "JVM")
-           (fboundp 'jvm::jvm-compile))
-  (mapcar #'jvm::jvm-compile '(floor
-                               ceiling
-                               round
-                               rem
-                               ftruncate
-                               ffloor
-                               fceiling
-                               fround
-                               rational
-                               rationalize)))
-
 
 
@@ -213 +200 @@
 
 
+(defun float-sign (float1 &optional (float2 (float 1 float1)))
+  "Returns a floating-point number that has the same sign as
+   float1 and, if float2 is given, has the same absolute value
+   as float2."
+  (* (if (minusp float1)
+   (float -1 float1)
+   (float 1 float1))
+     (abs float2)))
+
+
 (defun phase (number)
   "Returns the angle part of the polar representation of a complex number.
@@ -233 +230 @@
              (complex
               (atan (imagpart number) (realpart number)))))
+
+
+(when (and (find-package "JVM")
+           (fboundp 'jvm::jvm-compile))
+  (mapcar #'jvm::jvm-compile '(floor
+                               ceiling
+                               round
+                               rem
+                               ftruncate
+                               ffloor
+                               fceiling
+                               fround
+                               rational
+                               rationalize)))