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

ikarus.reader is now loadable separately.

This commit is contained in:
Abdulaziz Ghuloum 2008-05-20 23:21:37 -07:00
parent ebcc042ea1
commit 0a6df79e3b
11 changed files with 137 additions and 92 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.

6
scheme/ikarus.io.ss
View File

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

9
scheme/ikarus.load.ss
View File

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

127
scheme/ikarus.numerics.ss
View File

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

46
scheme/ikarus.reader.annotated.ss Normal file
View File

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

32
scheme/ikarus.reader.ss
View File

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

1
scheme/ikarus.unicode-data.ss
View File

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

2
scheme/ikarus.writer.ss
View File

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

2
scheme/last-revision
View File

@ -1 +1 @@
1483
1484

2
scheme/makefile.ss
View File

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

2
scheme/psyntax.compat.ss
View File

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