diff --git a/scheme/ikarus.fasl.ss b/scheme/ikarus.fasl.ss index 7b05b2c..aa440f6 100644 --- a/scheme/ikarus.fasl.ss +++ b/scheme/ikarus.fasl.ss @@ -336,6 +336,34 @@ (vector-set! fields i (list (if field-mutable? 'mutable 'immutable) field-name)) (f (+ i 1)))])))] + [(#\b) ;;; bignum + (let ([i (read-int p)]) + (let ([bytes (if (< i 0) (- i) i)]) + (let ([bv (get-bytevector-n p bytes)]) + (let ([n (bytevector-uint-ref bv 0 'little bytes)]) + (let ([n (if (< i 0) (- n) n)]) + (when m (put-mark m n)) + n)))))] + [(#\f) ;;; flonum + (let () + (import (ikarus system $flonums)) + (let ([x ($make-flonum)]) + ($flonum-set! x 7 (get-u8 p)) + ($flonum-set! x 6 (get-u8 p)) + ($flonum-set! x 5 (get-u8 p)) + ($flonum-set! x 4 (get-u8 p)) + ($flonum-set! x 3 (get-u8 p)) + ($flonum-set! x 2 (get-u8 p)) + ($flonum-set! x 1 (get-u8 p)) + ($flonum-set! x 0 (get-u8 p)) + (when m (put-mark m x)) + x))] + [(#\r) ;;; ratnum + (let* ([den (read)] + [num (read)]) + (let ([x (/ num den)]) + (when m (put-mark m x)) + x))] [else (die who "Unexpected char as a fasl object header" h)]))) (read)) diff --git a/scheme/last-revision b/scheme/last-revision index 4b486a6..26e58c7 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1410 +1411 diff --git a/scheme/run-tests.ss b/scheme/run-tests.ss index 9c1051e..4a48fc1 100755 --- a/scheme/run-tests.ss +++ b/scheme/run-tests.ss @@ -35,6 +35,7 @@ (tests io) (tests case-folding) (tests sorting) + (tests fasl) ) (define (test-exact-integer-sqrt) @@ -77,4 +78,5 @@ (test-bitwise-bit-count) (test-io) (test-sorting) +(test-fasl) (printf "Happy Happy Joy Joy\n") diff --git a/scheme/tests/fasl.ss b/scheme/tests/fasl.ss new file mode 100644 index 0000000..950914a --- /dev/null +++ b/scheme/tests/fasl.ss @@ -0,0 +1,32 @@ + +(library (tests fasl) + (export test-fasl) + (import (ikarus) (tests framework)) + + (define (test x) + (printf "test-fasl ~s\n" x) + (let-values ([(p e) (open-bytevector-output-port)]) + (fasl-write x p) + (let ([bv (e)]) + (let ([y (fasl-read (open-bytevector-input-port bv))]) + (unless (equal? x y) + (error 'test-fasl "failed/expected" y x)))))) + + (define (test-fasl) + (test 12) + (test -12) + (test 0) + (test #t) + (test #f) + (test '()) + (test 'hello) + (test "Hello") + (test '(Hello There)) + (test 3498798327498723894789237489324) + (test -3498798327498723894789237489324) + (test 2389478923749872389723894/23498739874892379482374) + (test -2389478923749872389723894/23498739874892379482374))) + + + +