complex numbers

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 791979ccff2b26987b097c4f63b126ab28c2ef51..1c66319c131ebf5740f9688ad607d49f596d2d1a 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,5 +1,8 @@
 + native:\r
 \r
+- printing floats: append .0 always\r
+- vector=\r
+- make-image: take a parameter, include le & be images in dist\r
 - do something about "base" variable -- too fragile\r
 ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable" ]\r
 - errors: don't show .factor-rc\r

diff --git a/build.sh b/build.sh
index 78a8fc4c6ebfd065f969ee3c710a0e3d6e5adcf6..056f96997ce2a3a652a39442c364bd0543a82f60 100644 (file)
--- a/build.sh
+++ b/build.sh
@@ -1,5 +1,5 @@
 export CC=gcc34
-export CFLAGS="-pedantic -Wall -Winline -O2 -march=pentium4 -fomit-frame-pointer"
+export CFLAGS="-pedantic -Wall -Winline -Os -march=pentium4 -fomit-frame-pointer"
 
 $CC $CFLAGS -o f native/*.c
 

diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor
index bbe6582448056fe9ebcf98a1fc8e9a548c997110..89d61b4e0e0b4786af4baf7fefa6afaa91034155 100644 (file)
--- a/library/cross-compiler.factor
+++ b/library/cross-compiler.factor
@@ -134,6 +134,11 @@ IN: cross-compiler
         float?
         str>float
         unparse-float
+        complex?
+        real
+        imaginary
+        >rect
+        rect>
         +
         -
         *

diff --git a/library/image.factor b/library/image.factor
index b129645ac8a20d143b33aa96a22c2e8299e85804..a6566cd8b7cdecda190fcb59c7837e78c29614d5 100644 (file)
--- a/library/image.factor
+++ b/library/image.factor
@@ -68,7 +68,9 @@ USE: words
 : cons-tag     BIN: 010 ;
 : object-tag   BIN: 011 ;
 : rational-tag BIN: 100 ;
-: header-tag   BIN: 101 ;
+: complex-tag  BIN: 101 ;
+: header-tag   BIN: 110 ;
+: gc-fwd-ptr   BIN: 111 ; ( we don't output these )
 
 : immediate ( x tag -- tagged ) swap tag-bits shift< bitor ;
 : >header ( id -- tagged ) header-tag immediate ;

diff --git a/library/platform/jvm/arithmetic.factor b/library/platform/jvm/arithmetic.factor
index a09e90f67308a81f0c5d715ee4d52bc39b5f86f3..34a7ee3a4bf955f06757ce37c850423181174646 100644 (file)
--- a/library/platform/jvm/arithmetic.factor
+++ b/library/platform/jvm/arithmetic.factor
@@ -63,7 +63,7 @@ USE: stack
     jinvoke-static ; inline
 
 : /mod ( a b -- a/b a%b )
-    2dup / >fixnum -rot mod ;
+    2dup /i -rot mod ;
 
 : > ( a b -- boolean )
     [ "java.lang.Number" "java.lang.Number" ]

diff --git a/library/platform/native/boot.factor b/library/platform/native/boot.factor
index eb5e241bd27a4781fa62e723298af17fc89d937c..d1d7976b1085d8dc989d724bd6ab8efe035e3697 100644 (file)
--- a/library/platform/native/boot.factor
+++ b/library/platform/native/boot.factor
@@ -79,6 +79,7 @@ primitives,
     "/library/vocabulary-style.factor"
     "/library/words.factor"
     "/library/math/math-combinators.factor"
+    "/library/math/list-math.factor"
     "/library/math/namespace-math.factor"
     "/library/test/test.factor"
     "/library/platform/native/arithmetic.factor"

diff --git a/library/platform/native/kernel.factor b/library/platform/native/kernel.factor
index 8d16c30eb40b5cde6938998d41c2d7e5bea77ecc..28fea8658517575e9618ca8da4aafdc03fe86a26 100644 (file)
--- a/library/platform/native/kernel.factor
+++ b/library/platform/native/kernel.factor
@@ -73,19 +73,20 @@ USE: unparser
 
 : class-of ( obj -- name )
     [
-        [ fixnum? ] [ drop "fixnum" ]
-        [ bignum? ] [ drop "bignum" ]
-        [ ratio?  ] [ drop "ratio" ]
-        [ float?  ] [ drop "float" ]
-        [ cons?   ] [ drop "cons" ]
-        [ word?   ] [ drop "word" ]
-        [ f =     ] [ drop "f" ]
-        [ t =     ] [ drop "t" ]
-        [ vector? ] [ drop "vector" ]
-        [ string? ] [ drop "string" ]
-        [ sbuf?   ] [ drop "sbuf" ]
-        [ handle? ] [ drop "handle" ]
-        [ drop t  ] [ drop "unknown" ]
+        [ fixnum?  ] [ drop "fixnum" ]
+        [ bignum?  ] [ drop "bignum" ]
+        [ ratio?   ] [ drop "ratio" ]
+        [ float?   ] [ drop "float" ]
+        [ complex? ] [ drop "complex" ]
+        [ cons?    ] [ drop "cons" ]
+        [ word?    ] [ drop "word" ]
+        [ f =      ] [ drop "f" ]
+        [ t =      ] [ drop "t" ]
+        [ vector?  ] [ drop "vector" ]
+        [ string?  ] [ drop "string" ]
+        [ sbuf?    ] [ drop "sbuf" ]
+        [ handle?  ] [ drop "handle" ]
+        [ drop t   ] [ drop "unknown" ]
     ] cond ;
 
 : toplevel ( -- )

diff --git a/native/arithmetic.c b/native/arithmetic.c
index 8cc86702733c445461bbb3596f134e4c2b2861df..a28fbeace2fa620a829eaf7e9410d9c9aeb86cd8 100644 (file)
--- a/native/arithmetic.c
+++ b/native/arithmetic.c
@@ -36,24 +36,51 @@ FLOAT* ratio_to_float(CELL tagged)
        return (FLOAT*)UNTAG(divfloat(r->numerator,r->denominator));
 }
 
-void primitive_numberp(void)
+bool realp(CELL tagged)
 {
-       check_non_empty(env.dt);
-
-       switch(type_of(env.dt))
+       switch(type_of(tagged))
        {
        case FIXNUM_TYPE:
        case BIGNUM_TYPE:
        case RATIO_TYPE:
        case FLOAT_TYPE:
-               env.dt = T;
+               return true;
                break;
        default:
-               env.dt = F;
+               return false;
                break;
        }
 }
 
+bool numberp(CELL tagged)
+{
+       return realp(tagged) || type_of(tagged) == COMPLEX_TYPE;
+}
+
+void primitive_numberp(void)
+{
+       check_non_empty(env.dt);
+       env.dt = tag_boolean(numberp(env.dt));
+}
+
+bool zerop(CELL tagged)
+{
+       switch(type_of(tagged))
+       {
+       case FIXNUM_TYPE:
+               return tagged == 0;
+       case BIGNUM_TYPE:
+               return ((BIGNUM*)UNTAG(tagged))->n == 0;
+       case FLOAT_TYPE:
+               return ((FLOAT*)UNTAG(tagged))->n == 0.0;
+       case RATIO_TYPE:
+               return false;
+       default:
+               critical_error("Bad parameter to zerop",tagged);
+               return false; /* Can't happen */
+       }
+}
+
 CELL to_integer(CELL tagged)
 {
        RATIO* r;
@@ -67,7 +94,7 @@ CELL to_integer(CELL tagged)
                r = (RATIO*)UNTAG(tagged);
                return divint(r->numerator,r->denominator);
        default:
-               type_error(FIXNUM_TYPE,tagged);
+               type_error(INTEGER_TYPE,tagged);
                return NULL; /* can't happen */
        }
 }

diff --git a/native/arithmetic.h b/native/arithmetic.h
index 2307c6e4c81f835c52d1b2c6c97750f1299b68d9..bb65d94085a9890ac512cfdd1c1ff82c44203059 100644 (file)
--- a/native/arithmetic.h
+++ b/native/arithmetic.h
@@ -35,14 +35,28 @@ CELL OP(CELL x, CELL y) \
                        return OP##_fixnum(x,y); \
                case RATIO_TYPE: \
                        if(integerOnly) \
-                               return OP(x,to_integer(y)); \
+                       { \
+                               type_error(FIXNUM_TYPE,y); \
+                               return F; \
+                       } \
                        else \
                                return OP##_ratio((CELL)fixnum_to_ratio(x),y); \
+               case COMPLEX_TYPE: \
+                       if(integerOnly) \
+                       { \
+                               type_error(FIXNUM_TYPE,y); \
+                               return F; \
+                       } \
+                       else \
+                               return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \
                case BIGNUM_TYPE: \
                        return OP##_bignum((CELL)fixnum_to_bignum(x),y); \
                case FLOAT_TYPE: \
                        if(integerOnly) \
-                               return OP(x,to_integer(y)); \
+                       { \
+                               type_error(FIXNUM_TYPE,y); \
+                               return F; \
+                       } \
                        else \
                                return OP##_float((CELL)fixnum_to_float(x),y); \
                default: \
@@ -54,29 +68,53 @@ CELL OP(CELL x, CELL y) \
                } \
 \
        case RATIO_TYPE: \
+\
+               if(integerOnly) \
+               { \
+                       type_error(FIXNUM_TYPE,x); \
+                       return F; \
+               } \
 \
                switch(type_of(y)) \
                { \
                case FIXNUM_TYPE: \
-                       if(integerOnly) \
-                               return OP(to_integer(x),y); \
-                       else \
-                               return OP##_ratio(x,(CELL)fixnum_to_ratio(y)); \
+                       return OP##_ratio(x,(CELL)fixnum_to_ratio(y)); \
                case RATIO_TYPE: \
-                       if(integerOnly) \
-                               return OP(to_integer(x),to_integer(y)); \
-                       else \
-                               return OP##_ratio(x,y); \
+                       return OP##_ratio(x,y); \
+               case COMPLEX_TYPE: \
+                       return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \
                case BIGNUM_TYPE: \
-                       if(integerOnly) \
-                               return OP(to_integer(x),y); \
-                       else \
-                               return OP##_ratio(x,(CELL)bignum_to_ratio(y)); \
+                       return OP##_ratio(x,(CELL)bignum_to_ratio(y)); \
                case FLOAT_TYPE: \
-                       if(integerOnly) \
-                               return OP(to_integer(x),to_integer(y)); \
+                       return OP##_float((CELL)ratio_to_float(x),y); \
+               default: \
+                       if(anytype) \
+                               return OP##_anytype(x,y); \
                        else \
-                               return OP##_float((CELL)ratio_to_float(x),y); \
+                               type_error(FIXNUM_TYPE,y); \
+                       return F; \
+               } \
+\
+       case COMPLEX_TYPE: \
+\
+               if(integerOnly) \
+               { \
+                       type_error(FIXNUM_TYPE,x); \
+                       return F; \
+               } \
+\
+               switch(type_of(y)) \
+               { \
+               case FIXNUM_TYPE: \
+                       return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \
+               case RATIO_TYPE: \
+                       return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \
+               case COMPLEX_TYPE: \
+                       return OP##_complex(x,y); \
+               case BIGNUM_TYPE: \
+                       return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \
+               case FLOAT_TYPE: \
+                       return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \
                default: \
                        if(anytype) \
                                return OP##_anytype(x,y); \
@@ -93,14 +131,28 @@ CELL OP(CELL x, CELL y) \
                        return OP##_bignum(x,(CELL)fixnum_to_bignum(y)); \
                case RATIO_TYPE: \
                        if(integerOnly) \
-                               return OP(x,to_integer(y)); \
+                       { \
+                               type_error(BIGNUM_TYPE,y); \
+                               return F; \
+                       } \
                        else \
                                return OP##_ratio((CELL)bignum_to_ratio(x),y); \
+               case COMPLEX_TYPE: \
+                       if(integerOnly) \
+                       { \
+                               type_error(BIGNUM_TYPE,y); \
+                               return F; \
+                       } \
+                       else \
+                               return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \
                case BIGNUM_TYPE: \
                        return OP##_bignum(x,y); \
                case FLOAT_TYPE: \
                        if(integerOnly) \
-                               return OP(x,to_integer(y)); \
+                       { \
+                               type_error(BIGNUM_TYPE,y); \
+                               return F; \
+                       } \
                        else \
                                return OP##_float((CELL)bignum_to_float(x),y); \
                default: \
@@ -112,34 +164,27 @@ CELL OP(CELL x, CELL y) \
                } \
 \
        case FLOAT_TYPE: \
-        \
+\
+               if(integerOnly) \
+               { \
+                       type_error(FIXNUM_TYPE,x); \
+                       return F; \
+               } \
+\
                switch(type_of(y)) \
                { \
                case FIXNUM_TYPE: \
-                       if(integerOnly) \
-                               return OP(to_integer(x),y); \
-                       else \
-                               return OP##_float(x,(CELL)fixnum_to_float(y)); \
+                       return OP##_float(x,(CELL)fixnum_to_float(y)); \
                case RATIO_TYPE: \
-                       if(integerOnly) \
-                               return OP(x,to_integer(y)); \
-                       else \
-                               return OP##_float(x,(CELL)ratio_to_float(y)); \
+                       return OP##_float(x,(CELL)ratio_to_float(y)); \
+               case COMPLEX_TYPE: \
+                       return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \
                case BIGNUM_TYPE: \
-                       if(integerOnly) \
-                               return OP(to_integer(x),y); \
-                       else \
-                               return OP##_float(x,(CELL)bignum_to_float(y)); \
+                       return OP##_float(x,(CELL)bignum_to_float(y)); \
                case FLOAT_TYPE: \
-                       if(integerOnly) \
-                               return OP(to_integer(x),to_integer(y)); \
-                       else \
-                               return OP##_float(x,y); \
+                       return OP##_float(x,y); \
                default: \
-                       if(anytype) \
-                               return OP##_anytype(x,y); \
-                       else \
-                               type_error(FLOAT_TYPE,y); \
+                       type_error(FLOAT_TYPE,y); \
                        return F; \
                } \
 \
@@ -159,8 +204,12 @@ void primitive_##OP(void) \
        env.dt = OP(x,y); \
 }
 
+bool realp(CELL tagged);
+bool numberp(CELL tagged);
 void primitive_numberp(void);
 
+bool zerop(CELL tagged);
+
 FIXNUM to_fixnum(CELL tagged);
 void primitive_to_fixnum(void);
 BIGNUM* to_bignum(CELL tagged);

diff --git a/native/factor.h b/native/factor.h
index 999aa1b80777fd5daad4149053d715a85681942d..a0f63db6577735ed6a4d09a30c2c5b5865746180 100644 (file)
--- a/native/factor.h
+++ b/native/factor.h
@@ -47,6 +47,7 @@ typedef unsigned char BYTE;
 #include "bignum.h"
 #include "ratio.h"
 #include "float.h"
+#include "complex.h"
 #include "arithmetic.h"
 #include "misc.h"
 #include "string.h"

diff --git a/native/primitives.c b/native/primitives.c
index 2d15625eefc414b893ebf9bee60824bf794761d3..e963313916a6d1a4fd1cfe095647a167db4d60b4 100644 (file)
--- a/native/primitives.c
+++ b/native/primitives.c
@@ -48,6 +48,11 @@ XT primitives[] = {
        primitive_floatp,
        primitive_str_to_float,
        primitive_float_to_str,
+       primitive_complexp,
+       primitive_real,
+       primitive_imaginary,
+       primitive_to_rect,
+       primitive_from_rect,
        primitive_add,
        primitive_subtract,
        primitive_multiply,

diff --git a/native/primitives.h b/native/primitives.h
index 8146fe1669d71651d79a30705007449407f881a0..3847b25c062bff61d2265fc5193fadffec038931 100644 (file)
--- a/native/primitives.h
+++ b/native/primitives.h
@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 107
+#define PRIMITIVE_COUNT 112
 
 CELL primitive_to_xt(CELL primitive);

diff --git a/native/ratio.c b/native/ratio.c
index 964b7143afba2bf61cae5bc9f069a4224eb34f6e..4b7bba42977a8ed73d9b2f70b0230d51fadab052 100644 (file)
--- a/native/ratio.c
+++ b/native/ratio.c
@@ -2,7 +2,7 @@
 
 RATIO* ratio(CELL numerator, CELL denominator)
 {
-       RATIO* ratio = (RATIO*)allot(sizeof(RATIO));
+       RATIO* ratio = allot(sizeof(RATIO));
        ratio->numerator = numerator;
        ratio->denominator = denominator;
        return ratio;
@@ -26,7 +26,7 @@ void primitive_numerator(void)
                env.dt = untag_ratio(env.dt)->numerator;
                break;
        default:
-               type_error(RATIO_TYPE,env.dt);
+               type_error(RATIONAL_TYPE,env.dt);
                break;
        }
 }
@@ -43,7 +43,7 @@ void primitive_denominator(void)
                env.dt = untag_ratio(env.dt)->denominator;
                break;
        default:
-               type_error(RATIO_TYPE,env.dt);
+               type_error(RATIONAL_TYPE,env.dt);
                break;
        }
 }

diff --git a/native/types.c b/native/types.c
index a549d3b6f56e8f5d85a182e924980f6854ea6b0b..ec7899abb08d1de8990885cb245952072d23f68c 100644 (file)
--- a/native/types.c
+++ b/native/types.c
@@ -60,20 +60,32 @@ void* allot_object(CELL type, CELL length)
 
 CELL object_size(CELL pointer)
 {
+       CELL size;
+
        switch(TAG(pointer))
        {
        case CONS_TYPE:
-               return align8(sizeof(CONS));
+               size = sizeof(CONS);
+               break;
        case WORD_TYPE:
-               return align8(sizeof(WORD));
+               size = sizeof(WORD);
+               break;
        case RATIO_TYPE:
-               return align8(sizeof(RATIO));
+               size = sizeof(RATIO);
+               break;
+       case COMPLEX_TYPE:
+               size = sizeof(COMPLEX);
+               break;
        case OBJECT_TYPE:
-               return untagged_object_size(UNTAG(pointer));
+               size = untagged_object_size(UNTAG(pointer));
+               break;
        default:
                critical_error("Cannot determine size",pointer);
-               return -1;
+               size = 0; /* Can't happen */
+               break;
        }
+
+       return align8(size);
 }
 
 CELL untagged_object_size(CELL pointer)

diff --git a/native/types.h b/native/types.h
index bf51c0842f72bf1e9fe338873b75a7dd647be639..5f12ce5c640dcd2770cd409a3fcea023d2ad0636 100644 (file)
--- a/native/types.h
+++ b/native/types.h
@@ -10,8 +10,9 @@
 #define CONS_TYPE 2
 #define OBJECT_TYPE 3
 #define RATIO_TYPE 4
-#define HEADER_TYPE 5
-#define GC_COLLECTED 6 /* See gc.c */
+#define COMPLEX_TYPE 5
+#define HEADER_TYPE 6
+#define GC_COLLECTED 7 /* See gc.c */
 
 /*** Header types ***/
 
@@ -35,6 +36,11 @@ CELL empty;
 #define BIGNUM_TYPE 14
 #define FLOAT_TYPE 15
 
+/* Pseudo-types. For error reporting only. */
+#define INTEGER_TYPE 100 /* FIXNUM or BIGNUM */
+#define RATIONAL_TYPE 101 /* INTEGER or RATIO */
+#define REAL_TYPE 102 /* RATIONAL or FLOAT */
+
 bool typep(CELL type, CELL tagged);
 CELL type_of(CELL tagged);
 void type_check(CELL type, CELL tagged);