;; The first three lines of this file were inserted by DrRacket. They record metadata ;; about the language level of this file in a form that our tools can easily process. #reader(lib "htdp-beginner-abbr-reader.ss" "lang")((modname brainfuck) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) ; ============= ; === ABOUT === ; ============= ; DrRacket source code. ; Written by Jonathan Frech; December 2017, January 2018. ; ; This Brainfuck interpreter interprets a given Brainfuck source code. ; ; Hyperlinks regarding the Turing tarpit in question: ; * https://en.wikipedia.org/wiki/Brainfuck ; * https://esolangs.org/wiki/Brainfuck ; ================ ; === REQUIRES === ; ================ ; I require abstraction. (require 2htdp/abstraction) ; ======================== ; === DATA DEFINITIONS === ; ======================== ; A TapeData is a List-of-Integers. ; interp.: A tape's cells. ; A TapePointer is a Number. ; interp.: A tape's current cell pointer. ; A CodeData is a String. ; interp.: A code's source code data. ; A CodePointer is a String. ; interp.: A code's current instruction pointer. ; An Input is a String. ; interp.: A Brainfuck program's input. ; An InputPointer is a String. ; interp.: A Brainfuck program's input's current pointer. ; An Ouput is a String. ; interp.: A Brainfuck program's current output. ; A Tape is a (make-tape TapeData TapePointer). ; interp.: The Brainfuck tape. (define-struct tape (data pointer)) ; A Code is a (make-code CodeData CodePointer). ; interp.: The Brainfuck code. (define-struct code (data pointer)) ; An I/o is a (make-i/o Input InputPointer Ouput). ; interp.: The Brainfuck input and output. (define-struct i/o (input inputpointer output)) ; A Program is a (make-program Tape Code I/o). ; interp.: A full Brainfuck program, ready to execute. (define-struct program (tape code i/o)) ; an empty tape and an empty i/o (define EMPTY-TAPE (make-tape '(0) 0)) (define EMPTY-I/O (make-i/o "" 0 "")) ; ===================== ; === MISCELLANEOUS === ; ===================== ; Code -> Character ; Returns the current instruction character. (define (currentinstruction code) (cond [(in-range? (code-pointer code) 0 (sub1 (string-length (code-data code)))) (string-ref (code-data code) (code-pointer code))] [#t (error "Code too short.")])) (check-expect (currentinstruction (make-code "abcd" 2)) #\c) (check-error (currentinstruction (make-code "abcd" 4))) (check-error (currentinstruction (make-code "" 0))) ; List-of-Integers Integer -> Integer ; Returns the i-th element of the list. (define (list-index lst i) (cond [(empty? lst) (error "List too short.")] [(zero? i) (first lst)] [#t (list-index (rest lst) (sub1 i))])) (check-expect (list-index '(1 2 3 4) 2) 3) (check-error (list-index '(-1 -78 5) -1)) ; List-of-Integers Integer Integer -> List-of-Integers ; Set the list's i-th value to v. (define (list-set lst i v) (cond [(empty? lst) (error "List too short.")] [(zero? i) (cons (modulo v 256) (rest lst))] [#t (cons (first lst) (list-set (rest lst) (- i 1) v))])) (check-expect (list-set '(0 0 0) 1 3) '(0 3 0)) (check-error (list-set empty 3 9)) ; List-of-Integers Integer Integer -> List-of-Integers ; Add v to the list's i-th position. (define (list-add lst i v) (cond [(empty? lst) (error "List too short.")] [(zero? i) (cons (modulo (+ (first lst) v) 256) (rest lst))] [#t (cons (first lst) (list-add (rest lst) (- i 1) v))])) (check-expect (list-add '(1 2 3) 1 10) '(1 12 3)) (check-error (list-add '(0 1 2) 100 9)) ; List-of-Integers Integer Integer -> List-of-Integer ; Insert a v at i-th position into list. (define (list-insert lst i v) (cond [(cons? lst) (cond [(zero? i) (cons v (cons (first lst) (rest lst)))] [(> i 0) (cons (first lst) (list-insert (rest lst) (sub1 i) v))])] [(and (empty? lst) (zero? i)) (cons v empty)] [#t (error "List too short.")])) (check-expect (list-insert empty 0 1) '(1)) (check-expect (list-insert '(0 0 0 0) 2 1) '(0 0 1 0 0)) (check-error (list-insert empty 1 0)) ; Integer Integer Integer -> Boolean ; Check whether or not v is in between a and b. (define (in-range? v a b) (and (>= v a) (<= v b))) (check-expect (in-range? 1 1 1) #t) (check-expect (in-range? 1 1 0) #f) ; Char -> String ; Convert a character to a 1-length string. (define (char->string c) (list->string (cons c empty))) (check-expect (char->string #\B) "B") (check-expect (char->string #\r) "r") (check-expect (char->string #\a) "a") (check-expect (char->string #\i) "i") (check-expect (char->string #\n) "n") (check-expect (char->string #\f) "f") (check-expect (char->string #\u) "u") (check-expect (char->string #\c) "c") (check-expect (char->string #\k) "k") ; ======================= ; === EXECUTION ATOMS === ; ======================= ; Code -> Code ; Increments the code pointer by one. (define (codestep code) (make-code (code-data code) (add1 (code-pointer code)))) (check-expect (codestep (make-code "code" 3)) (make-code "code" 4)) ; Program -> Program ; Increments a program's code pointer by one. (define (programcodestep program) (make-program (program-tape program) (codestep (program-code program)) (program-i/o program))) (check-expect (programcodestep (make-program EMPTY-TAPE (make-code "<>>>>><>" 3) EMPTY-I/O)) (make-program EMPTY-TAPE (make-code "<>>>>><>" 4) EMPTY-I/O)) ; Code -> Boolean ; Checks whether or not the code string's end is reached. (define (codeend? code) (>= (code-pointer code) (string-length (code-data code)))) ; I/o -> Integer ; Returns the current input as an integer. If input string is too short, return zero. (define (currentinput i/o) (cond [(in-range? (i/o-inputpointer i/o) 0 (sub1 (string-length (i/o-input i/o)))) (char->integer (string-ref (i/o-input i/o) (i/o-inputpointer i/o)))] [#t 0])) (check-expect (currentinput (make-i/o "input" 3 "out... out... output!")) 117) (check-expect (currentinput EMPTY-I/O) 0) ; Tape -> Integer ; Returns the value of the current cell. (define (currentcell tape) (cond [(in-range? (tape-pointer tape) 0 (sub1 (length (tape-data tape)))) (list-index (tape-data tape) (tape-pointer tape))] [#t (error "Illegal tape pointer position.")])) (check-expect (currentcell EMPTY-TAPE) 0) (check-expect (currentcell (make-tape '(56 99 3) 1)) 99) (check-error (currentcell (make-tape '(6 38 90) 3))) ; ===================== ; === VISUALIZATION === ; ===================== ; List-of-Integers -> String ; Turn a list of integers into a string representation of that list. (define (list-of-integers->string lst) (cond [(cons? lst) (string-append (number->string (first lst)) " | " (list-of-integers->string (rest lst)))] [#t ""])) (check-expect (list-of-integers->string '(1 7 99 0)) "1 | 7 | 99 | 0 | ") ; Program -> String ; Return a string representing the program's current state (output and tape). (define (visualizedebug program) (string-append "Output: '" (i/o-output (program-i/o program)) "', Tape: { | " (list-of-integers->string (tape-data (program-tape program))) "} (pointing at " (number->string (tape-pointer (program-tape program))) ")")) (check-expect (visualizedebug (make-program (make-tape '(6 7 4) 1) (make-code ",NOP." 2) (make-i/o "!" 0 ""))) "Output: '', Tape: { | 6 | 7 | 4 | } (pointing at 1)") ; ================= ; === OPERATORS === ; ================= ; '+' ; Tape -> Tape ; Executes the PLS operation on tape. (define (tapePLS tape) (make-tape (list-add (tape-data tape) (tape-pointer tape) 1) (tape-pointer tape))) (check-expect (tapePLS (make-tape '(1 3 2) 1)) (make-tape '(1 4 2) 1)) (check-expect (tapePLS (make-tape '(1 3 2) 2)) (make-tape '(1 3 3) 2)) (check-expect (tapePLS (make-tape '(255) 0)) EMPTY-TAPE) (check-error (tapePLS (make-tape empty 3))) ; Program -> Program ; Executes the PLS (plus, '+') operation. (define (operatorPLS program) (make-program (tapePLS (program-tape program)) (codestep (program-code program)) (program-i/o program))) ; '-' ; Tape -> Tape ; Executes the MNS operation on tape. (define (tapeMNS tape) (make-tape (list-add (tape-data tape) (tape-pointer tape) -1) (tape-pointer tape))) (check-expect (tapeMNS (make-tape '(1 3 2) 1)) (make-tape '(1 2 2) 1)) (check-expect (tapeMNS (make-tape '(1 3 2) 2)) (make-tape '(1 3 1) 2)) (check-expect (tapeMNS EMPTY-TAPE) (make-tape '(255) 0)) (check-error (tapeMNS (make-tape empty 0))) ; Program -> Program ; Executes the MNS (minus, '-') operation. (define (operatorMNS program) (make-program (tapeMNS (program-tape program)) (codestep (program-code program)) (program-i/o program))) ; '<' ; Tape -> Tape ; Executes the LFT operation on tape. (define (tapeLFT tape) (cond [(zero? (tape-pointer tape)) (make-tape (cons 0 (tape-data tape)) 0)] [(in-range? (tape-pointer tape) 1 (sub1 (length (tape-data tape)))) (make-tape (tape-data tape) (sub1 (tape-pointer tape)))] [#t (error "Illegal tape pointer position.")])) (check-expect (tapeLFT (make-tape empty 0)) EMPTY-TAPE) (check-expect (tapeLFT (make-tape '(1 2 3) 2)) (make-tape '(1 2 3) 1)) (check-expect (tapeLFT (make-tape '(1 2 3) 1)) (make-tape '(1 2 3) 0)) (check-expect (tapeLFT (make-tape '(1 2 3) 0)) (make-tape '(0 1 2 3) 0)) (check-error (tapeLFT (make-tape empty -1))) ; Program -> Program ; Executes the LFT (left, '<') operation. (define (operatorLFT program) (make-program (tapeLFT (program-tape program)) (codestep (program-code program)) (program-i/o program))) ; '>' ; Tape -> Tape ; Executes the RGT operation on tape. (define (tapeRGT tape) (cond [(or (= (tape-pointer tape) (sub1 (length (tape-data tape)))) (and (empty? (tape-data tape)) (zero? (tape-pointer tape)))) (make-tape (list-insert (tape-data tape) (length (tape-data tape)) 0) (length (tape-data tape)))] [(in-range? (tape-pointer tape) 0 (- (length (tape-data tape)) 2)) (make-tape (tape-data tape) (add1 (tape-pointer tape)))] [#t (error "Illegal tape pointer position.")])) (check-expect (tapeRGT (make-tape empty 0)) EMPTY-TAPE) (check-expect (tapeRGT (make-tape '(1 2 3) 2)) (make-tape '(1 2 3 0) 3)) (check-expect (tapeRGT (make-tape '(1 2 3) 1)) (make-tape '(1 2 3) 2)) (check-expect (tapeRGT (make-tape '(1 2 3) 0)) (make-tape '(1 2 3) 1)) (check-error (tapeRGT (make-tape empty 1))) ; Program -> Program ; Executes the RGT (right, '>') operation. (define (operatorRGT program) (make-program (tapeRGT (program-tape program)) (codestep (program-code program)) (program-i/o program))) ; '[' ; Code Number -> Code ; Moves the code pointer to the loop's end. Call with n equal to -1. (define (loopskip code n) (cond [(char=? (currentinstruction code) #\]) (if (zero? n) code (loopskip (codestep code) (sub1 n)))] [(char=? (currentinstruction code) #\[) (loopskip (codestep code) (add1 n))] [#t (loopskip (codestep code) n)])) (check-expect (loopskip (make-code "[]" 0) -1) (make-code "[]" 1)) (check-expect (loopskip (make-code "[[]]" 0) -1) (make-code "[[]]" 3)) (check-expect (loopskip (make-code "[[[]]]" 0) -1) (make-code "[[[]]]" 5)) (check-expect (loopskip (make-code "[[[]]]" 1) -1) (make-code "[[[]]]" 4)) (check-expect (loopskip (make-code "[..[[..].]...]" 3) -1) (make-code "[..[[..].]...]" 9)) ; Program -> Program ; Executes the LPS (loop start, '[') instruction. (define (operatorLPS program) (if (zero? (currentcell (program-tape program))) (make-program (program-tape program) (loopskip (program-code program) -1) (program-i/o program)) (programcodestep program))) ; ']' ; Code Number -> Code ; Moves the code pointer back to the loop's start. Call with n equal to -1. (define (loopback code n) (cond [(char=? (currentinstruction code) #\[) (if (zero? n) code (loopback (make-code (code-data code) (sub1 (code-pointer code))) (sub1 n)))] [(char=? (currentinstruction code) #\]) (loopback (make-code (code-data code) (sub1 (code-pointer code))) (add1 n))] [#t (loopback (make-code (code-data code) (sub1 (code-pointer code))) n)])) (check-expect (loopback (make-code "[]" 1) -1) (make-code "[]" 0)) (check-expect (loopback (make-code "[[]]" 3) -1) (make-code "[[]]" 0)) (check-expect (loopback (make-code "[[[]]]" 5) -1) (make-code "[[[]]]" 0)) (check-expect (loopback (make-code "[[[]]]" 4) -1) (make-code "[[[]]]" 1)) (check-expect (loopback (make-code "[..[[..].]...]" 9) -1) (make-code "[..[[..].]...]" 3)) ; Program -> Program ; Executes the LPE (loop end, ']') instruction. (define (operatorLPE program) (if (not (zero? (currentcell (program-tape program)))) (make-program (program-tape program) (loopback (program-code program) -1) (program-i/o program)) (programcodestep program))) ; '.' ; Program -> Program ; Executes the OUT (output, '.') instruction. (define (operatorOUT program) (make-program (program-tape program) (codestep (program-code program)) (make-i/o (i/o-input (program-i/o program)) (i/o-inputpointer (program-i/o program)) (string-append (i/o-output (program-i/o program)) (char->string (integer->char (currentcell (program-tape program)))))))) (check-expect (operatorOUT (make-program (make-tape '(100 101 102) 1) (make-code "><." 3) (make-i/o "inputting..." 4 "OUT:"))) (make-program (make-tape '(100 101 102) 1) (make-code "><." 4) (make-i/o "inputting..." 4 "OUT:e"))) ; ',' ; Program -> Program ; Executes the INP (input, ',') instruction. (define (operatorINP program) (make-program (make-tape (list-set (tape-data (program-tape program)) (tape-pointer (program-tape program)) (currentinput (program-i/o program))) (tape-pointer (program-tape program))) (codestep (program-code program)) (make-i/o (i/o-input (program-i/o program)) (add1 (i/o-inputpointer (program-i/o program))) (i/o-output (program-i/o program))))) (check-expect (operatorINP (make-program EMPTY-TAPE (make-code ",<>" 0) (make-i/o "a" 0 ""))) (make-program (make-tape '(97) 0) (make-code ",<>" 1) (make-i/o "a" 1 ""))) ; ================= ; === EXECUTION === ; ================= ; Program -> Program ; Executes a given program until the code's end is reached. ; Returns the final program state. Does try to evaluate non-halting ; programs; does not halt after a certain maximum amount of iterations. (define (execute program) (if (codeend? (program-code program)) program (execute (match (currentinstruction (program-code program)) [#\+ (operatorPLS program)] [#\- (operatorMNS program)] [#\< (operatorLFT program)] [#\> (operatorRGT program)] [#\[ (operatorLPS program)] [#\] (operatorLPE program)] [#\. (operatorOUT program)] [#\, (operatorINP program)] [else (programcodestep program)])))) (check-expect (execute (make-program EMPTY-TAPE (make-code "+" 0) EMPTY-I/O)) (make-program (make-tape '(1) 0) (make-code "+" 1) EMPTY-I/O)) (check-expect (execute (make-program EMPTY-TAPE (make-code "+--" 0) EMPTY-I/O)) (make-program (make-tape '(255) 0) (make-code "+--" 3) EMPTY-I/O)) (check-expect (execute (make-program EMPTY-TAPE (make-code "+--->+<<-" 0) EMPTY-I/O)) (make-program (make-tape '(255 254 1) 0) (make-code "+--->+<<-" 9) EMPTY-I/O)) (check-expect (execute (make-program EMPTY-TAPE (make-code "[>>> [T]his <<< gets [+++] ignored ...]+" 0) EMPTY-I/O)) (make-program (make-tape '(1) 0) (make-code "[>>> [T]his <<< gets [+++] ignored ...]+" 40) EMPTY-I/O)) (check-expect (execute (make-program EMPTY-TAPE (make-code "[+]+>++++[-]" 0) EMPTY-I/O)) (make-program (make-tape '(1 0) 1) (make-code "[+]+>++++[-]" 12) EMPTY-I/O)) (check-expect (execute (make-program EMPTY-TAPE (make-code ",+.,+.,+.[-]" 0) (make-i/o "abc" 0 ""))) (make-program EMPTY-TAPE (make-code ",+.,+.,+.[-]" 12) (make-i/o "abc" 3 "bcd"))) (check-expect (execute (make-program EMPTY-TAPE (make-code "The plus operator (+) adds one to the current cell." 0) EMPTY-I/O)) (make-program (make-tape '(1) 0) (make-code "The plus operator (+) adds one to the current cell." 51) (make-i/o "" 0 "\u0001"))) ; String -> String ; Interprets a given code string as Brainfuck source code and execute it. ; Returns the program's output string. (define (run code) (i/o-output (program-i/o (execute (make-program EMPTY-TAPE (make-code (string-append code "") 0) EMPTY-I/O))))) (check-expect (run " 0 === 'Hello World!' program === Source from https://esolangsorg/wiki/Brainfuck === 1 +++++ +++ Set Cell #0 to 8 2 [ 3 >++++ Add 4 to Cell #1; this will always set Cell #1 to 4 4 [ as the cell will be cleared by the loop 5 >++ Add 4*2 to Cell #2 6 >+++ Add 4*3 to Cell #3 7 >+++ Add 4*3 to Cell #4 8 >+ Add 4 to Cell #5 9 <<<<- Decrement the loop counter in Cell #1 10 ] Loop till Cell #1 is zero 11 >+ Add 1 to Cell #2 12 >+ Add 1 to Cell #3 13 >- Subtract 1 from Cell #4 14 >>+ Add 1 to Cell #6 15 [<] Move back to the first zero cell you find; this will 16 be Cell #1 which was cleared by the previous loop 17 <- Decrement the loop Counter in Cell #0 18 ] Loop till Cell #0 is zero 19 20 The result of this is: 21 Cell No : 0 1 2 3 4 5 6 22 Contents: 0 0 72 104 88 32 8 23 Pointer : ^ 24 25 >>. Cell #2 has value 72 which is 'H' 26 >---. Subtract 3 from Cell #3 to get 101 which is 'e' 27 +++++ ++..+++. Likewise for 'llo' from Cell #3 28 >>. Cell #5 is 32 for the space 29 <-. Subtract 1 from Cell #4 for 87 to give a 'W' 30 <. Cell #3 was set to 'o' from the end of 'Hello' 31 +++.----- -.----- ---. Cell #3 for 'rl' and 'd' 32 >>+. Add 1 to Cell #5 gives us an exclamation point 33 >++. And finally a newline from Cell #6") "Hello World!\n") ; String String -> String ; Interprets a given code string as Brainfuck source code and execute it with given input string. ; Returns the program's output string. (define (run/input code input) (i/o-output (program-i/o (execute (make-program EMPTY-TAPE (make-code (string-append code "") 0) (make-i/o input 0 "")))))) (check-expect (run/input ",>,+<.>." "~$") "~%") ; String String -> String ; Interprets a given code string as Brainfuck source code and execute it with given input string. ; Returns a string representation of the program's final state. (Used to debug and examine Brainfuck programs.) (define (run/debug code input) (visualizedebug (execute (make-program EMPTY-TAPE (make-code (string-append code "") 0) (make-i/o input 0 ""))))) (check-expect (run/debug "," "/") "Output: '', Tape: { | 47 | } (pointing at 0)")