Add REPL history

scheme-core/system.scm

@@ -940,30 +940,53 @@
 (define white   7)
 (define default-color 8)
 
+(define history '())
+
+(define (history-push form values)
+  (set! history (cons (cons form values) history)))
+
+(define (history-get x proc)
+  (cond ((pair? x) (proc x))
+        ((eqv? #f x) (history-get 0 proc))
+        ((and (integer? x) (>= x 0) (< x (length history)))
+         (history-get (list-ref history x) proc))
+        (else #f)))
+
+(define (history-form (x #f))
+  (history-get x car))
+
+(define (history-value (x #f))
+  (history-get x cadr))
+
+(define (history-values (x #f))
+  (history-get x cdr))
+
+(define (history-exception (x #f))
+  #f)
+
 (define (repl)
   (define (prompt)
     (display (string-append (sgr bold (fg cyan)) "up>" (sgr) " "))
     (io.flush *output-stream*)
-    (let ((v (trycatch (read)
+    (let ((form (trycatch (read)
-                       (lambda (e) (begin (io.discardbuffer *input-stream*)
+                          (lambda (e)
-                                          (raise e))))))
+                            (io.discardbuffer *input-stream*)
+                            (raise e)))))
       (and (not (io.eof? *input-stream*))
-           (begin (trycatch (let ((V (load-process v)))
+           (let ((value #f) (exception #f))
-                              (writeln V)
+             (trycatch (begin (set! value (load-process form))
-                              (set! that V)
+                              (writeln value)
-                              #t)
+                              (set! that value))
-                            (lambda (e)
+                       (lambda (e)
-                              (top-level-exception-handler e)
+                         (set! exception e)
-                              #t))
+                         (top-level-exception-handler e)))
-                  (when (or (eqv? 'help v) (eqv? 'exit v))
+             (history-push form (list value))
-                    (newline)
+             (when (or (eqv? 'help form) (eqv? 'exit form))
-                    (displayln "Type (help) for help or (exit) to exit."))
+               (newline)
-                  #t))))
+               (displayln "Type (help) for help or (exit) to exit."))
+             #t))))
   (define (reploop)
-    (when (trycatch (prompt)
+    (when (trycatch (prompt) (lambda (e) (top-level-exception-handler e) #t))
-                    (lambda (e)
-                      (top-level-exception-handler e)
-                      #t))
       (reploop)))
   (reploop)
   (newline))