Added nice errror handling in cli and gui
This commit is contained in:
Claudio Maggioni
parent
17cbac57eb
commit
f5491a2b44
3
cli.rkt
3
cli.rkt
|
|
@ -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
11
gui.rkt
|
|
@ -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%
|
||||
|
|
|
|||
120
interpreter.rkt
120
interpreter.rkt
|
|
@ -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.")
|
||||
"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,20 +211,19 @@
|
|||
; 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))))]
|
||||
(prog-state
|
||||
(if end-of-tape
|
||||
(append (prog-state-tape w) (list 0))
|
||||
(prog-state-tape w))
|
||||
(add1 (prog-state-dp w))
|
||||
(if end-of-tape
|
||||
(add1 (prog-state-tape-len w))
|
||||
(prog-state-tape-len w))
|
||||
(prog-state-output w)
|
||||
(prog-state-program w)
|
||||
(add1 (prog-state-ip w))
|
||||
(prog-state-error 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))
|
||||
(prog-state-tape w))
|
||||
(add1 (prog-state-dp w))
|
||||
(if end-of-tape
|
||||
(add1 (prog-state-tape-len w))
|
||||
(prog-state-tape-len w))
|
||||
(prog-state-output w)
|
||||
(prog-state-program w)
|
||||
(add1 (prog-state-ip 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,20 +266,22 @@
|
|||
(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)
|
||||
(cond
|
||||
[(and (zero? nest) (char=? (string-ref prg s) brkt))
|
||||
s]
|
||||
[(char=? (string-ref prg s) oppos-brkt)
|
||||
(fm-helper (upd-start s) (add1 nest))]
|
||||
[(char=? (string-ref prg s) brkt)
|
||||
(fm-helper (upd-start s) (sub1 nest))]
|
||||
[else
|
||||
(fm-helper (upd-start s) nest)]))
|
||||
(with-handlers ([exn:fail:contract? (lambda (e) #f)])
|
||||
(cond
|
||||
[(and (zero? nest) (char=? (string-ref prg s) brkt))
|
||||
s]
|
||||
[(char=? (string-ref prg s) oppos-brkt)
|
||||
(fm-helper (upd-start s) (add1 nest))]
|
||||
[(char=? (string-ref prg s) brkt)
|
||||
(fm-helper (upd-start s) (sub1 nest))]
|
||||
[else
|
||||
(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))])))
|
||||
; 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 #f)]))
|
||||
|
||||
|
||||
; execute: ProgState (ProgState -> _) ((Byte -> _) -> _) -> _
|
||||
; Given an initial ProgState state,
|
||||
|
|
|
|||
Loading…
Reference in New Issue