aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/ast.boot14
-rw-r--r--src/boot/strap/ast.clisp9
2 files changed, 12 insertions, 11 deletions
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|))))