maggicl/DrBrainf-ck
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Added nice errror handling in cli and gui

Browse source
This commit is contained in:
Claudio Maggioni 2018-12-12 20:34:41 +01:00
parent 17cbac57eb
commit f5491a2b44
3 changed files with 81 additions and 53 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
cli.rkt
View file

@ -35,6 +35,9 @@
; Given the fineal prog-state, prints the results according to the flags.
(define (end-print p)
(display (prog-state-output p))
(if (eq? (prog-state-error p) #f)
(display (string-append "\n" (prog-state-error p)))
(void))
(if (show-tape) (display-status p) (void)))
; display-trace: ProgState -> _

11
gui.rkt
View file

@ -105,7 +105,8 @@
(execute-content
(lambda (ps)
(update-state-gui ps)
(send RUN-OUTPUT set-field-background end-col))))
(send RUN-OUTPUT set-field-background
(if (eq? (prog-state-error ps) #f) end-col err-col)))))
; run-step: Button ControlEvent -> Nothing
; Given the step button pressed and an event, runs the matching step (step or
@ -124,10 +125,11 @@
; the contents of that prog-state.
(define (update-state-gui ps)
(define out (prog-state-output ps))
(define err (prog-state-error ps))
; update data tape inspector
(make-tape-cells ps)
; set output and change color to ended
(send RUN-OUTPUT set-value out))
; set output
(send RUN-OUTPUT set-value (string-append out "\n" (if (eq? err #f) "" err))))
; The tape panel
(define BUTTON-PANEL
@ -294,6 +296,9 @@
; Output completed color
(define end-col (make-object color% 200 250 200))
; Error color
(define err-col (make-object color% 250 200 200))
; The tape panel
(define tape-panel
(new horizontal-panel%

74
interpreter.rkt
View file

@ -134,12 +134,20 @@
(define (error-code sym)
(cond [(eq? sym #f) ""]
[(symbol=? sym 'error1)
"ERROR: '<' not working. Cannot access negative tape positions."]))
"ERROR: '<' not working. Cannot access negative tape positions."]
[(symbol=? sym 'error2)
"ERROR: '[' not working. Matching parenthesis not found."]
[(symbol=? sym 'error3)
"ERROR: ']' not working. Matching parenthesis not found."]))
; Tests for error-code
(check-equal? (error-code #f) "")
(check-equal? (error-code 'error1)
"ERROR: '<' not working. Cannot access negative tape positions.")
(check-equal? (error-code 'error2)
"ERROR: '[' not working. Matching parenthesis not found.")
(check-equal? (error-code 'error3)
"ERROR: ']' not working. Matching parenthesis not found.")
; exec-add1: ProgState -> ProgState
; Given a ProgState, returns a new ProgState with the + instruction executed
@ -150,7 +158,7 @@
(prog-state-output w)
(prog-state-program w)
(add1 (prog-state-ip w))
(prog-state-error w)))
#f))
; Tests for exec-add1
(check-equal? (exec-add1 (prog-state
@ -169,7 +177,7 @@
(prog-state-output w)
(prog-state-program w)
(add1 (prog-state-ip w))
(prog-state-error w)))
#f))
; Tests for exec-sub1
(check-equal? (exec-sub1 (prog-state
@ -188,9 +196,7 @@
(prog-state-output w)
(prog-state-program w)
(add1 (prog-state-ip w))
(if (zero? (prog-state-dp w))
(error-code 'error1)
(prog-state-error w))))
(if (zero? (prog-state-dp w)) (error-code 'error1) #f)))
; Tests for exec-tape-left
;(check-exn exn:fail? (exec-tape-left (prog-state (list 1 2 3) 0 3 "" "<" 0)))
@ -205,8 +211,7 @@
; exec-tape-right: ProgState -> ProgState
; Given a ProgState, returns a new ProgState with the > instruction executed
(define (exec-tape-right w)
(local [(define end-of-tape
(= (prog-state-dp w) (sub1 (prog-state-tape-len w))))]
(define end-of-tape (= (prog-state-dp w) (sub1 (prog-state-tape-len w))))
(prog-state
(if end-of-tape
(append (prog-state-tape w) (list 0))
@ -218,7 +223,7 @@
(prog-state-output w)
(prog-state-program w)
(add1 (prog-state-ip w))
(prog-state-error w))))
#f))
; Tests for exec-tape-right
(check-equal? (exec-tape-right (prog-state (list 1 2 3) 0 3 "" ">" 0 #f))
@ -239,7 +244,7 @@
(list (integer->char (list-ref (prog-state-tape w) (prog-state-dp w))))))
(prog-state-program w)
(add1 (prog-state-ip w))
(prog-state-error w)))
#f))
; Tests for exec-out
(check-equal? (exec-out (prog-state (list 50) 0 1 "" ".[->+<]" 0 #f))
@ -252,7 +257,7 @@
; - 'backward
; Interpretation: the direction to walk the Brainf*ck Program with.
; find-matching: Program Nat WalkingDirection -> Nat
; find-matching: Program Nat WalkingDirection -> Option<Nat>
; Given a program, a starting position in the progam and a walking direction
; returns the position of the matching bracket walking in the given direction.
(define (find-matching prg start wd)
@ -261,11 +266,13 @@
(define oppos-brkt (if (symbol=? wd 'forward) #\[ #\]))
(define upd-start (if (symbol=? wd 'forward) add1 sub1))
; fm-helper Nat Nat -> Nat
; fm-helper Nat Nat -> Option<Nat>
; Given a starting position and a nest accumulator, returns the position of
; the matching bracket waking in the direction provided by updating the
; accumulator recursively with the current level of nesting.
; accumulator recursively with the current level of nesting. #f is returned
; when the search for the matching paren overflows out of the string.
(define (fm-helper s nest)
(with-handlers ([exn:fail:contract? (lambda (e) #f)])
(cond
[(and (zero? nest) (char=? (string-ref prg s) brkt))
s]
@ -274,7 +281,7 @@
[(char=? (string-ref prg s) brkt)
(fm-helper (upd-start s) (sub1 nest))]
[else
(fm-helper (upd-start s) nest)]))
(fm-helper (upd-start s) nest)])))
(fm-helper (upd-start start) 0))
@ -285,21 +292,27 @@
17)
(check-equal? (find-matching "[+++++[]+---->><-]++++]+--" 17 'backward)
0)
(check-equal? (find-matching ".+++++[]+---->><-]++++]+--" 17 'backward)
#f)
; exec-loop-start: ProgState -> ProgState
; Given a ProgState, returns a new ProgState with the [ instruction executed
(define (exec-loop-start w)
; Whether to jump or not
(define jump (zero? (list-ref (prog-state-tape w) (prog-state-dp w))))
; Next value of IP or #f (if non-matching)
(define pos-or-f
(if jump
(find-matching (prog-state-program w) (prog-state-ip w) 'forward)
(prog-state-ip w)))
(prog-state
(prog-state-tape w)
(prog-state-dp w)
(prog-state-tape-len w)
(prog-state-output w)
(prog-state-program w)
(add1 (if jump
(find-matching (prog-state-program w) (prog-state-ip w) 'forward)
(prog-state-ip w)))
(prog-state-error w)))
(if (number? pos-or-f) (add1 pos-or-f) (prog-state-ip w))
(if (number? pos-or-f) #f (error-code 'error2))))
; Tests for exec-loop-start
(check-equal? (exec-loop-start
@ -312,17 +325,21 @@
; exec-loop-end: ProgState -> ProgState
; Given a ProgState, returns a new ProgState with the ] instruction executed
(define (exec-loop-end w)
; Whether to jump or not
(define jump (not (zero? (list-ref (prog-state-tape w) (prog-state-dp w)))))
; Next value of IP or #f (if non-matching)
(define pos-or-f
(if jump
(find-matching (prog-state-program w) (prog-state-ip w) 'backward)
(prog-state-ip w)))
(prog-state
(prog-state-tape w)
(prog-state-dp w)
(prog-state-tape-len w)
(prog-state-output w)
(prog-state-program w)
(add1 (if jump
(find-matching (prog-state-program w) (prog-state-ip w) 'backward)
(prog-state-ip w)))
(prog-state-error w)))
(if (number? pos-or-f) (add1 pos-or-f) (prog-state-ip w))
(if (number? pos-or-f) #f (error-code 'error3))))
; Tests for exec-loop-end
(check-equal? (exec-loop-end
@ -392,15 +409,18 @@
[(char=? inst #\]) (exec-loop-end w)]
[(char=? inst #\.) (exec-out w)]))
; Fetch current instruction. If the char is out of range, call done with #f
(with-handlers
([exn:fail:contract? (lambda (e) (done #f))])
(define inst (string-ref (prog-state-program prog) (prog-state-ip prog)))
(cond [(eq? (prog-state-error prog) #f)
; Fetch current instr.. If the char is out of range, call done with #f
(with-handlers ([exn:fail:contract? (lambda (e) (done #f))])
(define inst (string-ref (prog-state-program prog)
(prog-state-ip prog)))
; Execute asynchr. if ",", otherwise call callback with results of
; execute-sync
(cond [(char=? inst #\,) (exec-in prog get-input done)]
[else (done (execute-sync inst prog))])))
[else (done (execute-sync inst prog))]))]
[else (done #f)]))
; execute: ProgState (ProgState -> _) ((Byte -> _) -> _) -> _
; Given an initial ProgState state,