updated world structure
added error-code function and fixed tests accordingly
This commit is contained in:
parent
854949641c
commit
6edbb8bf76
1 changed files with 102 additions and 66 deletions
168
interpreter.rkt
168
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<ErrorCode>
|
||||
; 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<Symbol> -> 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"
|
||||
|
||||
|
|
Loading…
Reference in a new issue