diff --git a/interpreter.rkt b/interpreter.rkt index 9d94668..cfdc3cc 100644 --- a/interpreter.rkt +++ b/interpreter.rkt @@ -41,6 +41,10 @@ ; A InstructionPointer (IP) is a NonNegInt ; Interpretation: a pointer to the instruction to execute. +; An ErrorCode is one of: +; - 'error1 +; Interp: an error code for the bf interpreter. + ; A ProgState is a (prog-state tape dp output program ip) where: ; - tape: Tape ; - dp: DataPointer @@ -48,8 +52,9 @@ ; - output: String ; - program: Program ; - ip: InstructionPointer +; - error: Option ; Interpretation: the current state of execution of a brainf*ck program. -(struct prog-state (tape dp tape-len output program ip) +(struct prog-state (tape dp tape-len output program ip error) #:transparent #:methods gen:custom-write [(define write-proc @@ -60,16 +65,18 @@ (prog-state-tape-len w) (prog-state-output w) (prog-state-program w) - (prog-state-ip w)))))]) + (prog-state-ip w) + (prog-state-error w)))))]) ; Template function for ProgState #;(define (fn-for-prog-state w) - #; (... (prog-state-tape w) - #; (prog-state-dp w) - #; (prog-state-tape-len w) - #; (prog-state-output w) - #; (prog-state-program w) - #; (prog-state-ip w))) +#; (... (prog-state-tape w) +#; (prog-state-dp w) +#; (prog-state-tape-len w) +#; (prog-state-output w) +#; (prog-state-program w) +#; (prog-state-ip w) +#; (prog-state-error w))) ; string->program: String -> Program ; Given a string, returns a bf program without any invalid character @@ -109,11 +116,11 @@ ; program->prog-state: Program -> ProgState ; Given a program, returns the corresponding initial ProgState state. (define (program->prog-state p) - (prog-state (cons 0 '()) 0 1 "" p 0)) + (prog-state (cons 0 '()) 0 1 "" p 0 #f)) ; Tests for program->prog-state (check-equal? - (program->prog-state "[->+<]") (prog-state (list 0) 0 1 "" "[->+<]" 0)) + (program->prog-state "[->+<]") (prog-state (list 0) 0 1 "" "[->+<]" 0 #f)) ; tape-help: Tape DP (Byte -> Byte) -> Tape ; Given a tape and a data pointer, returns the same tape with the data in the @@ -126,6 +133,18 @@ (check-equal? (tape-help (list 0) 0 add1-byte) (list 1)) (check-equal? (tape-help (list 0 1 2 3) 2 sub1-byte) (list 0 1 1 3)) +; error-code: Option -> String +; Given an index symbol, returns the corresponding error. +(define (error-code sym) + (cond [(eq? sym #f) ""] + [(symbol=? sym 'error1) + "ERROR: '<' not working. Cannot access negative tape positions."])) + +; Tests for error-code +(check-equal? (error-code #f) "") +(check-equal? (error-code 'error1) + "ERROR: '<' not working. Cannot access negative tape positions.") + ; exec-add1: ProgState -> ProgState ; Given a ProgState, returns a new ProgState with the + instruction executed (define (exec-add1 w) @@ -134,15 +153,16 @@ (prog-state-tape-len w) (prog-state-output w) (prog-state-program w) - (add1 (prog-state-ip w)))) + (add1 (prog-state-ip w)) + (prog-state-error w))) ; Tests for exec-add1 (check-equal? (exec-add1 (prog-state - (list 1 2 3 4 5 6 7) 3 7 "" "+" 0)) - (prog-state (list 1 2 3 5 5 6 7) 3 7 "" "+" 1)) + (list 1 2 3 4 5 6 7) 3 7 "" "+" 0 #f)) + (prog-state (list 1 2 3 5 5 6 7) 3 7 "" "+" 1 #f)) (check-equal? (exec-add1 (prog-state - (list 255 1 2 3) 0 4 "" "+" 0)) - (prog-state (list 0 1 2 3) 0 4 "" "+" 1)) + (list 255 1 2 3) 0 4 "" "+" 0 #f)) + (prog-state (list 0 1 2 3) 0 4 "" "+" 1 #f)) ; exec-sub1: ProgState -> ProgState ; Given a ProgState, returns a new ProgState with the - instruction executed @@ -152,32 +172,39 @@ (prog-state-tape-len w) (prog-state-output w) (prog-state-program w) - (add1 (prog-state-ip w)))) + (add1 (prog-state-ip w)) + (prog-state-error w))) ; Tests for exec-sub1 (check-equal? (exec-sub1 (prog-state - (list 1 2 3 4 5 6 7) 3 7 "" "-" 0)) - (prog-state (list 1 2 3 3 5 6 7) 3 7 "" "-" 1)) + (list 1 2 3 4 5 6 7) 3 7 "" "-" 0 #f)) + (prog-state (list 1 2 3 3 5 6 7) 3 7 "" "-" 1 #f)) (check-equal? (exec-sub1 (prog-state - (list 0 1 2 3) 0 4 "" "-" 0)) - (prog-state (list 255 1 2 3) 0 4 "" "-" 1)) + (list 0 1 2 3) 0 4 "" "-" 0 #f)) + (prog-state (list 255 1 2 3) 0 4 "" "-" 1 #f)) ; exec-tape-left: ProgState -> ProgState ; Given a ProgState, returns a new ProgState with the < instruction executed -(define (exec-tape-left w) - (if (zero? (prog-state-dp w)) - (error "Can't access negative tape positions") - (prog-state (prog-state-tape w) - (sub1 (prog-state-dp w)) - (prog-state-tape-len w) - (prog-state-output w) - (prog-state-program w) - (add1 (prog-state-ip w))))) +(define (exec-tape-left w) + (prog-state (prog-state-tape w) + (sub1 (prog-state-dp w)) + (prog-state-tape-len w) + (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)))) ; Tests for exec-tape-left ;(check-exn exn:fail? (exec-tape-left (prog-state (list 1 2 3) 0 3 "" "<" 0))) -(check-equal? (exec-tape-left (prog-state (list 1 2 3) 2 3 "" "<" 0)) - (prog-state (list 1 2 3) 1 3 "" "<" 1)) +(check-equal? (exec-tape-left (prog-state (list 1 2 3) 2 3 "" "<" 0 #f)) + (prog-state (list 1 2 3) 1 3 "" "<" 1 #f)) +(check-equal? (exec-tape-left (prog-state (list 1 2 3) 0 3 "" "<" 0 #f)) + (prog-state + (list 1 2 3) -1 3 "" "<" 1 + "ERROR: '<' not working. Cannot access negative tape positions.") + ) ; exec-tape-right: ProgState -> ProgState ; Given a ProgState, returns a new ProgState with the > instruction executed @@ -194,13 +221,14 @@ (prog-state-tape-len w)) (prog-state-output w) (prog-state-program w) - (add1 (prog-state-ip w))))) + (add1 (prog-state-ip w)) + (prog-state-error w)))) ; Tests for exec-tape-right -(check-equal? (exec-tape-right (prog-state (list 1 2 3) 0 3 "" ">" 0)) - (prog-state (list 1 2 3) 1 3 "" ">" 1)) -(check-equal? (exec-tape-right (prog-state (list 0 1 2) 2 3 "" ">" 0)) - (prog-state (list 0 1 2 0) 3 4 "" ">" 1)) +(check-equal? (exec-tape-right (prog-state (list 1 2 3) 0 3 "" ">" 0 #f)) + (prog-state (list 1 2 3) 1 3 "" ">" 1 #f)) +(check-equal? (exec-tape-right (prog-state (list 0 1 2) 2 3 "" ">" 0 #f)) + (prog-state (list 0 1 2 0) 3 4 "" ">" 1 #f)) ; exec-out: ProgState -> ProgState ; Given a ProgState, returns a new ProgState with the . instruction executed @@ -214,13 +242,14 @@ (list->string (list (integer->char (list-ref (prog-state-tape w) (prog-state-dp w)))))) (prog-state-program w) - (add1 (prog-state-ip w)))) + (add1 (prog-state-ip w)) + (prog-state-error w))) ; Tests for exec-out -(check-equal? (exec-out (prog-state (list 50) 0 1 "" ".[->+<]" 0)) - (prog-state (list 50) 0 1 "2" ".[->+<]" 1)) -(check-equal? (exec-out (prog-state (list 65) 0 1 "" ".[->+<]" 0)) - (prog-state (list 65) 0 1 "A" ".[->+<]" 1)) +(check-equal? (exec-out (prog-state (list 50) 0 1 "" ".[->+<]" 0 #f)) + (prog-state (list 50) 0 1 "2" ".[->+<]" 1 #f)) +(check-equal? (exec-out (prog-state (list 65) 0 1 "" ".[->+<]" 0 #f)) + (prog-state (list 65) 0 1 "A" ".[->+<]" 1 #f)) ; WalkingDirection can be one of: ; - 'forward @@ -229,7 +258,7 @@ ; find-matching: Program Nat WalkingDirection -> Nat ; Given a program, a starting position in the progam and a walking direction -; returns the position of the matching bracket waking in the direction provided. +; returns the position of the matching bracket walking in the given direction. (define (find-matching prg start wd) (define brkt (if (symbol=? wd 'forward) #\] #\[)) @@ -253,7 +282,7 @@ (fm-helper (upd-start start) 0)) -; Tests for find-first +; Tests for find-matching (check-equal? (find-matching "[++++++---->><-]++++]+--" 0 'forward) 15) (check-equal? (find-matching "[+++++][+---->><-]++++]+--" 7 'forward) @@ -273,15 +302,16 @@ (prog-state-program w) (add1 (if jump (find-matching (prog-state-program w) (prog-state-ip w) 'forward) - (prog-state-ip w))))) + (prog-state-ip w))) + (prog-state-error w))) ; Tests for exec-loop-start (check-equal? (exec-loop-start - (prog-state '(0) 0 1 "" "[++--]++--+-[]" 0)) - (prog-state '(0) 0 1 "" "[++--]++--+-[]" 6)) + (prog-state '(0) 0 1 "" "[++--]++--+-[]" 0 #f)) + (prog-state '(0) 0 1 "" "[++--]++--+-[]" 6 #f)) (check-equal? (exec-loop-start - (prog-state '(1) 0 1 "" "[++--]++--+-[]" 0)) - (prog-state '(1) 0 1 "" "[++--]++--+-[]" 1)) + (prog-state '(1) 0 1 "" "[++--]++--+-[]" 0 #f)) + (prog-state '(1) 0 1 "" "[++--]++--+-[]" 1 #f)) ; exec-loop-end: ProgState -> ProgState ; Given a ProgState, returns a new ProgState with the ] instruction executed @@ -295,15 +325,16 @@ (prog-state-program w) (add1 (if jump (find-matching (prog-state-program w) (prog-state-ip w) 'backward) - (prog-state-ip w))))) + (prog-state-ip w))) + (prog-state-error w))) ; Tests for exec-loop-end (check-equal? (exec-loop-end - (prog-state '(0) 0 1 "" "[++--]++--+-[]" 5)) - (prog-state '(0) 0 1 "" "[++--]++--+-[]" 6)) + (prog-state '(0) 0 1 "" "[++--]++--+-[]" 5 #f)) + (prog-state '(0) 0 1 "" "[++--]++--+-[]" 6 #f)) (check-equal? (exec-loop-end - (prog-state '(1) 0 1 "" "[++--]++--+-[]" 5)) - (prog-state '(1) 0 1 "" "[++--]++--+-[]" 1)) + (prog-state '(1) 0 1 "" "[++--]++--+-[]" 5 #f)) + (prog-state '(1) 0 1 "" "[++--]++--+-[]" 1 #f)) ; insert-in-tape: DataTape Byte Nat -> DataTape ; Given a datatape, a byte to insert and an index, returns a datatape with the @@ -325,7 +356,8 @@ (define (exec-in w get-input done) ; got-input: Byte -> _ - ; Given a byte, updates the ProgState and calls `done` with the new ProgState + ; Given a byte, updates the ProgState and calls `done` + ; with the new ProgState. (define (got-input byte) (done (prog-state (insert-in-tape (prog-state-tape w) byte (prog-state-dp w)) @@ -333,19 +365,21 @@ (prog-state-tape-len w) (prog-state-output w) (prog-state-program w) - (add1 (prog-state-ip w))))) + (add1 (prog-state-ip w)) + (prog-state-error w)))) (get-input got-input)) ; Tests for get-input (test-begin (exec-in - (prog-state (list 0) 0 1 "," "" 0) + (prog-state (list 0) 0 1 "," "" 0 #f) (lambda (done) (done 50)) - (lambda (w) (check-equal? w (prog-state (list 50) 0 1 "," "" 1))))) + (lambda (w) (check-equal? w (prog-state (list 50) 0 1 "," "" 1 #f))))) ; execute: ProgState (ProgState -> _) ((Byte -> _) -> _) -> _ -; Given an initial ProgState state, calls done when the final ProgState has been +; Given an initial ProgState state, +; calls done when the final ProgState has been ; computed by executing the program (define (execute prog done get-input) @@ -365,7 +399,8 @@ (define program-len (string-length (prog-state-program prog))) ; execute-help: ProgState -> _ - ; Helper function for `execute`. Given an initial ProgState state, calls done + ; Helper function for `execute`. + ; Given an initial ProgState state, calls done ; when the final ProgState is ready. (define (execute-help w) (cond [(>= (prog-state-ip w) program-len) (done w)] @@ -373,7 +408,8 @@ ; Fetch current instruction (define inst (string-ref (prog-state-program w) (prog-state-ip w))) (cond [(char=? inst #\,) - (exec-in w get-input (lambda (ps) (execute ps done get-input)))] + (exec-in w get-input + (lambda (ps) (execute ps done get-input)))] [else (execute (execute-sync inst w) done get-input)])])) (execute-help prog)) @@ -381,20 +417,20 @@ ; Tests for execute (test-begin (execute - (prog-state (list 0) 0 3 "" "" 0) - (lambda (w) (check-equal? w (prog-state (list 0) 0 3 "" "" 0))) + (prog-state (list 0) 0 3 "" "" 0 #f) + (lambda (w) (check-equal? w (prog-state (list 0) 0 3 "" "" 0 #f))) (lambda (done) (done 0)))) ; assert that 5+2 to ASCII = "7" (test-begin (execute - (prog-state (list 0) 0 1 "" "++>+++++[<+>-]++++++++[<++++++>-]<." 0) + (prog-state (list 0) 0 1 "" "++>+++++[<+>-]++++++++[<++++++>-]<." 0 #f) (lambda (w) (check-equal? w (prog-state (list 55 0) 0 2 "7" - "++>+++++[<+>-]++++++++[<++++++>-]<." 35))) + "++>+++++[<+>-]++++++++[<++++++>-]<." 35 #f))) (lambda (done) (done 0)))) (test-begin (execute - (prog-state (list 0) 0 1 "" ",." 0) - (lambda (w) (check-equal? w (prog-state (list 49) 0 1 "1" ",." 2))) + (prog-state (list 0) 0 1 "" ",." 0 #f) + (lambda (w) (check-equal? w (prog-state (list 49) 0 1 "1" ",." 2 #f))) (lambda (done) (done 49)))) ; ASCII for "1"