From c8eb73e987eef935d0d0ca1fc1e02f0ea726bd8a Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
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))
+