#lang scheme/base

;; Minimalistic REPL for a string evaluator like 'forth-command.

 scheme/control  ;; for 'prompt so errors don't kill the REPL
 ;; readline/rep ;; readline command line editing (not standard on XP, so commented out)
(provide repl

(define repl-command-hook
   (lambda (interpret str)
     (interpret str)
     (interpret "OK"))))

(define (repl-break-exit command str)
  (printf "\nCommand \"~a\" interrupted.\nTrying cold restart...\n" str)
  (command "cold")
  (let ((ok (with-timeout 1 (lambda () (command "OK")))))
    (unless ok (printf "Timed out.\n"))

(define (repl-break command str)
  (printf "\nCommand \"~a\" interrupted.\n" str)

(define repl-break-hook
  (make-parameter repl-break))

(define (with-timeout sec thunk)
  (define retv #t)
  (define (watchdog)
    (sleep sec)
    (set! retv #f))
  (let ((ok (thread thunk))
        (timeout (thread watchdog)))
    (sync ok timeout)
    (kill-thread ok)
    (kill-thread timeout)

(define (repl command)

  ;; User break while reading a line is ignored.
  (define (_read-line)
        ((exn:break? (lambda _ "")))

  ;; User break while running a command will reset the target device
  ;; using the "cold" command, which triggers external reset circuitry
  ;; if available.

  (define (_command cmd)
           (lambda _ ((repl-break-hook) command cmd))))
       ((repl-command-hook) command cmd)

  ;; Main console loop
  (define (console)
    (let ((cmd (_read-line)))
      (unless (eof-object? cmd)
        (when (_command cmd)

  ;; Start.
  (with-handlers ((void void))
    (file-stream-buffer-mode (current-output-port) 'none))
  (printf "Press ctrl-D to quit.\n")
  (when (_command "")  ;; first "OK"
  (printf "Dada.\n")