edward

  1;;>| Read–Eval–Print Loop
  2;;>
  3;;> REPL abstraction which provides a read-eval-print loop that
  4;;> continously reads data from standard input and parses this
  5;;> input data using provided parser combinators. The REPL
  6;;> operates on a [parse stream](#section-parse-streams) internally.
  7
  8;;> Create an new REPL instance with the given input `prompt` string.
  9
 10(define (make-repl prompt)
 11  (let ((prompt? (not (empty-string? prompt))))
 12    (%make-repl
 13      (if prompt? prompt "*")
 14      prompt?
 15      (make-parse-stream "stdin"
 16        (let ((stat (file-stat fileno/stdin)))
 17          ;; Normally, we use our custom `file-read-char` to read from stdin.
 18          ;; This procedure builds upon CHICKEN's `file-read` (i.e., read(3)) to
 19          ;; be able to read beyond end-of-file. Sadly, currently this function
 20          ;; doesn't do any internal buffering thus it will emit a lot of system
 21          ;; calls. However, when stdin is a regular file, we cannot read beyond
 22          ;; end-of-file anyhow so might as well use the buffered `read-char`
 23          ;; provided by CHICKEN by passing a port, instead of a fileno here.
 24          (if (is-regular? (vector-ref stat 1))
 25            (current-input-port)
 26            fileno/stdin)))
 27      0)))
 28
 29(define (repl-state-set! repl source index)
 30  (repl-stream-set! repl source)
 31  (repl-index-set! repl index))
 32
 33;;> Record type representing the REPL.
 34(define-record-type Read-Eval-Print-Loop
 35  (%make-repl prompt-str prompt? stream index)
 36  ;;> Predicate which returns true if the given object was created using [make-repl](#make-repl).
 37  repl?
 38  ;; Prompt string used for input prompt.
 39  (prompt-str repl-prompt-str)
 40  ;; Whether the prompt should be shown or hidden.
 41  (prompt?
 42    ;;> Predicate which returns true if the prompt should be shown.
 43    repl-prompt?
 44
 45    ;;> Change prompt visibility, a truth value means the prompt is shown.
 46    repl-set-prompt!)
 47  ;; Parse stream used for the parser combinator.
 48  (stream repl-stream repl-stream-set!)
 49  ;; Last index in parse stream.
 50  (index repl-index repl-index-set!))
 51
 52;; Skip all buffered chunks, i.e. next read will block.
 53
 54(define (repl-skip-chunks! repl)
 55  (define (%repl-skip-chunks! source i)
 56    (if (>= (+ i 1) (vector-length (parse-stream-buffer source)))
 57      (%repl-skip-chunks! (parse-stream-tail source) i) ;; go to last chunck
 58      (values
 59        source
 60        ;; inc to go beyond last char.
 61        (inc (parse-stream-max-char source)))))
 62
 63  (let-values (((source i)
 64                (%repl-skip-chunks!
 65                  (repl-stream repl)
 66                  (repl-index repl))))
 67    (repl-state-set! repl source i)))
 68
 69(define (repl-parse repl f sk fk)
 70  (define (stream-next-line source idx)
 71    (let* ((next-index  (parse-stream-next-index source idx))
 72           (next-source (parse-stream-next-source source idx))
 73           (char        (parse-stream-ref source idx)))
 74      (if (or (eof-object? char) (char=? char #\newline))
 75        (cons next-source next-index) ;; first index after newline/eof
 76        (stream-next-line
 77          next-source
 78          next-index))))
 79
 80  (call-with-parse f
 81    (repl-stream repl)
 82    (repl-index repl)
 83    (lambda (r s i fk)
 84      (repl-state-set! repl s i)
 85      (sk (repl-line repl i) r))
 86    (lambda (s i reason)
 87      (let ((line (repl-line repl i))
 88            (next (stream-next-line (repl-stream repl) i)))
 89        (repl-state-set! repl (car next) (cdr next))
 90        (fk line reason)))))
 91
 92(define (repl-line repl index)
 93  (let ((s (repl-stream repl)))
 94    (inc ;; XXX: For some reason line start at zero.
 95      (+
 96        (parse-stream-line s)
 97        (car (parse-stream-count-lines s (parse-stream-max-char s)))))))
 98
 99;;> Start the REPL given by `repl`, and continuously parse input using
100;;> the provided parser `f`. Successfully parsed input is passed to
101;;> the success continuation `sk`, which receives the line number and
102;;> parser result as procedure arguments. If the parser failed for the
103;;> current input, the failure continuation `fk` is invoked. This
104;;> continuation receives the line number and failure reason as
105;;> procedure arguments. Lastly, an interrupt continuation must
106;;> also be provided which is invoked on `SIGINT`. This continuation
107;;> is not passed any arguments.
108
109(define (repl-run repl f sk fk ik)
110  (when (repl-prompt? repl)
111    (display (repl-prompt-str repl))
112    (flush-output-port))
113
114  ;; Allow parsing itself (especially of input mode commands) to be
115  ;; interrupted by SIGINT signals. See "Asynchronous Events" in ed(1).
116  (call-with-current-continuation
117    (lambda (k)
118      (set-signal-handler!
119        signal/int
120        (lambda (signum)
121          (ik)
122          (repl-skip-chunks! repl)
123          (k #f)))
124
125        (begin
126          (repl-parse repl f sk fk)
127          (k #f))))
128
129  (repl-run repl f sk fk ik))
130
131;;> Run a parser interactively within the REPL. That is, deviate from
132;;> the standard REPL parser and instead parse the next input line
133;;> with the given parser `f`. On success, returns the result of `f`
134;;> otherwise, invokes the provided failure continuation `fk`.
135
136(define (repl-interactive repl f fk)
137  (repl-parse repl f (lambda (line value) value) fk))