From 0ef117f547d2bb254c69c21078d3ad0b42a65b1e Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sun, 29 Apr 2012 21:37:23 +0000
Subject: 	* boot/ast.boot (bfNumber?): Rename from bfSmintable.  Check
 for 	floating point literals too. Adjust callers. 	(bfLessp): Check for
 integer or floating pointer numbers. 	* interp/vmlisp.lisp (complex?): New. 
 (complex): Likewise. 	(realPart): Likewise. 	(imagPart): Likewise. 
 (conjugate): Likewise. 	(sqrt): Likewise.

---
 src/ChangeLog            | 12 ++++++++++++
 src/boot/ast.boot        | 14 +++++++-------
 src/boot/strap/ast.clisp |  9 +++++----
 src/interp/boot-pkg.lisp | 21 +++++++++++++++++++++
 4 files changed, 45 insertions(+), 11 deletions(-)

diff --git a/src/ChangeLog b/src/ChangeLog
index 4e45dcb6..a64c9eba 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,15 @@
+2012-04-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* boot/ast.boot (bfNumber?): Rename from bfSmintable.  Check for
+	floating point literals too. Adjust callers.
+	(bfLessp): Check for integer or floating pointer numbers.
+	* interp/vmlisp.lisp (complex?): New.
+	(complex): Likewise.
+	(realPart): Likewise.
+	(imagPart): Likewise.
+	(conjugate): Likewise.
+	(sqrt): Likewise.
+
 2012-04-28  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/compiler.boot (finishLambdaExpression): Tidy.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index c45ade39..945af4bc 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2011, Gabriel Dos Reis.
+-- Copyright (C) 2007-2012, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -876,9 +876,9 @@ defQuoteId x==
 bfChar? x ==
   char? x or cons? x and x.op in '(char CODE_-CHAR SCHAR)
  
-bfSmintable x==
-  integer? x or cons? x and
-    x.op in '(SIZE LENGTH CHAR_-CODE MAXINDEX _+ _-)
+bfNumber? x==
+  integer? x or float? x or
+    cons? x and x.op in '(SIZE LENGTH CHAR_-CODE MAXINDEX _+ _-)
 
 bfString? x ==
   string? x
@@ -886,7 +886,7 @@ bfString? x ==
 
 bfQ(l,r)==
   bfChar? l or bfChar? r => ["CHAR=",l,r]
-  bfSmintable l or bfSmintable r => ["EQL",l,r]
+  bfNumber? l or bfNumber? r => ["EQL",l,r]
   defQuoteId l or defQuoteId r => ["EQ",l,r]
   l = nil => ["NULL",r]
   r = nil => ["NULL",l]
@@ -896,8 +896,8 @@ bfQ(l,r)==
   ["EQUAL",l,r]
  
 bfLessp(l,r)==
-  l = 0 => ["PLUSP",r]
-  r = 0 => ["MINUSP", l]
+  (integer? l or float? l) and l = 0 => ["PLUSP",r]
+  (integer? r or float? r) and r = 0 => ["MINUSP", l]
   bfChar? l or bfChar? r => ["CHAR<",l,r]
   bfString? l or bfString? r => ["STRING<",l,r]
   ["<",l,r]
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 8d1d93f4..092da1dd 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1431,8 +1431,8 @@
   (OR (CHARACTERP |x|)
       (AND (CONSP |x|) (|symbolMember?| (CAR |x|) '(|char| CODE-CHAR SCHAR)))))
 
-(DEFUN |bfSmintable| (|x|)
-  (OR (INTEGERP |x|)
+(DEFUN |bfNumber?| (|x|)
+  (OR (INTEGERP |x|) (FLOATP |x|)
       (AND (CONSP |x|)
            (|symbolMember?| (CAR |x|) '(SIZE LENGTH CHAR-CODE MAXINDEX + -)))))
 
@@ -1443,7 +1443,7 @@
 
 (DEFUN |bfQ| (|l| |r|)
   (COND ((OR (|bfChar?| |l|) (|bfChar?| |r|)) (LIST 'CHAR= |l| |r|))
-        ((OR (|bfSmintable| |l|) (|bfSmintable| |r|)) (LIST 'EQL |l| |r|))
+        ((OR (|bfNumber?| |l|) (|bfNumber?| |r|)) (LIST 'EQL |l| |r|))
         ((OR (|defQuoteId| |l|) (|defQuoteId| |r|)) (LIST 'EQ |l| |r|))
         ((NULL |l|) (LIST 'NULL |r|)) ((NULL |r|) (LIST 'NULL |l|))
         ((OR (EQ |l| T) (EQ |r| T)) (LIST 'EQ |l| |r|))
@@ -1452,7 +1452,8 @@
         (T (LIST 'EQUAL |l| |r|))))
 
 (DEFUN |bfLessp| (|l| |r|)
-  (COND ((EQL |l| 0) (LIST 'PLUSP |r|)) ((EQL |r| 0) (LIST 'MINUSP |l|))
+  (COND ((AND (OR (INTEGERP |l|) (FLOATP |l|)) (EQL |l| 0)) (LIST 'PLUSP |r|))
+        ((AND (OR (INTEGERP |r|) (FLOATP |r|)) (EQL |r| 0)) (LIST 'MINUSP |l|))
         ((OR (|bfChar?| |l|) (|bfChar?| |r|)) (LIST 'CHAR< |l| |r|))
         ((OR (|bfString?| |l|) (|bfString?| |r|)) (LIST 'STRING< |l| |r|))
         (T (LIST '< |l| |r|))))
diff --git a/src/interp/boot-pkg.lisp b/src/interp/boot-pkg.lisp
index 0bfffad7..8f3e4d91 100644
--- a/src/interp/boot-pkg.lisp
+++ b/src/interp/boot-pkg.lisp
@@ -54,6 +54,27 @@
 (defun |gensym?| (s)
   (and (symbolp s) (null (symbol-package s))))
 
+(defmacro |complex?| (x)
+  `(complexp ,x))
+
+(defmacro |complex| (x (&optional (y 0.0)))
+  `(complex ,x ,y))
+
+(defmacro |realPart| (z)
+  `(realpart ,z))
+
+(defmacro |imagPart| (z)
+  `(imagpart ,z))
+
+(defmacro |conjugate| (z)
+  `(conjugate ,z))
+
+(defmacro |integerAndFractionalParts| (x)
+  `(multiple-value-list (floor ,x)))
+
+(defmacro |sqrt| (x)
+  `(sqrt ,x))
+
 ;; Below are some missing functions.  There here for lack of better
 ;; place (sys-funs.lisp?)
 ;;
-- 
cgit v1.2.3