conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

- Added complex numbers representation (exact complex only). 

- Added make-rectangular.
- Added the ability to display complex numbers.
This commit is contained in:
Abdulaziz Ghuloum 2008-05-18 20:39:41 -07:00
parent da7cedfe64
commit 82140f87ba
10 changed files with 144 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.prebuilt
View File

Binary file not shown.

7
scheme/ikarus.compiler.ss
View File

@ -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)

31
scheme/ikarus.not-yet-implemented.ss
View File

@ -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
port-has-port-position? port-has-set-port-position!?
port-position set-port-position! make-eqv-hashtable
hashtable-hash-function make-hashtable
hashtable-equivalence-function equal-hash
string-downcase string-normalize-nfc string-normalize-nfd
string-normalize-nfkc string-normalize-nfkd string-titlecase
string-upcase))
open-file-input/output-port
output-port-buffer-mode
port-has-set-port-position!? set-port-position!
port-has-port-position? port-position
))

45
scheme/ikarus.numerics.ss
View File

@ -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)]))
)

30
scheme/ikarus.predicates.ss
View File

@ -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)])))

2
scheme/last-revision
View File

@ -1 +1 @@
1480
1481

6
scheme/makefile.ss
View File

@ -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]

28
scheme/pass-specify-rep-primops.ss
View File

@ -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)

12
src/ikarus-collect.c
View File

@ -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);

6
src/ikarus-data.h
View File

@ -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)