diff --git a/cli.rkt b/cli.rkt index c242111..dd0b29d 100755 --- a/cli.rkt +++ b/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 -> _ diff --git a/gui.rkt b/gui.rkt index 7088a53..e613dde 100644 --- a/gui.rkt +++ b/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% diff --git a/interpreter.rkt b/interpreter.rkt index b2c3d3b..570b8a8 100644 --- a/interpreter.rkt +++ b/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 ; 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 ; 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,