ikarus.reader is now loadable separately.
This commit is contained in:
parent
ebcc042ea1
commit
0a6df79e3b
Binary file not shown.
|
@ -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*)
|
||||
)
|
||||
|
||||
|
|
|
@ -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)])
|
||||
|
|
|
@ -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)])))
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -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))]))))))))
|
||||
)
|
|
@ -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))]))))))))
|
||||
)
|
||||
|
||||
|
||||
|
|
|
@ -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>?
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -1 +1 @@
|
|||
1483
|
||||
1484
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue