464 lines
17 KiB
Racket
464 lines
17 KiB
Racket
#lang racket
|
|
; vim: set tw=80 :
|
|
|
|
; 2018-11-21 - Made by Claudio Maggioni - Tommaso Rodolfo Masera
|
|
; easybf
|
|
|
|
(require racket/base
|
|
racket/struct
|
|
rackunit)
|
|
|
|
(provide (struct-out prog-state)
|
|
execute-instr
|
|
execute
|
|
string->program
|
|
program->prog-state)
|
|
|
|
; A Byte is an Int between 0 and 255
|
|
; Interpretation: a byte in decimal notation.
|
|
|
|
; A Tape is a NEList<Byte>
|
|
; Interpretation: a tape in brainf*ck's Turing machine.
|
|
|
|
; A DataPointer (DP) is a NonNegInt
|
|
; Interpretation: a data pointer in the brainf*ck language in a tape.
|
|
|
|
; A Program is a String of:
|
|
; - ">" (tape-right)
|
|
; - "<" (tape-left)
|
|
; - "+" (add1)
|
|
; - "-" (sub1)
|
|
; - "." (out)
|
|
; - "," (in)
|
|
; - "[" (loop-start)
|
|
; - "]" (loop-end)
|
|
; Interpretation: the brainf*ck program.
|
|
|
|
; A InstructionPointer (IP) is a NonNegInt
|
|
; Interpretation: a pointer to the instruction to execute.
|
|
|
|
; An ErrorCode is one of:
|
|
; - 'error1 (Interp: negative tape position when <)
|
|
; - 'error2 (Interp: non-matching [)
|
|
; - 'error3 (Interp: non-matching ])
|
|
; Interp: an error code for the bf interpreter.
|
|
|
|
; A ProgState is a (prog-state tape dp output program ip) where:
|
|
; - tape: Tape
|
|
; - dp: DataPointer
|
|
; - tape-len: Nat
|
|
; - output: String
|
|
; - program: Program
|
|
; - ip: InstructionPointer
|
|
; - error: Option<String>
|
|
; Interpretation: the current state of execution of a brainf*ck program.
|
|
(struct prog-state (tape dp tape-len output program ip error)
|
|
#:transparent
|
|
#:methods gen:custom-write
|
|
[(define write-proc
|
|
(make-constructor-style-printer
|
|
(lambda (w) 'ProgState)
|
|
(lambda (w) (list (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)))))])
|
|
|
|
; 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-error w)))
|
|
|
|
; string->program: String -> Program
|
|
; Given a string, returns a bf program without any invalid character
|
|
(define (string->program s)
|
|
(local [; valid-char: Char -> Boolean
|
|
; Given a valid-char, returns #t if the character is a valid bf
|
|
; instruction.
|
|
(define (valid-char? s)
|
|
(ormap (lambda (x) (char=? s x))
|
|
'(#\> #\< #\+ #\- #\, #\. #\[ #\])))]
|
|
(list->string (filter valid-char? (string->list s)))))
|
|
|
|
; Tests for 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
|
|
(define (add1-byte b)
|
|
(modulo (add1 b) 256))
|
|
|
|
; Tests for add1-byte
|
|
(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
|
|
(define (sub1-byte b)
|
|
(cond [(zero? b) 255]
|
|
[else (sub1 b)]))
|
|
|
|
; Tests for sub1-byte
|
|
(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.
|
|
(define (program->prog-state p)
|
|
(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 #f))
|
|
|
|
; tape-help: Tape DP (Byte -> Byte) -> Tape
|
|
; Given a tape and a data pointer, returns the same tape with the data in the
|
|
; location of the data pointer altered by the function `alter`.
|
|
(define (tape-help tape dp alter)
|
|
(cond [(zero? dp) (cons (alter (first tape)) (rest tape))]
|
|
[else (cons (first tape) (tape-help (rest tape) (sub1 dp) alter))]))
|
|
|
|
; Tests for tape-help
|
|
(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."]
|
|
[(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.")
|
|
(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
|
|
(define (exec-add1 w)
|
|
(prog-state (tape-help (prog-state-tape w) (prog-state-dp w) add1-byte)
|
|
(prog-state-dp w)
|
|
(prog-state-tape-len w)
|
|
(prog-state-output w)
|
|
(prog-state-program w)
|
|
(add1 (prog-state-ip w))
|
|
#f))
|
|
|
|
; Tests for exec-add1
|
|
(check-equal? (exec-add1 (prog-state
|
|
(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 #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
|
|
(define (exec-sub1 w)
|
|
(prog-state (tape-help (prog-state-tape w) (prog-state-dp w) sub1-byte)
|
|
(prog-state-dp w)
|
|
(prog-state-tape-len w)
|
|
(prog-state-output w)
|
|
(prog-state-program w)
|
|
(add1 (prog-state-ip w))
|
|
#f))
|
|
|
|
; Tests for exec-sub1
|
|
(check-equal? (exec-sub1 (prog-state
|
|
(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 #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)
|
|
(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) #f)))
|
|
|
|
; 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 #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
|
|
(define (exec-tape-right w)
|
|
(define end-of-tape (= (prog-state-dp w) (sub1 (prog-state-tape-len w))))
|
|
(prog-state
|
|
(if end-of-tape
|
|
(append (prog-state-tape w) (list 0))
|
|
(prog-state-tape w))
|
|
(add1 (prog-state-dp w))
|
|
(if end-of-tape
|
|
(add1 (prog-state-tape-len w))
|
|
(prog-state-tape-len w))
|
|
(prog-state-output w)
|
|
(prog-state-program w)
|
|
(add1 (prog-state-ip w))
|
|
#f))
|
|
|
|
; Tests for exec-tape-right
|
|
(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
|
|
(define (exec-out w)
|
|
(prog-state
|
|
(prog-state-tape w)
|
|
(prog-state-dp w)
|
|
(prog-state-tape-len w)
|
|
(string-append
|
|
(prog-state-output w)
|
|
(list->string
|
|
(list (integer->char (list-ref (prog-state-tape w) (prog-state-dp w))))))
|
|
(prog-state-program w)
|
|
(add1 (prog-state-ip w))
|
|
#f))
|
|
|
|
; Tests for exec-out
|
|
(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
|
|
; - 'backward
|
|
; Interpretation: the direction to walk the Brainf*ck Program with.
|
|
|
|
; 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)
|
|
|
|
(define brkt (if (symbol=? wd 'forward) #\] #\[))
|
|
(define oppos-brkt (if (symbol=? wd 'forward) #\[ #\]))
|
|
(define upd-start (if (symbol=? wd 'forward) add1 sub1))
|
|
|
|
; 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. #f is returned
|
|
; when the search for the matching paren overflows out of the string.
|
|
(define (fm-helper s nest)
|
|
(with-handlers ([exn:fail:contract? (lambda (e) #f)])
|
|
(cond
|
|
[(and (zero? nest) (char=? (string-ref prg s) brkt))
|
|
s]
|
|
[(char=? (string-ref prg s) oppos-brkt)
|
|
(fm-helper (upd-start s) (add1 nest))]
|
|
[(char=? (string-ref prg s) brkt)
|
|
(fm-helper (upd-start s) (sub1 nest))]
|
|
[else
|
|
(fm-helper (upd-start s) nest)])))
|
|
|
|
(fm-helper (upd-start start) 0))
|
|
|
|
; Tests for find-matching
|
|
(check-equal? (find-matching "[++++++---->><-]++++]+--" 0 'forward)
|
|
15)
|
|
(check-equal? (find-matching "[+++++][+---->><-]++++]+--" 7 'forward)
|
|
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)
|
|
(if (number? pos-or-f) (add1 pos-or-f) (prog-state-ip w))
|
|
(if (number? pos-or-f) #f (error-code 'error2))))
|
|
|
|
; Tests for exec-loop-start
|
|
(check-equal? (exec-loop-start
|
|
(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 #f))
|
|
(prog-state '(1) 0 1 "" "[++--]++--+-[]" 1 #f))
|
|
|
|
; 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)
|
|
(if (number? pos-or-f) (add1 pos-or-f) (prog-state-ip w))
|
|
(if (number? pos-or-f) #f (error-code 'error3))))
|
|
|
|
; Tests for exec-loop-end
|
|
(check-equal? (exec-loop-end
|
|
(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 #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
|
|
; 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))
|
|
(prog-state-dp w)
|
|
(prog-state-tape-len w)
|
|
(prog-state-output w)
|
|
(prog-state-program 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 #f)
|
|
(lambda (done) (done 50))
|
|
(lambda (w) (check-equal? w (prog-state (list 50) 0 1 "," "" 1 #f)))))
|
|
|
|
; execute-instr: ProgState (Option<ProgState> -> _) ((Byte -> _) -> _) -> _
|
|
; Given an initial ProgState state, an async function to get input and a "done"
|
|
; callback, calls done with the ProgState updated after executing one
|
|
; instruction. If the program is at the last step of execution, calls done with
|
|
; #f
|
|
(define (execute-instr 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)]))
|
|
|
|
(cond [(eq? (prog-state-error prog) #f)
|
|
; Fetch current instr.. If the char is out of range, call done with #f
|
|
(with-handlers ([exn:fail:contract? (lambda (e) (done #f))])
|
|
(define inst (string-ref (prog-state-program prog)
|
|
(prog-state-ip prog)))
|
|
|
|
; Execute asynchr. if ",", otherwise call callback with results of
|
|
; execute-sync
|
|
(cond [(char=? inst #\,) (exec-in prog get-input done)]
|
|
[else (done (execute-sync inst prog))]))]
|
|
[else (done #f)]))
|
|
|
|
|
|
; 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-help: ProgState ProgState -> _
|
|
; Helper function for `execute`.
|
|
; Given an initial ProgState state, and the previous state,
|
|
; calls done when the final ProgState is ready.
|
|
(define (execute-help w prev)
|
|
(cond [(eq? w #f) (done prev)]
|
|
[else (execute-instr w (lambda (new) (execute-help new w))
|
|
get-input)]))
|
|
|
|
(execute-instr prog (lambda (new) (execute-help new prog)) get-input))
|
|
|
|
; Tests for execute
|
|
(test-begin
|
|
(execute
|
|
(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 #f)
|
|
(lambda (w)
|
|
(check-equal? w (prog-state (list 55 0) 0 2 "7"
|
|
"++>+++++[<+>-]++++++++[<++++++>-]<." 35 #f)))
|
|
(lambda (done) (done 0))))
|
|
(test-begin
|
|
(execute
|
|
(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"
|
|
|