- Added complex numbers representation (exact complex only).

- Added make-rectangular.
- Added the ability to display complex numbers.

scheme/ikarus.compiler.ss

@@ -2445,9 +2445,14 @@
   (define disp-ratnum-den  (* 2 wordsize))
   (define ratnum-size      (* 4 wordsize))
 
+  (define compnum-tag        #x37)
+  (define disp-compnum-real  (* 1 wordsize))
+  (define disp-compnum-imag  (* 2 wordsize))
+  (define compnum-size       (* 4 wordsize))
+
   (define bignum-mask        #b111)
   (define bignum-tag         #b011)
-  (define bignum-sign-mask  #b1000)
+  (define bignum-sign-mask   #b1000)
   (define bignum-sign-shift   3)
   (define bignum-length-shift 4) 
   (define disp-bignum-data    wordsize)

scheme/ikarus.not-yet-implemented.ss

@@ -1,7 +1,7 @@
 
 (library (ikarus not-yet-implemented)
   (export 
-    make-rectangular angle make-polar 
+    angle make-polar 
     bitwise-copy-bit-field bitwise-reverse-bit-field
     bitwise-rotate-bit-field bitwise-if fxreverse-bit-field
     fxrotate-bit-field bytevector->string string->bytevector
@@ -17,7 +17,7 @@
     string-upcase)
 
   (import (except (ikarus) 
-    make-rectangular angle make-polar 
+    angle make-polar 
     bitwise-copy-bit-field bitwise-reverse-bit-field
     bitwise-rotate-bit-field bitwise-if fxreverse-bit-field
     fxrotate-bit-field bytevector->string string->bytevector
@@ -31,8 +31,6 @@
     string-downcase string-normalize-nfc string-normalize-nfd
     string-normalize-nfkc string-normalize-nfkd string-titlecase
     string-upcase))
-                  
-                  
   
   (define-syntax not-yet
     (syntax-rules ()
@@ -57,20 +55,25 @@
          ...)]))
 
   (not-yet 
-    make-rectangular angle make-polar 
+    ;;; should be implemented
+    bytevector->string string->bytevector
+    string-downcase string-titlecase string-upcase
+    angle make-polar 
     bitwise-if
     bitwise-rotate-bit-field bitwise-copy-bit-field bitwise-reverse-bit-field
     fxreverse-bit-field fxrotate-bit-field 
-    bytevector->string string->bytevector
+    ;;; not top priority at the moment
+    make-eqv-hashtable make-hashtable equal-hash
+    hashtable-hash-function hashtable-equivalence-function
+    string-normalize-nfc string-normalize-nfd
+    string-normalize-nfkc string-normalize-nfkd 
+    ;;; won't be implemented
     make-custom-binary-input/output-port
     make-custom-textual-input/output-port
-    open-file-input/output-port output-port-buffer-mode
+    open-file-input/output-port
-    port-has-port-position? port-has-set-port-position!?
+    output-port-buffer-mode
-    port-position set-port-position! make-eqv-hashtable
+    port-has-set-port-position!? set-port-position! 
-    hashtable-hash-function make-hashtable
+    port-has-port-position? port-position
-    hashtable-equivalence-function equal-hash
+    ))
-    string-downcase string-normalize-nfc string-normalize-nfd
-    string-normalize-nfkc string-normalize-nfkd string-titlecase
-    string-upcase))
 
 

scheme/ikarus.numerics.ss

@@ -1300,7 +1300,7 @@
         [(bignum? x) (even-bignum? x)]
         [(flonum? x) (die 'odd? "BUG" x)]
         [else (die 'odd? "not an integer" x)])))
-  
+
   (module (number->string)
     (module (bignum->string)
       (define (bignum->decimal-string x)
@@ -1353,8 +1353,15 @@
           ($number->string ($ratnum-n x) r)
           "/"
           ($number->string ($ratnum-d x) r))))
+    (define (imag x r)
+      (cond
+        [(eqv? x 1) "+"]
+        [(eqv? x -1) "-"]
+        [(< x 0) ($number->string x r)]
+        [else (string-append "+" ($number->string x r))]))
     (define $number->string
       (lambda (x r)
+        (import (ikarus system $compnums))
         (cond
           [(fixnum? x) (fixnum->string x r)]
           [(bignum? x) (bignum->string x r)]
@@ -1365,6 +1372,11 @@
                 r x))
            (flonum->string x)]
           [(ratnum? x) (ratnum->string x r)]
+          [(compnum? x)
+           (string-append 
+             ($number->string ($compnum-real x) r)
+             (imag ($compnum-imag x) r)
+             "i")]
           [else (die 'number->string "not a number" x)])))
     (define number->string
       (case-lambda
@@ -3354,3 +3366,34 @@
   )
 
 
+(library (ikarus complex-numbers)
+  (export make-rectangular $make-rectangular)
+  (import 
+    (except (ikarus) make-rectangular)
+    (except (ikarus system $compnums) $make-rectangular))
+
+  (define ($make-rectangular r i)
+    (cond
+      [(eqv? i 0) r]
+      [else ($make-compnum r i)]))
+
+  (define (make-rectangular r i)
+    (define who 'make-rectangular)
+    (define (err x)
+      (die who "invalid argument" x))
+    (define (valid-part? x)
+      (or (fixnum? x)
+          (bignum? x)
+          (ratnum? x)))
+    (cond
+      [(eqv? i 0)
+       (if (valid-part? r) r (err r))]
+      [(valid-part? i) 
+       (if (valid-part? r) 
+           ($make-compnum r i)
+           (err i))]
+      [else (err r)]))
+)
+
+
+

scheme/ikarus.predicates.ss

@@ -16,14 +16,16 @@
 
 (library (ikarus predicates)
 
-  (export fixnum? flonum? bignum? ratnum? number? complex? real? rational?
+  (export fixnum? flonum? bignum? ratnum? compnum?
+          number? complex? real? rational?
           integer? exact? inexact? eof-object? bwp-object? immediate?
           boolean? char? vector? bytevector? string? procedure? null? pair?
           symbol? code? not weak-pair? eq? eqv? equal? boolean=?
           symbol=? finite? infinite? nan? real-valued?
           rational-valued? integer-valued? transcoder?)
   (import 
-    (except (ikarus) fixnum? flonum? bignum? ratnum? number? complex? real?
+    (except (ikarus) fixnum? flonum? bignum? ratnum? compnum? 
+            number? complex? real?
             rational? integer? exact? inexact? eof-object? bwp-object?
             immediate? boolean? char? vector? bytevector? string? procedure?
             null? pair? weak-pair? symbol? code? not eq? eqv? equal?
@@ -36,7 +38,9 @@
     (ikarus system $chars)
     (ikarus system $strings)
     (ikarus system $vectors)
-    (rename (only (ikarus) fixnum? flonum? bignum? ratnum? eof-object?
+    ;(ikarus system $compnums)
+    (rename (only (ikarus) fixnum? flonum? bignum? ratnum? compnum? 
+                  eof-object?
                   bwp-object? immediate? boolean? char? vector? string?
                   bytevector? procedure? null? pair? symbol? code? eq?
                   transcoder?)
@@ -44,6 +48,7 @@
             (flonum? sys:flonum?)
             (bignum? sys:bignum?)
             (ratnum? sys:ratnum?)
+            (compnum? sys:compnum?)
             (eof-object? sys:eof-object?)
             (bwp-object? sys:bwp-object?)
             (immediate? sys:immediate?)
@@ -73,21 +78,29 @@
   (define flonum? 
     (lambda (x) (sys:flonum? x)))
   
+  (define compnum? 
+    (lambda (x) (sys:compnum? x)))
+
   (define number?
     (lambda (x)
       (or (sys:fixnum? x)
           (sys:bignum? x)
           (sys:flonum? x)
-          (sys:ratnum? x))))
+          (sys:ratnum? x)
+          (sys:compnum? x))))
   
   (define complex?
     (lambda (x) (number? x)))
   
   (define real?
-    (lambda (x) (number? x)))
+    (lambda (x) 
+      (or (sys:fixnum? x)
+          (sys:bignum? x)
+          (sys:flonum? x)
+          (sys:ratnum? x))))
 
   (define real-valued?
-    (lambda (x) (number? x)))
+    (lambda (x) (real? x)))
 
   (define rational?
     (lambda (x) 
@@ -120,6 +133,7 @@
         [(sys:bignum? x) #t]
         [(sys:ratnum? x) #t]
         [(sys:flonum? x) #f]
+        [(sys:compnum? x) #t]
         [else 
          (die 'exact? "not a number" x)])))
   
@@ -131,6 +145,7 @@
         [(sys:fixnum? x) #f]
         [(sys:bignum? x) #f]
         [(sys:ratnum? x) #f]
+        [(sys:compnum? x) #f]
         [else 
          (die 'inexact? "not a number" x)])))
 
@@ -141,6 +156,7 @@
         [(sys:fixnum? x) #t]
         [(sys:bignum? x) #t]
         [(sys:ratnum? x) #t]
+        [(sys:compnum? x) #t]
         [else 
          (die 'finite? "not a number" x)])))
 
@@ -151,6 +167,7 @@
         [(sys:fixnum? x) #f]
         [(sys:bignum? x) #f]
         [(sys:ratnum? x) #f]
+        [(sys:compnum? x) #f]
         [else 
          (die 'infinite? "not a number" x)])))
 
@@ -161,6 +178,7 @@
         [(sys:fixnum? x) #f]
         [(sys:bignum? x) #f]
         [(sys:ratnum? x) #f]
+        [(sys:compnum? x) #f]
         [else 
          (die 'nan? "not a number" x)])))
 

scheme/last-revision

@@ -1 +1 @@
-1480
+1481

scheme/makefile.ss

@@ -252,6 +252,7 @@
     [$transc     (ikarus system $transcoders)          #f     #t]
     [$fx         (ikarus system $fx)                   #f     #t]
     [$rat        (ikarus system $ratnums)              #f     #t]
+    [$comp       (ikarus system $compnums)             #f     #t]
     [$symbols    (ikarus system $symbols)              #f     #t]
     [$structs    (ikarus system $structs)              #f     #t]
     ;[$ports      (ikarus system $ports)                #f     #t]
@@ -314,6 +315,7 @@
     [sub1                                        i]
     [bignum?                                     i]
     [ratnum?                                     i]
+    [compnum?                                    i]
     [flonum-parts                                i]
     [flonum-bytes                                i]
     [quotient+remainder                          i]
@@ -454,6 +456,9 @@
     [$make-ratnum                                $rat]
     [$ratnum-n                                   $rat]
     [$ratnum-d                                   $rat]
+    [$make-compnum                               $comp]
+    [$compnum-real                               $comp]
+    [$compnum-imag                               $comp]
     [$make-vector                                $vectors]
     [$vector-length                              $vectors]
     [$vector-ref                                 $vectors]
@@ -696,6 +701,7 @@
     [magnitude                                   i r ba se]
     [make-polar                                  i r ba se]
     [make-rectangular                            i r ba se]
+    [$make-rectangular                           $comp]
     [make-string                                 i r ba se]
     [make-vector                                 i r ba se]
     [map                                         i r ba se]

scheme/pass-specify-rep-primops.ss

@@ -1083,6 +1083,34 @@
 
 /section)
 
+(section ;;; complnums
+
+(define-primop compnum? safe
+  [(P x) (sec-tag-test (T x) vector-mask vector-tag #f compnum-tag)]
+  [(E x) (nop)])
+
+(define-primop $make-compnum unsafe
+  [(V real imag)
+   (with-tmp ([x (prm 'alloc (K (align compnum-size)) (K vector-tag))])
+     (prm 'mset x (K (- vector-tag)) (K compnum-tag))
+     (prm 'mset x (K (- disp-compnum-real vector-tag)) (T real))
+     (prm 'mset x (K (- disp-compnum-imag vector-tag)) (T imag))
+     x)]
+  [(P str) (K #t)]
+  [(E str) (nop)])
+
+
+(define-primop $compnum-real unsafe
+  [(V x) (prm 'mref (T x) (K (- disp-compnum-real vector-tag)))])
+
+(define-primop $compnum-imag unsafe
+  [(V x) (prm 'mref (T x) (K (- disp-compnum-imag vector-tag)))])
+
+/section)
+
+
+
+
 (section ;;; generic arithmetic
 
 (define (non-fixnum? x)

src/ikarus-collect.c

@@ -1224,6 +1224,18 @@ add_object_proc(gc_t* gc, ikptr x)
       ref(y, disp_ratnum_den-vector_tag) = add_object(gc, den, "den");
       return y;
     }
+    else if(fst == compnum_tag){
+      ikptr y = gc_alloc_new_data(compnum_size, gc) + vector_tag;
+      ikptr rl = ref(x, disp_compnum_real-vector_tag);
+      ikptr im = ref(x, disp_compnum_imag-vector_tag);
+      ref(x, -vector_tag) = forward_ptr;
+      ref(x, wordsize-vector_tag) = y;
+      ref(y, -vector_tag) = fst;
+      ref(y, disp_compnum_real-vector_tag) = add_object(gc, rl, "real");
+      ref(y, disp_compnum_imag-vector_tag) = add_object(gc, im, "imag");
+      return y;
+    }
+
     else {
       fprintf(stderr, "unhandled vector with fst=0x%016lx\n",
                (long int)fst);

src/ikarus-data.h

@@ -391,6 +391,12 @@ ikptr ik_safe_alloc(ikpcb* pcb, int size);
 #define disp_ratnum_unused  (3 * wordsize)
 #define ratnum_size         (4 * wordsize)
 
+#define compnum_tag           ((ikptr) 0x37)
+#define disp_compnum_real     (1 * wordsize)
+#define disp_compnum_imag     (2 * wordsize)
+#define disp_compnum_unused   (3 * wordsize)
+#define compnum_size          (4 * wordsize)
+
 #define ik_eof_p(x) ((x) == ik_eof_object)
 #define page_index(x) (((unsigned long int)(x)) >> pageshift)