lassik
/
upscheme
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add REPL history

This commit is contained in:
Lassi Kortela 2019-08-28 14:22:08 +03:00
parent 78b663d41d
commit 0763a5df44
2 changed files with 1243 additions and 1181 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2365
scheme-boot/boot_image.h
View File

File diff suppressed because it is too large Load Diff

53
scheme-core/system.scm
View File

@ -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)
(lambda (e) (begin (io.discardbuffer *input-stream*)
(raise e))))))
(and (not (io.eof? *input-stream*))
(begin (trycatch (let ((V (load-process v)))
(writeln V)
(set! that V)
#t)
(let ((form (trycatch (read)
(lambda (e)
(top-level-exception-handler e)
#t))
(when (or (eqv? 'help v) (eqv? 'exit v))
(io.discardbuffer *input-stream*)
(raise e)))))
(and (not (io.eof? *input-stream*))
(let ((value #f) (exception #f))
(trycatch (begin (set! value (load-process form))
(writeln value)
(set! that value))
(lambda (e)
(set! exception e)
(top-level-exception-handler e)))
(history-push form (list value))
(when (or (eqv? 'help form) (eqv? 'exit form))
(newline)
(displayln "Type (help) for help or (exit) to exit."))
#t))))
(define (reploop)
(when (trycatch (prompt)
(lambda (e)
(top-level-exception-handler e)
#t))
(when (trycatch (prompt) (lambda (e) (top-level-exception-handler e) #t))
(reploop)))
(reploop)
(newline))