diff --git a/interpreter.rkt b/interpreter.rkt index d405fd9..9d94668 100644 --- a/interpreter.rkt +++ b/interpreter.rkt @@ -5,7 +5,7 @@ (require racket/base racket/struct - test-engine/racket-tests) + rackunit) (provide prog-state prog-state? @@ -64,12 +64,12 @@ ; 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))) ; string->program: String -> Program ; Given a string, returns a bf program without any invalid character @@ -80,12 +80,12 @@ (define (valid-char? s) (ormap (lambda (x) (char=? s x)) '(#\> #\< #\+ #\- #\, #\. #\[ #\])))] - (list->string (filter valid-char? (string->list s))))) + (list->string (filter valid-char? (string->list s))))) ; Tests for string->program -(check-expect (string->program "hello") "") -(check-expect (string->program "+ProgState50-[]") "+-[]") -(check-expect (string->program "") "") +(check-equal? (string->program "hello") "") +(check-equal? (string->program "+ProgState50-[]") "+-[]") +(check-equal? (string->program "") "") ; add1-byte: Byte -> Byte ; Given a byte, returns the byte+1 simulating overflows @@ -93,8 +93,8 @@ (modulo (add1 b) 256)) ; Tests for add1-byte -(check-expect (add1-byte 255) 0) -(check-expect (add1-byte 254) 255) +(check-equal? (add1-byte 255) 0) +(check-equal? (add1-byte 254) 255) ; sub1-byte: Byte -> Byte ; Given a byte, returns the byte-1 simulating underflows @@ -103,8 +103,8 @@ [else (sub1 b)])) ; Tests for sub1-byte -(check-expect (sub1-byte 0) 255) -(check-expect (sub1-byte 1) 0) +(check-equal? (sub1-byte 0) 255) +(check-equal? (sub1-byte 1) 0) ; program->prog-state: Program -> ProgState ; Given a program, returns the corresponding initial ProgState state. @@ -112,7 +112,7 @@ (prog-state (cons 0 '()) 0 1 "" p 0)) ; Tests for program->prog-state -(check-expect +(check-equal? (program->prog-state "[->+<]") (prog-state (list 0) 0 1 "" "[->+<]" 0)) ; tape-help: Tape DP (Byte -> Byte) -> Tape @@ -123,8 +123,8 @@ [else (cons (first tape) (tape-help (rest tape) (sub1 dp) alter))])) ; Tests for tape-help -(check-expect (tape-help (list 0) 0 add1-byte) (list 1)) -(check-expect (tape-help (list 0 1 2 3) 2 sub1-byte) (list 0 1 1 3)) +(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)) ; exec-add1: ProgState -> ProgState ; Given a ProgState, returns a new ProgState with the + instruction executed @@ -137,10 +137,10 @@ (add1 (prog-state-ip w)))) ; Tests for exec-add1 -(check-expect (exec-add1 (prog-state +(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)) -(check-expect (exec-add1 (prog-state +(check-equal? (exec-add1 (prog-state (list 255 1 2 3) 0 4 "" "+" 0)) (prog-state (list 0 1 2 3) 0 4 "" "+" 1)) @@ -155,10 +155,10 @@ (add1 (prog-state-ip w)))) ; Tests for exec-sub1 -(check-expect (exec-sub1 (prog-state +(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)) -(check-expect (exec-sub1 (prog-state +(check-equal? (exec-sub1 (prog-state (list 0 1 2 3) 0 4 "" "-" 0)) (prog-state (list 255 1 2 3) 0 4 "" "-" 1)) @@ -175,8 +175,8 @@ (add1 (prog-state-ip w))))) ; Tests for exec-tape-left -(check-error (exec-tape-left (prog-state (list 1 2 3) 0 3 "" "<" 0))) -(check-expect (exec-tape-left (prog-state (list 1 2 3) 2 3 "" "<" 0)) +;(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)) ; exec-tape-right: ProgState -> ProgState @@ -197,9 +197,9 @@ (add1 (prog-state-ip w))))) ; Tests for exec-tape-right -(check-expect (exec-tape-right (prog-state (list 1 2 3) 0 3 "" ">" 0)) +(check-equal? (exec-tape-right (prog-state (list 1 2 3) 0 3 "" ">" 0)) (prog-state (list 1 2 3) 1 3 "" ">" 1)) -(check-expect (exec-tape-right (prog-state (list 0 1 2) 2 3 "" ">" 0)) +(check-equal? (exec-tape-right (prog-state (list 0 1 2) 2 3 "" ">" 0)) (prog-state (list 0 1 2 0) 3 4 "" ">" 1)) ; exec-out: ProgState -> ProgState @@ -217,9 +217,9 @@ (add1 (prog-state-ip w)))) ; Tests for exec-out -(check-expect (exec-out (prog-state (list 50) 0 1 "" ".[->+<]" 0)) +(check-equal? (exec-out (prog-state (list 50) 0 1 "" ".[->+<]" 0)) (prog-state (list 50) 0 1 "2" ".[->+<]" 1)) -(check-expect (exec-out (prog-state (list 65) 0 1 "" ".[->+<]" 0)) +(check-equal? (exec-out (prog-state (list 65) 0 1 "" ".[->+<]" 0)) (prog-state (list 65) 0 1 "A" ".[->+<]" 1)) ; WalkingDirection can be one of: @@ -254,70 +254,78 @@ (fm-helper (upd-start start) 0)) ; Tests for find-first -(check-expect (find-matching "[++++++---->><-]++++]+--" 0 'forward) +(check-equal? (find-matching "[++++++---->><-]++++]+--" 0 'forward) 15) -(check-expect (find-matching "[+++++][+---->><-]++++]+--" 7 'forward) +(check-equal? (find-matching "[+++++][+---->><-]++++]+--" 7 'forward) 17) -(check-expect (find-matching "[+++++[]+---->><-]++++]+--" 17 'backward) +(check-equal? (find-matching "[+++++[]+---->><-]++++]+--" 17 'backward) 0) ; exec-loop-start: ProgState -> ProgState ; Given a ProgState, returns a new ProgState with the [ instruction executed (define (exec-loop-start w) - (local [(define jump - (zero? (list-ref (prog-state-tape w) (prog-state-dp 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)))))) + (define jump (zero? (list-ref (prog-state-tape w) (prog-state-dp 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))))) ; Tests for exec-loop-start -(check-expect (exec-loop-start +(check-equal? (exec-loop-start (prog-state '(0) 0 1 "" "[++--]++--+-[]" 0)) (prog-state '(0) 0 1 "" "[++--]++--+-[]" 6)) -(check-expect (exec-loop-start +(check-equal? (exec-loop-start (prog-state '(1) 0 1 "" "[++--]++--+-[]" 0)) (prog-state '(1) 0 1 "" "[++--]++--+-[]" 1)) ; exec-loop-end: ProgState -> ProgState ; Given a ProgState, returns a new ProgState with the ] instruction executed (define (exec-loop-end w) - (local [(define jump - (not (zero? (list-ref (prog-state-tape w) (prog-state-dp 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)))))) + (define jump (not (zero? (list-ref (prog-state-tape w) (prog-state-dp 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))))) ; Tests for exec-loop-end -(check-expect (exec-loop-end +(check-equal? (exec-loop-end (prog-state '(0) 0 1 "" "[++--]++--+-[]" 5)) (prog-state '(0) 0 1 "" "[++--]++--+-[]" 6)) -(check-expect (exec-loop-end +(check-equal? (exec-loop-end (prog-state '(1) 0 1 "" "[++--]++--+-[]" 5)) (prog-state '(1) 0 1 "" "[++--]++--+-[]" 1)) ; insert-in-tape: DataTape Byte Nat -> DataTape +; Given a datatape, a byte to insert and an index, returns a datatape with the +; cell at the position pointed by the index populated with the byte to insert. (define (insert-in-tape dt val n) (cond [(zero? n) (cons val (rest dt))] + [(empty? n) (error "Cannot insert in non-existing positive position")] [else (cons (first dt) (insert-in-tape (rest dt) val (sub1 n)))])) +; Tests insert-in-tape +(check-equal? (insert-in-tape (list 0 1 2 3 4) 30 0) (list 30 1 2 3 4)) +(check-equal? (insert-in-tape (list 0 1 2 3 4) 30 4) (list 0 1 2 3 30)) + ; exec-in: ProgState ((Byte -> _) -> _) (ProgState -> _) -> _ ; Given a ProgState, a function that takes a callback function requiring a Byte ; and a function which takes the new ProgState, calls done with the input ; provided by get-input (provided by the call to the callback given in ; get-input). (define (exec-in w get-input done) + + ; got-input: Byte -> _ + ; 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)) @@ -326,33 +334,67 @@ (prog-state-output w) (prog-state-program w) (add1 (prog-state-ip w))))) + (get-input got-input)) -; execute: ProgState ((ProgState) -> _) ((Byte -> _) -> _) -> ProgState -; Given an initial ProgState state, calls done when the final ProgState is ready -; to execute the program. -(define (execute w done get-input) - (define program-len (string-length (prog-state-program w))) - (cond [(>= (prog-state-ip w) program-len) (done w)] - [else - (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)))] - [else (execute (cond [(char=? inst #\+) (exec-add1 w)] - [(char=? inst #\-) (exec-sub1 w)] - [(char=? inst #\<) (exec-tape-left w)] - [(char=? inst #\>) (exec-tape-right w)] - [(char=? inst #\[) (exec-loop-start w)] - [(char=? inst #\]) (exec-loop-end w)] - [(char=? inst #\.) (exec-out w)]) done get-input)])])) +; Tests for get-input +(test-begin + (exec-in + (prog-state (list 0) 0 1 "," "" 0) + (lambda (done) (done 50)) + (lambda (w) (check-equal? w (prog-state (list 50) 0 1 "," "" 1))))) + +; execute: ProgState (ProgState -> _) ((Byte -> _) -> _) -> _ +; Given an initial ProgState state, calls done when the final ProgState has been +; computed by executing the program +(define (execute prog done get-input) + + ; execute-sync: Char ProgState -> ProgState + ; Given a synchronous instruction as a Char and the current ProgState, + ; returns the new ProgState by executing the instruction. + (define (execute-sync inst w) + (cond [(char=? inst #\+) (exec-add1 w)] + [(char=? inst #\-) (exec-sub1 w)] + [(char=? inst #\<) (exec-tape-left w)] + [(char=? inst #\>) (exec-tape-right w)] + [(char=? inst #\[) (exec-loop-start w)] + [(char=? inst #\]) (exec-loop-end w)] + [(char=? inst #\.) (exec-out w)])) + + ; The program length in characters + (define program-len (string-length (prog-state-program prog))) + + ; execute-help: ProgState -> _ + ; 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)] + [else + ; 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)))] + [else (execute (execute-sync inst w) done get-input)])])) + + (execute-help prog)) ; Tests for execute -(check-expect (execute (prog-state (list 0) 0 3 "" "" 0)) - (prog-state (list 0) 0 3 "" "" 0)) -; assert that 5+2 to ASCII = "7" (WTF) -(check-expect (execute (prog-state (list 0) 0 1 "" - "++>+++++[<+>-]++++++++[<++++++>-]<." 0)) - (prog-state (list 55 0) 0 2 "7" - "++>+++++[<+>-]++++++++[<++++++>-]<." 35)) -; Run tests -(test) +(test-begin + (execute + (prog-state (list 0) 0 3 "" "" 0) + (lambda (w) (check-equal? w (prog-state (list 0) 0 3 "" "" 0))) + (lambda (done) (done 0)))) +; assert that 5+2 to ASCII = "7" +(test-begin + (execute + (prog-state (list 0) 0 1 "" "++>+++++[<+>-]++++++++[<++++++>-]<." 0) + (lambda (w) + (check-equal? w (prog-state (list 55 0) 0 2 "7" + "++>+++++[<+>-]++++++++[<++++++>-]<." 35))) + (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))) + (lambda (done) (done 49)))) ; ASCII for "1" +