205 lines
6.6 KiB
Racket
205 lines
6.6 KiB
Racket
;; 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-intermediate-lambda-reader.ss" "lang")((modname main) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f)))
|
|
; 2018-11-21 - Made by Claudio Maggioni - Tommaso Rodolfo Masera
|
|
|
|
; easybf
|
|
(require 2htdp/batch-io)
|
|
(require 2htdp/image)
|
|
(require 2htdp/universe)
|
|
|
|
; 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)
|
|
; - ","
|
|
; - "["
|
|
; - "]"
|
|
; Interpretation: the brainf*ck program.
|
|
|
|
; A InstructionPointer (IP) is a NonNegInt
|
|
; Interpretation: a pointer to the instruction to execute.
|
|
|
|
; A World is a (make-world tape dp output program ip) where:
|
|
; - tape: Tape
|
|
; - dp: DataPointer
|
|
; - tape-len: Nat
|
|
; - output: String
|
|
; - program: Program
|
|
; - ip: InstructionPointer
|
|
; Interpretation: the current state of execution of a brainf*ck program.
|
|
(define-struct world [tape dp tape-len output program ip])
|
|
|
|
; Template function for World
|
|
(define (fn-for-world w)
|
|
(... (world-tape w)
|
|
(world-dp w)
|
|
(world-tape-len w)
|
|
(world-output w)
|
|
(world-program w)
|
|
(world-ip w)))
|
|
|
|
; string->program: String -> Program
|
|
; Given a string, returns a b(world-dp-len w)f program without any invalid character
|
|
(define (string->program s)
|
|
(local [; valid-char: 1String -> Boolean
|
|
; Given a valid-char, returns #t if the character is a valid bf
|
|
; instruction.
|
|
(define (valid-char? s)
|
|
(member? s '(">" "<" "+" "-" "," "." "[" "]")))]
|
|
(implode (filter valid-char? (explode s)))))
|
|
|
|
; Tests for string->program
|
|
(check-expect (string->program "hello") "")
|
|
(check-expect (string->program "+world50-[]") "+-[]")
|
|
(check-expect (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-expect (add1-byte 255) 0)
|
|
(check-expect (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-expect (sub1-byte 0) 255)
|
|
(check-expect (sub1-byte 1) 0)
|
|
|
|
; program->world: Program -> World
|
|
; Given a program, returns the corresponding initial world state.
|
|
(define (program->world p)
|
|
(make-world (cons 0 '()) 0 1 "" p 0))
|
|
|
|
; Tests for program->world
|
|
(check-expect (program->world "[->+<]") (make-world (list 0) 0 1 "" "[->+<]" 0))
|
|
|
|
; 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-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))
|
|
|
|
; exec-add1: World -> World
|
|
; Given a world, returns a new world with the + instruction executed
|
|
(define (exec-add1 w)
|
|
(make-world (tape-help (world-tape w) (world-dp w) add1-byte)
|
|
(world-dp w)
|
|
(world-tape-len w)
|
|
(world-output w)
|
|
(world-program w)
|
|
(add1 (world-ip w))))
|
|
|
|
; exec-sub1: World -> World
|
|
; Given a world, returns a new world with the - instruction executed
|
|
(define (exec-sub1 w)
|
|
(make-world (tape-help (world-tape w) (world-dp w) sub1-byte)
|
|
(world-dp w)
|
|
(world-tape-len w)
|
|
(world-output w)
|
|
(world-program w)
|
|
(add1 (world-ip w))))
|
|
|
|
; exec-tape-left: World -> World
|
|
; Given a world, returns a new world with the < instruction executed
|
|
(define (exec-tape-left w)
|
|
(if (zero? (world-dp w))
|
|
(error "Can't access negative tape positions")
|
|
(make-world (world-tape w)
|
|
(sub1 (world-dp w))
|
|
(world-tape-len w)
|
|
(world-output w)
|
|
(world-program w)
|
|
(add1 (world-ip w)))))
|
|
|
|
; exec-tape-right: World -> World
|
|
; Given a world, returns a new world with the > instruction executed
|
|
(define (exec-tape-right w)
|
|
(local [(define end-of-tape (= (world-dp w) (sub1 (world-tape-len w))))]
|
|
(make-world
|
|
(if end-of-tape
|
|
(cons (world-tape w) 0)
|
|
(world-tape w))
|
|
(add1 (world-dp w))
|
|
(if end-of-tape
|
|
(add1 (world-tape-len w))
|
|
(world-tape-len w))
|
|
(world-output w)
|
|
(world-program w)
|
|
(add1 (world-ip w)))))
|
|
|
|
; exec-out: World -> World
|
|
; Given a world, returns a new world with the . instruction executed
|
|
(define (exec-out w)
|
|
(make-world
|
|
(world-tape w)
|
|
(world-dp w)
|
|
(world-tape-len w)
|
|
(string-append
|
|
(world-output w)
|
|
(list->string
|
|
(list (integer->char (list-ref (world-tape w) (world-dp w))))))
|
|
(world-program w)
|
|
(add1 (world-ip w))))
|
|
|
|
; find-first: 1String String Nat -> Nat
|
|
(define (find-first char string start)
|
|
(cond [(string=? (substring string start (add1 start)) char) start]
|
|
[else (find-first char string (add1 start))]))
|
|
|
|
; exec-loop-start: World -> World
|
|
; Given a world, returns a new world with the [ instruction executed
|
|
(define (exec-loop-start w)
|
|
(local [(define jump (zero? (list-ref (world-tape w) (world-dp w))))]
|
|
(make-world
|
|
(world-tape w)
|
|
(world-dp w)
|
|
(world-tape-len w)
|
|
(world-output w)
|
|
(world-program w)
|
|
(add1 (if jump
|
|
(find-first "]" (world-program w) (world-ip w))
|
|
(world-ip w))))))
|
|
|
|
; Tests for exec-out
|
|
(check-expect (exec-out (make-world (list 50) 0 1 "" ".[->+<]" 0))
|
|
(make-world (list 50) 0 1 "2" ".[->+<]" 1))
|
|
(check-expect (exec-out (make-world (list 65) 0 1 "" ".[->+<]" 0))
|
|
(make-world (list 65) 0 1 "A" ".[->+<]" 1))
|
|
|
|
; main: Filename -> World
|
|
; Given a Filename, return the last world state of execution of the
|
|
; corresponding bf program in the file
|
|
(define (main file)
|
|
(program->world (string->program (read-file file))))
|
|
|
|
; TODO:
|
|
; - big-bang:
|
|
; - - - - - - inital state (make-world (list 0) 0 "" <program> 0)
|
|
; - - - - - - on-tick fetch, decode, execute
|
|
; - - - - - - on-key for ","
|
|
; - - - - - - (on-mouse for stepper)
|
|
; - - - - - - (draw-scene for output and tape)
|