ikarus.reader is now loadable separately.

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

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)])
+       (for-each eval-proc (read-script-source-file x))]))
-         (let ([x (read-initial p)])
-           (unless (eof-object? x)
-             (eval-proc x)
-             (read-and-eval p eval-proc)))
-         (close-input-port p))]))
   (define load-r6rs-top-level
     (lambda (x how)
       (let ([prog (read-script-source-file x)])

scheme/ikarus.numerics.ss

@@ -2294,12 +2294,21 @@
       (cond
         [(flonum? x) (foreign-call "ikrt_fl_sqrt" x)]
         [(fixnum? x)
-         (when ($fx< x 0) 
+         (cond
-           (die 'sqrt "complex results not supported" x))
+           [($fx< x 0)
-         (foreign-call "ikrt_fx_sqrt" x)]
+            (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)
-         (unless ($bignum-positive? x) 
+         (cond
-           (die 'sqrt "complex results not supported" x))
+           [($bignum-positive? x)
             (let-values ([(s r) (exact-integer-sqrt x)])
               (cond
                 [(eq? r 0) s]
@@ -2315,6 +2324,12 @@
                              ($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)])))
 )
-
-
-

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 <http://www.gnu.org/licenses/>.
+
+
+(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))]))))))))
+)

scheme/ikarus.reader.ss

@@ -14,19 +14,17 @@
 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 
-(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 
+          annotation-stripped)
-          read-library-source-file read-script-source-file)
   (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))]))))))))
 )
 
+          
+

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<=? char-ci>? char-ci>=?
       string-ci=?  string-ci<?  string-ci<=?  string-ci>?

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

scheme/last-revision

@@ -1 +1 @@
-1483
+1484

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]

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