rktfck/rktfck/interpreter.rkt

118 lines
3.0 KiB
Racket
Executable File

#lang typed/racket
(require "types.rkt"
"parser.rkt")
(require threading)
(provide Interpreter
make-interpreter
interpreter-run
interpret)
(define-type Interpreter interpreter)
(struct interpreter
([left : Tape]
[current : Cell]
[right : Tape]
[program : Program])
#:transparent)
(: make-interpreter (-> Program Interpreter))
(define (make-interpreter program)
(interpreter '() 0 '() program))
(: cell-inc (-> Cell Cell))
(define (cell-inc x)
(cast (if (= x 255)
0
(+ x 1))
Cell))
(: cell-dec (-> Cell Cell))
(define (cell-dec x)
(cast (if (zero? x)
255
(- x 1))
Cell))
(: cell-input (-> Cell Cell))
(define (cell-input _)
(let ([b (read-byte)])
(if (eof-object? b)
0
b)))
(: interpreter-step (-> Interpreter Interpreter))
(define (interpreter-step i)
(define instruction (car (interpreter-program i)))
(define next-state (struct-copy interpreter i
[program (cdr (interpreter-program i))]))
(match instruction
['increment (modify-current next-state cell-inc)]
['decrement (modify-current next-state cell-dec)]
['input (modify-current next-state cell-input)]
['output (output next-state)]
['pointer-increment (pointer-increment next-state)]
['pointer-decrement (pointer-decrement next-state)]
[(list _ ...) (interpreter-loop next-state instruction)]))
(: interpreter-loop (-> Interpreter Loop Interpreter))
(define (interpreter-loop i ins)
(if (zero? (interpreter-current i))
i
(struct-copy interpreter i
[program (append ins (list ins) (interpreter-program i))])))
(: pointer-increment (-> Interpreter Interpreter))
(define (pointer-increment i)
(match i
[(interpreter left current right program)
(interpreter (cons current left)
(if (null? right) 0 (car right))
(if (null? right) '() (cdr right))
program)]))
(: pointer-decrement (-> Interpreter Interpreter))
(define (pointer-decrement i)
(~> i
interpreter-flip
pointer-increment
interpreter-flip))
(: interpreter-flip (-> Interpreter Interpreter))
(define (interpreter-flip i)
(match i
[(interpreter left current right program)
(interpreter right current left program)]))
(: output (-> Interpreter Interpreter))
(define (output i)
(begin
(display (integer->char (interpreter-current i)))
i))
(: modify-current (-> Interpreter (-> Cell Cell) Interpreter))
(define (modify-current i f)
(struct-copy interpreter i
[current (f (interpreter-current i))]))
(: interpreter-done? (-> Interpreter Boolean))
(define (interpreter-done? i)
(null? (interpreter-program i)))
(: interpreter-run (-> Interpreter Interpreter))
(define (interpreter-run i)
(if (interpreter-done? i)
i
(interpreter-run (interpreter-step i))))
(: interpret (-> String Interpreter))
(define (interpret source)
(~> source
string->program
make-interpreter
interpreter-run))