Added nice errror handling in cli and gui

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 -> _

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
+  ; 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
 (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%

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))
+              (if (zero? (prog-state-dp w)) (error-code 'error1) #f)))
-                  (error-code 'error1)
-                  (prog-state-error w))))
 
 ; 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
+  (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))
+       (prog-state-tape w))
-         (prog-state-tape w))
+   (add1 (prog-state-dp w))
-     (add1 (prog-state-dp w))
+   (if end-of-tape
-     (if end-of-tape
+       (add1 (prog-state-tape-len w))
-         (add1 (prog-state-tape-len 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 (prog-state-ip w))
-     (add1 (prog-state-ip w))
+   #f))
-     (prog-state-error w))))
 
 ; 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
+    (with-handlers ([exn:fail:contract? (lambda (e) #f)])
-      [(and (zero? nest) (char=? (string-ref prg s) brkt))
+      (cond
-       s]
+        [(and (zero? nest) (char=? (string-ref prg s) brkt))
-      [(char=? (string-ref prg s) oppos-brkt)
+         s]
-       (fm-helper (upd-start s) (add1 nest))]
+        [(char=? (string-ref prg s) oppos-brkt)
-      [(char=? (string-ref prg s) brkt)
+         (fm-helper (upd-start s) (add1 nest))]
-       (fm-helper (upd-start s) (sub1 nest))]
+        [(char=? (string-ref prg s) brkt)
-      [else
+         (fm-helper (upd-start s) (sub1 nest))]
-       (fm-helper (upd-start s) 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
+   (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
 (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
+   (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
 (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
+  (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 -> _) -> _) -> _
 ; Given an initial ProgState state,