maggicl/DrBrainf-ck
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Merge branch 'master' of github.com:usi-pf1-2018/pf1-project-workingffs

Browse source
This commit is contained in:
Claudio Maggioni 2018-12-04 10:10:28 +01:00
commit 70323a222f
1 changed files with 30 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
interpreter.rkt
View file

@ -112,7 +112,8 @@
(prog-state (cons 0 '()) 0 1 "" p 0)) (prog-state (cons 0 '()) 0 1 "" p 0))
; Tests for program->prog-state ; Tests for program->prog-state
(check-expect (program->prog-state "[->+<]") (prog-state (list 0) 0 1 "" "[->+<]" 0)) (check-expect
(program->prog-state "[->+<]") (prog-state (list 0) 0 1 "" "[->+<]" 0))
; tape-help: Tape DP (Byte -> Byte) -> Tape ; tape-help: Tape DP (Byte -> Byte) -> Tape
; Given a tape and a data pointer, returns the same tape with the data in the ; Given a tape and a data pointer, returns the same tape with the data in the
@ -177,15 +178,16 @@
(check-error (exec-tape-left (prog-state (list 1 2 3) 0 3 "" "<" 0))) (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-expect (exec-tape-left (prog-state (list 1 2 3) 2 3 "" "<" 0))
(prog-state (list 1 2 3) 1 3 "" "<" 1)) (prog-state (list 1 2 3) 1 3 "" "<" 1))
; exec-tape-right: ProgState -> ProgState ; exec-tape-right: ProgState -> ProgState
; Given a ProgState, returns a new ProgState with the > instruction executed ; Given a ProgState, returns a new ProgState with the > instruction executed
(define (exec-tape-right w) (define (exec-tape-right w)
(local [(define end-of-tape (= (prog-state-dp w) (sub1 (prog-state-tape-len w))))] (local [(define end-of-tape
(= (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))
@ -243,7 +245,7 @@
(define brkt (if (symbol=? wd 'forward) #\] #\[)) (define brkt (if (symbol=? wd 'forward) #\] #\[))
(define oppos-brkt (if (symbol=? wd 'forward) #\[ #\])) (define oppos-brkt (if (symbol=? wd 'forward) #\[ #\]))
(define upd-start (if (symbol=? wd 'forward) add1 sub1)) (define upd-start (if (symbol=? wd 'forward) add1 sub1))
; fm-helper Nat Nat -> Nat ; fm-helper Nat Nat -> Nat
; Given a starting position and a nest accumulator, returns the position of ; Given a starting position and a nest accumulator, returns the position of
; the matching bracket waking in the direction provided by updating the ; the matching bracket waking in the direction provided by updating the
@ -272,7 +274,8 @@
; exec-loop-start: ProgState -> ProgState ; exec-loop-start: ProgState -> ProgState
; Given a ProgState, returns a new ProgState with the [ instruction executed ; Given a ProgState, returns a new ProgState with the [ instruction executed
(define (exec-loop-start w) (define (exec-loop-start w)
(local [(define jump (zero? (list-ref (prog-state-tape w) (prog-state-dp w))))] (local [(define jump
(zero? (list-ref (prog-state-tape w) (prog-state-dp w))))]
(prog-state (prog-state
(prog-state-tape w) (prog-state-tape w)
(prog-state-dp w) (prog-state-dp w)
@ -280,7 +283,7 @@
(prog-state-output w) (prog-state-output w)
(prog-state-program w) (prog-state-program w)
(add1 (if jump (add1 (if jump
(find-matching (prog-state-program w) (prog-state-ip w) 'forward) (find-matching (prog-state-program w) (prog-state-ip w) 'forward)
(prog-state-ip w)))))) (prog-state-ip w))))))
; Tests for exec-loop-start ; Tests for exec-loop-start
@ -294,7 +297,8 @@
; exec-loop-end: ProgState -> ProgState ; exec-loop-end: ProgState -> ProgState
; Given a ProgState, returns a new ProgState with the ] instruction executed ; Given a ProgState, returns a new ProgState with the ] instruction executed
(define (exec-loop-end w) (define (exec-loop-end w)
(local [(define jump (not (zero? (list-ref (prog-state-tape w) (prog-state-dp w)))))] (local [(define jump
(not (zero? (list-ref (prog-state-tape w) (prog-state-dp w)))))]
(prog-state (prog-state
(prog-state-tape w) (prog-state-tape w)
(prog-state-dp w) (prog-state-dp w)
@ -302,7 +306,7 @@
(prog-state-output w) (prog-state-output w)
(prog-state-program w) (prog-state-program w)
(add1 (if jump (add1 (if jump
(find-matching (prog-state-program w) (prog-state-ip w) 'backward) (find-matching (prog-state-program w) (prog-state-ip w) 'backward)
(prog-state-ip w)))))) (prog-state-ip w))))))
; Tests for exec-loop-end ; Tests for exec-loop-end
@ -313,7 +317,23 @@
(prog-state '(1) 0 1 "" "[++--]++--+-[]" 5)) (prog-state '(1) 0 1 "" "[++--]++--+-[]" 5))
(prog-state '(1) 0 1 "" "[++--]++--+-[]" 1)) (prog-state '(1) 0 1 "" "[++--]++--+-[]" 1))
; execute: ProgState ((ProgState) -> Any) -> ProgState ; 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)
(define (got-input byte)
(done (prog-state
(insert-in-tape byte (prog-state-dp w))
(prog-state-dp w)
(prog-state-tape-len w)
(prog-state-output w)
(prog-state-program w)
(add1 (prog-state-ip w)))))
(get-input got-input))
; execute: ProgState ((ProgState) -> _) -> ProgState
; Given an initial ProgState state, calls done when the final ProgState is ready ; Given an initial ProgState state, calls done when the final ProgState is ready
; to execute the program. ; to execute the program.
(define (execute w done) (define (execute w done)