diff --git a/scheme/ikarus.boot.prebuilt b/scheme/ikarus.boot.prebuilt
index 8bdf635..9b69bf9 100644
Binary files a/scheme/ikarus.boot.prebuilt and b/scheme/ikarus.boot.prebuilt differ
diff --git a/scheme/ikarus.io.ss b/scheme/ikarus.io.ss
index 96c4a5c..835c722 100644
--- a/scheme/ikarus.io.ss
+++ b/scheme/ikarus.io.ss
@@ -70,8 +70,8 @@
accept-connection accept-connection-nonblocking
close-tcp-server-socket
register-callback
- input-socket-buffer-size output-socket-buffer-size
- )
+ input-socket-buffer-size output-socket-buffer-size)
+
(import
@@ -2377,6 +2377,8 @@
[else (die who "invalid argument" what)]))
+
+
;(set-fd-nonblocking 0 'init '*stdin*)
)
diff --git a/scheme/ikarus.load.ss b/scheme/ikarus.load.ss
index 46eae70..b328200 100644
--- a/scheme/ikarus.load.ss
+++ b/scheme/ikarus.load.ss
@@ -22,7 +22,7 @@
(only (psyntax library-manager)
serialize-all current-precompiled-library-loader)
(only (psyntax expander) compile-r6rs-top-level)
- (only (ikarus reader) read-initial read-script-source-file))
+ (only (ikarus.reader.annotated) read-script-source-file))
(define-struct serialized-library (contents))
@@ -81,12 +81,7 @@
(die 'load "not a string" x))
(unless (procedure? eval-proc)
(die 'load "not a procedure" eval-proc))
- (let ([p (open-input-file x)])
- (let ([x (read-initial p)])
- (unless (eof-object? x)
- (eval-proc x)
- (read-and-eval p eval-proc)))
- (close-input-port p))]))
+ (for-each eval-proc (read-script-source-file x))]))
(define load-r6rs-top-level
(lambda (x how)
(let ([prog (read-script-source-file x)])
diff --git a/scheme/ikarus.numerics.ss b/scheme/ikarus.numerics.ss
index 05d8016..e0292d1 100644
--- a/scheme/ikarus.numerics.ss
+++ b/scheme/ikarus.numerics.ss
@@ -2294,27 +2294,42 @@
(cond
[(flonum? x) (foreign-call "ikrt_fl_sqrt" x)]
[(fixnum? x)
- (when ($fx< x 0)
- (die 'sqrt "complex results not supported" x))
- (foreign-call "ikrt_fx_sqrt" x)]
- [(bignum? x)
- (unless ($bignum-positive? x)
- (die 'sqrt "complex results not supported" x))
- (let-values ([(s r) (exact-integer-sqrt x)])
- (cond
- [(eq? r 0) s]
- [else
- (let ([v (sqrt (inexact x))])
- ;;; could the [dropped] residual ever affect the answer?
- (cond
- [(infinite? v)
- (if (bignum? s)
- (foreign-call "ikrt_bignum_to_flonum"
- s
- 1 ;;; round up in case of a tie
- ($make-flonum))
- (inexact s))]
- [else v]))]))]
+ (cond
+ [($fx< x 0)
+ (let-values ([(s r) (exact-integer-sqrt (- x))])
+ (cond
+ [(eq? r 0) ($make-rectangular 0 s)]
+ [else
+ (error 'sqrt "inexact complex numbers not supported yet")]))]
+ [else
+ (let-values ([(s r) (exact-integer-sqrt x)])
+ (cond
+ [(eq? r 0) s]
+ [else (foreign-call "ikrt_fx_sqrt" x)]))])]
+ [(bignum? x)
+ (cond
+ [($bignum-positive? x)
+ (let-values ([(s r) (exact-integer-sqrt x)])
+ (cond
+ [(eq? r 0) s]
+ [else
+ (let ([v (sqrt (inexact x))])
+ ;;; could the [dropped] residual ever affect the answer?
+ (cond
+ [(infinite? v)
+ (if (bignum? s)
+ (foreign-call "ikrt_bignum_to_flonum"
+ s
+ 1 ;;; round up in case of a tie
+ ($make-flonum))
+ (inexact s))]
+ [else v]))]))]
+ [else
+ (let-values ([(s r) (exact-integer-sqrt (- x))])
+ (cond
+ [(eq? r 0) (make-rectangular 0 s)]
+ [else
+ (error 'sqrt "inexact complex numbers not supported yet")]))])]
[(ratnum? x)
;;; FIXME: incorrect as per bug 180170
(/ (sqrt ($ratnum-n x)) (sqrt ($ratnum-d x)))]
@@ -2887,33 +2902,6 @@
)
-(library (ikarus complexnums)
- (export real-part imag-part magnitude)
- (import (except (ikarus) real-part imag-part magnitude))
- ;;; stub implementation since we don't have a way of
- ;;; constructing complex numbers yet.
-
- (define magnitude
- (lambda (x)
- (if (number? x)
- (abs x)
- (die 'magnitude "not a number" x))))
-
- (define real-part
- (lambda (x)
- (if (number? x)
- x
- (die 'real-part "not a number" x))))
-
- (define imag-part
- (lambda (x)
- (cond
- [(fixnum? x) 0]
- [(bignum? x) 0]
- [(ratnum? x) 0]
- [(flonum? x) 0.0]
- [else
- (die 'imag-part "not a number" x)]))))
@@ -3630,9 +3618,11 @@
(library (ikarus complex-numbers)
- (export make-rectangular $make-rectangular)
+ (export make-rectangular $make-rectangular
+ real-part imag-part magnitude)
(import
- (except (ikarus) make-rectangular)
+ (except (ikarus)
+ make-rectangular real-part imag-part magnitude)
(except (ikarus system $compnums) $make-rectangular))
(define ($make-rectangular r i)
@@ -3656,7 +3646,38 @@
($make-compnum r i)
(err i))]
[else (err r)]))
+
+ (define magnitude
+ (lambda (x)
+ (cond
+ [(or (fixnum? x) (bignum? x) (ratnum? x) (flonum? x))
+ (abs x)]
+ [(compnum? x)
+ (let ([r ($compnum-real x)]
+ [i ($compnum-imag x)])
+ (sqrt (+ (* r r) (* i i))))]
+ [else
+ (die 'magnitude "not a number" x)])))
+
+ (define real-part
+ (lambda (x)
+ (cond
+ [(fixnum? x) x]
+ [(bignum? x) x]
+ [(ratnum? x) x]
+ [(flonum? x) x]
+ [(compnum? x) ($compnum-real x)]
+ [else
+ (die 'real-part "not a number" x)])))
+
+ (define imag-part
+ (lambda (x)
+ (cond
+ [(fixnum? x) 0]
+ [(bignum? x) 0]
+ [(ratnum? x) 0]
+ [(flonum? x) 0.0]
+ [(compnum? x) ($compnum-imag x)]
+ [else
+ (die 'imag-part "not a number" x)])))
)
-
-
-
diff --git a/scheme/ikarus.reader.annotated.ss b/scheme/ikarus.reader.annotated.ss
new file mode 100644
index 0000000..d70e7cd
--- /dev/null
+++ b/scheme/ikarus.reader.annotated.ss
@@ -0,0 +1,46 @@
+;;; Ikarus Scheme -- A compiler for R6RS Scheme.
+;;; Copyright (C) 2006,2007,2008 Abdulaziz Ghuloum
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License version 3 as
+;;; published by the Free Software Foundation.
+;;;
+;;; This program is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see .
+
+
+(library (ikarus.reader.annotated)
+ (export read-library-source-file read-script-source-file)
+ (import
+ (except (ikarus) read-annotated read-script-annotated)
+ (only (ikarus.reader) read-annotated read-script-annotated)
+ (only (io-spec) open-string-input-port/id))
+
+ (define (annotated-port file-name)
+ (open-string-input-port/id
+ (with-input-from-file file-name
+ (lambda () (get-string-all (current-input-port))))
+ file-name))
+
+ (define (read-library-source-file file-name)
+ (read-annotated (annotated-port file-name)))
+
+ (define (read-script-source-file file-name)
+ (let ([p (annotated-port file-name)])
+ (let ([x (read-script-annotated p)])
+ (if (eof-object? x)
+ (begin (close-input-port p) '())
+ (cons x
+ (let f ()
+ (let ([x (read-annotated p)])
+ (cond
+ [(eof-object? x)
+ (close-input-port p)
+ '()]
+ [else (cons x (f))]))))))))
+)
diff --git a/scheme/ikarus.reader.ss b/scheme/ikarus.reader.ss
index ca4fb0d..7e35fb1 100644
--- a/scheme/ikarus.reader.ss
+++ b/scheme/ikarus.reader.ss
@@ -14,19 +14,17 @@
;;; along with this program. If not, see .
-(library (ikarus reader)
+(library (ikarus.reader)
(export read read-initial read-token comment-handler get-datum
read-annotated read-script-annotated annotation?
annotation-expression annotation-source
- annotation-stripped
- read-library-source-file read-script-source-file)
+ annotation-stripped)
(import
(ikarus system $chars)
(ikarus system $fx)
(ikarus system $pairs)
(ikarus system $bytevectors)
- (only (io-spec) open-string-input-port/id)
- (only (ikarus unicode-data) unicode-printable-char?)
+ ;(only (ikarus unicode-data) unicode-printable-char?)
(except (ikarus) read-char read read-token comment-handler get-datum
read-annotated read-script-annotated annotation?
annotation-expression annotation-source annotation-stripped))
@@ -1428,27 +1426,7 @@
(die 'comment-handler "not a procedure" x))
x)))
- (define (annotated-port file-name)
- (open-string-input-port/id
- (with-input-from-file file-name
- (lambda () (get-string-all (current-input-port))))
- file-name))
+)
- (define (read-library-source-file file-name)
- (read-annotated (annotated-port file-name)))
-
- (define (read-script-source-file file-name)
- (let ([p (annotated-port file-name)])
- (let ([x (read-script-annotated p)])
- (if (eof-object? x)
- (begin (close-input-port p) '())
- (cons x
- (let f ()
- (let ([x (read-annotated p)])
- (cond
- [(eof-object? x)
- (close-input-port p)
- '()]
- [else (cons x (f))]))))))))
- )
+
diff --git a/scheme/ikarus.unicode-data.ss b/scheme/ikarus.unicode-data.ss
index 114739e..32e85e6 100644
--- a/scheme/ikarus.unicode-data.ss
+++ b/scheme/ikarus.unicode-data.ss
@@ -34,6 +34,7 @@
(ikarus system $pairs)
(ikarus system $strings)
(except (ikarus)
+ unicode-printable-char?
char-downcase char-upcase char-titlecase char-foldcase
char-ci=? char-ci? char-ci>=?
string-ci=? string-ci?
diff --git a/scheme/ikarus.writer.ss b/scheme/ikarus.writer.ss
index 1496f47..b27b53f 100644
--- a/scheme/ikarus.writer.ss
+++ b/scheme/ikarus.writer.ss
@@ -28,7 +28,7 @@
(ikarus system $bytevectors)
(ikarus system $transcoders)
(only (ikarus.pretty-formats) get-fmt)
- (only (ikarus unicode-data) unicode-printable-char?)
+ ;(only (ikarus unicode-data) unicode-printable-char?)
(except (ikarus)
write display format printf fprintf print-error print-unicode print-graph
put-datum))
diff --git a/scheme/last-revision b/scheme/last-revision
index 2df0801..bf4a29a 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1483
+1484
diff --git a/scheme/makefile.ss b/scheme/makefile.ss
index e85dc06..8687d13 100755
--- a/scheme/makefile.ss
+++ b/scheme/makefile.ss
@@ -75,6 +75,7 @@
"ikarus.pretty-formats.ss"
"ikarus.writer.ss"
"ikarus.reader.ss"
+ "ikarus.reader.annotated.ss"
"ikarus.code-objects.ss"
"ikarus.intel-assembler.ss"
"ikarus.trace.ss"
@@ -353,6 +354,7 @@
[print-gensym i symbols]
[print-graph i]
[print-unicode i]
+ [unicode-printable-char? i]
[gensym-count i symbols]
[gensym-prefix i symbols]
[make-parameter i parameters]
diff --git a/scheme/psyntax.compat.ss b/scheme/psyntax.compat.ss
index 2940731..a458d48 100644
--- a/scheme/psyntax.compat.ss
+++ b/scheme/psyntax.compat.ss
@@ -23,7 +23,7 @@
read-library-source-file)
(import
(only (ikarus.compiler) eval-core)
- (only (ikarus reader) read-library-source-file)
+ (only (ikarus.reader.annotated) read-library-source-file)
(ikarus))