Added nice errror handling in cli and gui
This commit is contained in:
parent
17cbac57eb
commit
f5491a2b44
3 changed files with 81 additions and 53 deletions
3
cli.rkt
3
cli.rkt
|
@ -35,6 +35,9 @@
|
||||||
; Given the fineal prog-state, prints the results according to the flags.
|
; Given the fineal prog-state, prints the results according to the flags.
|
||||||
(define (end-print p)
|
(define (end-print p)
|
||||||
(display (prog-state-output 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)))
|
(if (show-tape) (display-status p) (void)))
|
||||||
|
|
||||||
; display-trace: ProgState -> _
|
; display-trace: ProgState -> _
|
||||||
|
|
11
gui.rkt
11
gui.rkt
|
@ -105,7 +105,8 @@
|
||||||
(execute-content
|
(execute-content
|
||||||
(lambda (ps)
|
(lambda (ps)
|
||||||
(update-state-gui 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
|
; run-step: Button ControlEvent -> Nothing
|
||||||
; Given the step button pressed and an event, runs the matching step (step or
|
; Given the step button pressed and an event, runs the matching step (step or
|
||||||
|
@ -124,10 +125,11 @@
|
||||||
; the contents of that prog-state.
|
; the contents of that prog-state.
|
||||||
(define (update-state-gui ps)
|
(define (update-state-gui ps)
|
||||||
(define out (prog-state-output ps))
|
(define out (prog-state-output ps))
|
||||||
|
(define err (prog-state-error ps))
|
||||||
; update data tape inspector
|
; update data tape inspector
|
||||||
(make-tape-cells ps)
|
(make-tape-cells ps)
|
||||||
; set output and change color to ended
|
; set output
|
||||||
(send RUN-OUTPUT set-value out))
|
(send RUN-OUTPUT set-value (string-append out "\n" (if (eq? err #f) "" err))))
|
||||||
|
|
||||||
; The tape panel
|
; The tape panel
|
||||||
(define BUTTON-PANEL
|
(define BUTTON-PANEL
|
||||||
|
@ -294,6 +296,9 @@
|
||||||
; Output completed color
|
; Output completed color
|
||||||
(define end-col (make-object color% 200 250 200))
|
(define end-col (make-object color% 200 250 200))
|
||||||
|
|
||||||
|
; Error color
|
||||||
|
(define err-col (make-object color% 250 200 200))
|
||||||
|
|
||||||
; The tape panel
|
; The tape panel
|
||||||
(define tape-panel
|
(define tape-panel
|
||||||
(new horizontal-panel%
|
(new horizontal-panel%
|
||||||
|
|
|
@ -134,12 +134,20 @@
|
||||||
(define (error-code sym)
|
(define (error-code sym)
|
||||||
(cond [(eq? sym #f) ""]
|
(cond [(eq? sym #f) ""]
|
||||||
[(symbol=? sym 'error1)
|
[(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
|
; Tests for error-code
|
||||||
(check-equal? (error-code #f) "")
|
(check-equal? (error-code #f) "")
|
||||||
(check-equal? (error-code 'error1)
|
(check-equal? (error-code 'error1)
|
||||||
"ERROR: '<' not working. Cannot access negative tape positions.")
|
"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
|
; exec-add1: ProgState -> ProgState
|
||||||
; Given a ProgState, returns a new ProgState with the + instruction executed
|
; Given a ProgState, returns a new ProgState with the + instruction executed
|
||||||
|
@ -150,7 +158,7 @@
|
||||||
(prog-state-output w)
|
(prog-state-output w)
|
||||||
(prog-state-program w)
|
(prog-state-program w)
|
||||||
(add1 (prog-state-ip w))
|
(add1 (prog-state-ip w))
|
||||||
(prog-state-error w)))
|
#f))
|
||||||
|
|
||||||
; Tests for exec-add1
|
; Tests for exec-add1
|
||||||
(check-equal? (exec-add1 (prog-state
|
(check-equal? (exec-add1 (prog-state
|
||||||
|
@ -169,7 +177,7 @@
|
||||||
(prog-state-output w)
|
(prog-state-output w)
|
||||||
(prog-state-program w)
|
(prog-state-program w)
|
||||||
(add1 (prog-state-ip w))
|
(add1 (prog-state-ip w))
|
||||||
(prog-state-error w)))
|
#f))
|
||||||
|
|
||||||
; Tests for exec-sub1
|
; Tests for exec-sub1
|
||||||
(check-equal? (exec-sub1 (prog-state
|
(check-equal? (exec-sub1 (prog-state
|
||||||
|
@ -188,9 +196,7 @@
|
||||||
(prog-state-output w)
|
(prog-state-output w)
|
||||||
(prog-state-program w)
|
(prog-state-program w)
|
||||||
(add1 (prog-state-ip w))
|
(add1 (prog-state-ip w))
|
||||||
(if (zero? (prog-state-dp w))
|
(if (zero? (prog-state-dp w)) (error-code 'error1) #f)))
|
||||||
(error-code 'error1)
|
|
||||||
(prog-state-error w))))
|
|
||||||
|
|
||||||
; Tests for exec-tape-left
|
; Tests for exec-tape-left
|
||||||
;(check-exn exn:fail? (exec-tape-left (prog-state (list 1 2 3) 0 3 "" "<" 0)))
|
;(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
|
; exec-tape-right: ProgState -> ProgState
|
||||||
; Given a ProgState, returns a new ProgState with the > instruction executed
|
; Given a ProgState, returns a new ProgState with the > instruction executed
|
||||||
(define (exec-tape-right w)
|
(define (exec-tape-right w)
|
||||||
(local [(define end-of-tape
|
(define end-of-tape (= (prog-state-dp w) (sub1 (prog-state-tape-len w))))
|
||||||
(= (prog-state-dp w) (sub1 (prog-state-tape-len w))))]
|
|
||||||
(prog-state
|
(prog-state
|
||||||
(if end-of-tape
|
(if end-of-tape
|
||||||
(append (prog-state-tape w) (list 0))
|
(append (prog-state-tape w) (list 0))
|
||||||
|
@ -218,7 +223,7 @@
|
||||||
(prog-state-output w)
|
(prog-state-output w)
|
||||||
(prog-state-program w)
|
(prog-state-program w)
|
||||||
(add1 (prog-state-ip w))
|
(add1 (prog-state-ip w))
|
||||||
(prog-state-error w))))
|
#f))
|
||||||
|
|
||||||
; Tests for exec-tape-right
|
; Tests for exec-tape-right
|
||||||
(check-equal? (exec-tape-right (prog-state (list 1 2 3) 0 3 "" ">" 0 #f))
|
(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))))))
|
(list (integer->char (list-ref (prog-state-tape w) (prog-state-dp w))))))
|
||||||
(prog-state-program w)
|
(prog-state-program w)
|
||||||
(add1 (prog-state-ip w))
|
(add1 (prog-state-ip w))
|
||||||
(prog-state-error w)))
|
#f))
|
||||||
|
|
||||||
; Tests for exec-out
|
; Tests for exec-out
|
||||||
(check-equal? (exec-out (prog-state (list 50) 0 1 "" ".[->+<]" 0 #f))
|
(check-equal? (exec-out (prog-state (list 50) 0 1 "" ".[->+<]" 0 #f))
|
||||||
|
@ -252,7 +257,7 @@
|
||||||
; - 'backward
|
; - 'backward
|
||||||
; Interpretation: the direction to walk the Brainf*ck Program with.
|
; 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
|
; 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.
|
; returns the position of the matching bracket walking in the given direction.
|
||||||
(define (find-matching prg start wd)
|
(define (find-matching prg start wd)
|
||||||
|
@ -261,11 +266,13 @@
|
||||||
(define oppos-brkt (if (symbol=? wd 'forward) #\[ #\]))
|
(define oppos-brkt (if (symbol=? wd 'forward) #\[ #\]))
|
||||||
(define upd-start (if (symbol=? wd 'forward) add1 sub1))
|
(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
|
; Given a starting position and a nest accumulator, returns the position of
|
||||||
; the matching bracket waking in the direction provided by updating the
|
; 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)
|
(define (fm-helper s nest)
|
||||||
|
(with-handlers ([exn:fail:contract? (lambda (e) #f)])
|
||||||
(cond
|
(cond
|
||||||
[(and (zero? nest) (char=? (string-ref prg s) brkt))
|
[(and (zero? nest) (char=? (string-ref prg s) brkt))
|
||||||
s]
|
s]
|
||||||
|
@ -274,7 +281,7 @@
|
||||||
[(char=? (string-ref prg s) brkt)
|
[(char=? (string-ref prg s) brkt)
|
||||||
(fm-helper (upd-start s) (sub1 nest))]
|
(fm-helper (upd-start s) (sub1 nest))]
|
||||||
[else
|
[else
|
||||||
(fm-helper (upd-start s) nest)]))
|
(fm-helper (upd-start s) nest)])))
|
||||||
|
|
||||||
(fm-helper (upd-start start) 0))
|
(fm-helper (upd-start start) 0))
|
||||||
|
|
||||||
|
@ -285,21 +292,27 @@
|
||||||
17)
|
17)
|
||||||
(check-equal? (find-matching "[+++++[]+---->><-]++++]+--" 17 'backward)
|
(check-equal? (find-matching "[+++++[]+---->><-]++++]+--" 17 'backward)
|
||||||
0)
|
0)
|
||||||
|
(check-equal? (find-matching ".+++++[]+---->><-]++++]+--" 17 'backward)
|
||||||
|
#f)
|
||||||
|
|
||||||
; exec-loop-start: ProgState -> ProgState
|
; exec-loop-start: ProgState -> ProgState
|
||||||
; Given a ProgState, returns a new ProgState with the [ instruction executed
|
; Given a ProgState, returns a new ProgState with the [ instruction executed
|
||||||
(define (exec-loop-start w)
|
(define (exec-loop-start w)
|
||||||
|
; Whether to jump or not
|
||||||
(define jump (zero? (list-ref (prog-state-tape w) (prog-state-dp w))))
|
(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
|
||||||
(prog-state-tape w)
|
(prog-state-tape w)
|
||||||
(prog-state-dp w)
|
(prog-state-dp w)
|
||||||
(prog-state-tape-len w)
|
(prog-state-tape-len w)
|
||||||
(prog-state-output w)
|
(prog-state-output w)
|
||||||
(prog-state-program w)
|
(prog-state-program w)
|
||||||
(add1 (if jump
|
(if (number? pos-or-f) (add1 pos-or-f) (prog-state-ip w))
|
||||||
(find-matching (prog-state-program w) (prog-state-ip w) 'forward)
|
(if (number? pos-or-f) #f (error-code 'error2))))
|
||||||
(prog-state-ip w)))
|
|
||||||
(prog-state-error w)))
|
|
||||||
|
|
||||||
; Tests for exec-loop-start
|
; Tests for exec-loop-start
|
||||||
(check-equal? (exec-loop-start
|
(check-equal? (exec-loop-start
|
||||||
|
@ -312,17 +325,21 @@
|
||||||
; exec-loop-end: ProgState -> ProgState
|
; exec-loop-end: ProgState -> ProgState
|
||||||
; Given a ProgState, returns a new ProgState with the ] instruction executed
|
; Given a ProgState, returns a new ProgState with the ] instruction executed
|
||||||
(define (exec-loop-end w)
|
(define (exec-loop-end w)
|
||||||
|
; Whether to jump or not
|
||||||
(define jump (not (zero? (list-ref (prog-state-tape w) (prog-state-dp w)))))
|
(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
|
||||||
(prog-state-tape w)
|
(prog-state-tape w)
|
||||||
(prog-state-dp w)
|
(prog-state-dp w)
|
||||||
(prog-state-tape-len w)
|
(prog-state-tape-len w)
|
||||||
(prog-state-output w)
|
(prog-state-output w)
|
||||||
(prog-state-program w)
|
(prog-state-program w)
|
||||||
(add1 (if jump
|
(if (number? pos-or-f) (add1 pos-or-f) (prog-state-ip w))
|
||||||
(find-matching (prog-state-program w) (prog-state-ip w) 'backward)
|
(if (number? pos-or-f) #f (error-code 'error3))))
|
||||||
(prog-state-ip w)))
|
|
||||||
(prog-state-error w)))
|
|
||||||
|
|
||||||
; Tests for exec-loop-end
|
; Tests for exec-loop-end
|
||||||
(check-equal? (exec-loop-end
|
(check-equal? (exec-loop-end
|
||||||
|
@ -392,15 +409,18 @@
|
||||||
[(char=? inst #\]) (exec-loop-end w)]
|
[(char=? inst #\]) (exec-loop-end w)]
|
||||||
[(char=? inst #\.) (exec-out w)]))
|
[(char=? inst #\.) (exec-out w)]))
|
||||||
|
|
||||||
; Fetch current instruction. If the char is out of range, call done with #f
|
(cond [(eq? (prog-state-error prog) #f)
|
||||||
(with-handlers
|
; Fetch current instr.. If the char is out of range, call done with #f
|
||||||
([exn:fail:contract? (lambda (e) (done #f))])
|
(with-handlers ([exn:fail:contract? (lambda (e) (done #f))])
|
||||||
(define inst (string-ref (prog-state-program prog) (prog-state-ip prog)))
|
(define inst (string-ref (prog-state-program prog)
|
||||||
|
(prog-state-ip prog)))
|
||||||
|
|
||||||
; Execute asynchr. if ",", otherwise call callback with results of
|
; Execute asynchr. if ",", otherwise call callback with results of
|
||||||
; execute-sync
|
; execute-sync
|
||||||
(cond [(char=? inst #\,) (exec-in prog get-input done)]
|
(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 -> _) -> _) -> _
|
; execute: ProgState (ProgState -> _) ((Byte -> _) -> _) -> _
|
||||||
; Given an initial ProgState state,
|
; Given an initial ProgState state,
|
||||||
|
|
Loading…
Reference in a new issue