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

* Added get-line. (answers to bug 160663)

This commit is contained in:
Abdulaziz Ghuloum 2007-11-07 11:00:39 -05:00
parent 1b103a4ab8
commit e75bd7e33c
7 changed files with 57 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.orig
View File

Binary file not shown.

29
scheme/ikarus.io-primitives.ss
View File

@ -18,7 +18,7 @@
(export read-char unread-char peek-char write-char write-byte newline
port-name input-port-name output-port-name
close-input-port reset-input-port!
flush-output-port close-output-port)
flush-output-port close-output-port get-line)
(import
(ikarus system $io)
(ikarus system $fx)
@ -27,7 +27,7 @@
write-byte
newline port-name input-port-name output-port-name
close-input-port reset-input-port! flush-output-port
close-output-port))
close-output-port get-line))
(define write-char
(case-lambda
@ -143,5 +143,28 @@
[(p)
(if (output-port? p)
($flush-output-port p)
(error 'flush-output-port "not an output-port" p))])))
(error 'flush-output-port "not an output-port" p))]))
(define (get-line p)
(define (get-it p)
(let f ([p p] [n 0] [ac '()])
(let ([x ($read-char p)])
(cond
[(eqv? x #\newline)
(make-it n ac)]
[(eof-object? x)
(if (null? ac) x (make-it n ac))]
[else (f p (+ n 1) (cons x ac))]))))
(define (make-it n revls)
(let f ([s (make-string n)] [i (- n 1)] [ls revls])
(cond
[(pair? ls)
(string-set! s i (car ls))
(f s (- i 1) (cdr ls))]
[else s])))
(if (input-port? p)
(get-it p)
(error 'get-line "not an input port" p)))
)

2
scheme/makefile.ss
View File

@ -1047,7 +1047,7 @@
[get-bytevector-some r ip]
[get-char r ip]
[get-datum r ip]
[get-line r ip]
[get-line i r ip]
[get-string-all r ip]
[get-string-n r ip]
[get-string-n! r ip]

5
scheme/run-tests.ss
View File

@ -26,7 +26,9 @@
(tests bignums)
(tests fxcarry)
(tests bignum-to-flonum)
(tests string-to-number))
(tests string-to-number)
(tests input-ports)
)
(define (test-exact-integer-sqrt)
(define (f i j inc)
@ -52,4 +54,5 @@
(test-fxcarry)
(test-lists)
(test-hashtables)
(test-input-ports)
(printf "Happy Happy Joy Joy\n")

7
scheme/tests/bytevectors.ss
View File

@ -299,6 +299,13 @@
(reverse (bytevector->u8-list v1)))])
(bytevector-ieee-double-ref v2 0 'big)))]
[(lambda (x) (= x 17.0))
(let ([v1 (make-bytevector 8)])
(bytevector-ieee-double-set! v1 0 17.0 'big)
(let ([v2 (u8-list->bytevector
(reverse (bytevector->u8-list v1)))])
(bytevector-ieee-double-ref v2 0 'little)))]
))

16
scheme/tests/input-ports.ss Normal file
View File

@ -0,0 +1,16 @@
(library (tests input-ports)
(export test-input-ports)
(import (ikarus) (tests framework))
(define-tests test-input-ports
[eof-object?
(get-line (open-input-string ""))]
[(lambda (x) (equal? x "abcd"))
(get-line (open-input-string "abcd"))]
[(lambda (x) (equal? x ""))
(get-line (open-input-string "\nabcd"))]
[(lambda (x) (equal? x "abcd"))
(get-line (open-input-string "abcd\nefg"))]))

6
scheme/todo-r6rs.ss
View File

@ -377,8 +377,8 @@
[bytevector-fill! C bv]
[bytevector-ieee-double-native-ref C bv]
[bytevector-ieee-double-native-set! C bv]
[bytevector-ieee-double-ref S bv]
[bytevector-ieee-double-set! S bv]
[bytevector-ieee-double-ref C bv]
[bytevector-ieee-double-set! C bv]
[bytevector-ieee-single-native-ref S bv]
[bytevector-ieee-single-native-set! S bv]
[bytevector-ieee-single-ref S bv]
@ -570,7 +570,7 @@
[get-bytevector-some S ip]
[get-char S ip]
[get-datum S ip]
[get-line S ip]
[get-line C ip]
[get-string-all S ip]
[get-string-n S ip]
[get-string-n! S ip]