72 lines
2.0 KiB
Scheme
72 lines
2.0 KiB
Scheme
|
#!/usr/bin/env scheme-script
|
||
|
|
(import (ikarus) (ikarus system interrupts))
|
||
|
|
|
||
|
|
(define (prompt-and-read-exprs p)
|
||
|
|
(define (read-lines ls)
|
||
|
|
(let ([p (open-input-string
|
||
|
|
(apply string-append (reverse ls)))])
|
||
|
|
(let f ([ls '()])
|
||
|
|
(let ([x (read p)])
|
||
|
|
(cond
|
||
|
|
[(eof-object? x)
|
||
|
|
(if (null? ls)
|
||
|
|
(eof-object)
|
||
|
|
(reverse ls))]
|
||
|
|
[else (f (cons x ls))])))))
|
||
|
|
(define (read-lines-maybe ls)
|
||
|
|
(call/cc
|
||
|
|
(lambda (k)
|
||
|
|
(with-exception-handler
|
||
|
|
(lambda (cn)
|
||
|
|
(cond
|
||
|
|
[(interrupted-condition? cn)
|
||
|
|
(raise-continuable cn)]
|
||
|
|
[else (k #f)]))
|
||
|
|
(lambda ()
|
||
|
|
(read-lines ls))))))
|
||
|
|
(display "> " (console-output-port))
|
||
|
|
(let f ([lns '()])
|
||
|
|
(let ([x (get-line p)])
|
||
|
|
(cond
|
||
|
|
[(eof-object? x)
|
||
|
|
(read-lines lns)]
|
||
|
|
[else
|
||
|
|
(let ([lns (cons x lns)])
|
||
|
|
(or (read-lines-maybe lns)
|
||
|
|
(f lns)))]))))
|
||
|
|
|
||
|
|
(printf "Experimental prompt\n")
|
||
|
|
(printf "This just echos the output pretty-printed\n\n")
|
||
|
|
(let f ()
|
||
|
|
(define (try k f)
|
||
|
|
(with-exception-handler
|
||
|
|
(lambda (cn)
|
||
|
|
(flush-output-port (current-error-port))
|
||
|
|
(flush-output-port (current-output-port))
|
||
|
|
(reset-input-port! (current-input-port))
|
||
|
|
(newline (console-output-port))
|
||
|
|
(unless (interrupted-condition? cn)
|
||
|
|
(fprintf (console-output-port)
|
||
|
|
"Error while reading expression\n")
|
||
|
|
(print-condition cn (console-output-port)))
|
||
|
|
(k))
|
||
|
|
f))
|
||
|
|
(call/cc
|
||
|
|
(lambda (k)
|
||
|
|
(let ([x
|
||
|
|
(try k
|
||
|
|
(lambda ()
|
||
|
|
(prompt-and-read-exprs
|
||
|
|
(current-input-port))))])
|
||
|
|
(cond
|
||
|
|
[(eof-object? x)
|
||
|
|
(newline (console-output-port))
|
||
|
|
(exit)]
|
||
|
|
[else
|
||
|
|
(for-each
|
||
|
|
(lambda (x)
|
||
|
|
(pretty-print x (console-output-port)))
|
||
|
|
x)]))))
|
||
|
|
(f))
|
||
|
|
|