55 lines
1.3 KiB
Scheme
55 lines
1.3 KiB
Scheme
|
; Copyright (c) 1994 by Richard Kelsey. See file COPYING.
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
(define (xwrite-string string out)
|
||
|
|
(let ((len (string-length string)))
|
||
|
|
(do ((i 0 (+ i 1)))
|
||
|
|
((>= i len))
|
||
|
|
(write-char (string-ref string (- len (+ i 1))) out))
|
||
|
|
(newline out)))
|
||
|
|
|
||
|
|
(define (write-string string out)
|
||
|
|
(let ((len (string-length string)))
|
||
|
|
(do ((i 0 (+ i 1)))
|
||
|
|
((>= i len))
|
||
|
|
(write-char (string-ref string i) out))
|
||
|
|
(newline out)))
|
||
|
|
|
||
|
|
(define a-string "Hello sailor...")
|
||
|
|
|
||
|
|
(define (test)
|
||
|
|
(let* ((in (current-input-port))
|
||
|
|
(out (current-output-port))
|
||
|
|
(len (ashr (read-number in) 2))
|
||
|
|
(string (make-string len)))
|
||
|
|
(let loop ((i 0))
|
||
|
|
(if (< i len)
|
||
|
|
(ps-read-char in
|
||
|
|
(lambda (ch)
|
||
|
|
(string-set! string i ch)
|
||
|
|
(loop (+ i 1)))
|
||
|
|
(lambda ()
|
||
|
|
(unassigned)))))
|
||
|
|
(write-string string out)
|
||
|
|
(xwrite-string string out)
|
||
|
|
(deallocate string)
|
||
|
|
(write-string a-string out)
|
||
|
|
(xwrite-string a-string out)))
|
||
|
|
|
||
|
|
(define (read-number port)
|
||
|
|
(let loop ((r 0))
|
||
|
|
(ps-read-char port
|
||
|
|
(lambda (ch)
|
||
|
|
(cond ((digit? ch)
|
||
|
|
(loop (+ (- (char->ascii ch) (char->ascii #\0))
|
||
|
|
(* r 10))))
|
||
|
|
(else r)))
|
||
|
|
(lambda () 0))))
|
||
|
|
|
||
|
|
(define (digit? ch)
|
||
|
|
(let ((ch (char->ascii ch)))
|
||
|
|
(and (>= ch (char->ascii #\0))
|
||
|
|
(<= ch (char->ascii #\9)))))
|
||
|
|
|