From c8eb73e987eef935d0d0ca1fc1e02f0ea726bd8a Mon Sep 17 00:00:00 2001 From: Abdulaziz Ghuloum Date: Wed, 28 Nov 2007 20:12:09 -0500 Subject: [PATCH] added read-exprs.ss script to ikarus.dev/lab --- lab/read-exprs.ss | 71 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 71 insertions(+) create mode 100755 lab/read-exprs.ss diff --git a/lab/read-exprs.ss b/lab/read-exprs.ss new file mode 100755 index 0000000..7a42136 --- /dev/null +++ b/lab/read-exprs.ss @@ -0,0 +1,71 @@ +#!/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)) +