#lang racket
(require rackunit racket/unsafe/ops )
(provide (all-defined-out))
(define-struct state (data ptr)
#:mutable)
(define-syntax-rule (unsafe-state-data a-state)
(unsafe-struct-ref a-state 0))
(define-syntax-rule (unsafe-state-ptr a-state)
(unsafe-struct-ref a-state 1))
(define-syntax-rule (unsafe-set-state-ptr! a-state v)
(unsafe-struct-set! a-state 1 v))
(define (new-state)
(make-state (make-vector 30000 0)
0))
(define-syntax-rule (raise-range-errors! a-state caller-name stx)
(if stx
(raise-syntax-error #f "pointer went out of range of data" stx)
(error caller-name "pointer went out of range of data")))
(define-syntax-rule (increment-ptr a-state stx)
(begin
(unsafe-set-state-ptr! a-state (unsafe-fx+ (unsafe-state-ptr a-state) 1))
(when (unsafe-fx>= (unsafe-state-ptr a-state) (unsafe-vector-length (unsafe-state-data a-state)))
(raise-range-errors! a-state 'increment-ptr stx))))
(define-syntax-rule (decrement-ptr a-state stx)
(begin
(unsafe-set-state-ptr! a-state (unsafe-fx- (unsafe-state-ptr a-state) 1))
(when (unsafe-fx< (unsafe-state-ptr a-state) 0)
(raise-range-errors! a-state 'decrement-ptr stx))))
(define-syntax-rule (increment-byte a-state)
(let ([v (unsafe-state-data a-state)]
[i (unsafe-state-ptr a-state)])
(unsafe-vector-set! v i (unsafe-fx+ (unsafe-vector-ref v i) 1))))
(define-syntax-rule (decrement-byte a-state)
(let ([v (unsafe-state-data a-state)]
[i (unsafe-state-ptr a-state)])
(unsafe-vector-set! v i (unsafe-fx- (unsafe-vector-ref v i) 1))))
(define-syntax-rule (write-byte-to-stdout a-state)
(let ([v (unsafe-state-data a-state)]
[i (unsafe-state-ptr a-state)])
(write-byte (unsafe-vector-ref v i) (current-output-port))))
(define-syntax-rule (read-byte-from-stdin a-state)
(let ([v (unsafe-state-data a-state)]
[i (unsafe-state-ptr a-state)])
(unsafe-vector-set! v i (let ([v (read-byte (current-input-port))])
(if (eof-object? v)
0
v)))))
(define-syntax-rule (loop a-state body ...)
(let loop ()
(unless (= (unsafe-vector-ref (unsafe-state-data a-state)
(unsafe-state-ptr a-state))
0)
body ...
(loop))))
(let ([s (new-state)])
(increment-byte s)
(check-equal? 1 (vector-ref (state-data s) 0))
(increment-byte s)
(check-equal? 2 (vector-ref (state-data s) 0))
(decrement-byte s)
(check-equal? 1 (vector-ref (state-data s) 0)))
(let ([s (new-state)])
(increment-ptr s #f)
(increment-byte s)
(check-equal? 0 (vector-ref (state-data s) 0))
(check-equal? 1 (vector-ref (state-data s) 1))
(decrement-ptr s #f)
(increment-byte s)
(check-equal? 1 (vector-ref (state-data s) 0))
(check-equal? 1 (vector-ref (state-data s) 1)))
(let ([s (new-state)])
(parameterize ([current-input-port
(open-input-bytes (bytes 3 1 4))])
(read-byte-from-stdin s)
(increment-ptr s #f)
(read-byte-from-stdin s)
(increment-ptr s #f)
(read-byte-from-stdin s))
(check-equal? 3 (vector-ref (state-data s) 0))
(check-equal? 1 (vector-ref (state-data s) 1))
(check-equal? 4 (vector-ref (state-data s) 2)))
(let ([s (new-state)])
(set-state-data! s (vector 80 76 84))
(let ([simulated-stdout (open-output-string)])
(parameterize ([current-output-port simulated-stdout])
(write-byte-to-stdout s)
(increment-ptr s #f)
(write-byte-to-stdout s)
(increment-ptr s #f)
(write-byte-to-stdout s))
(check-equal? "PLT" (get-output-string simulated-stdout))))
(let ([s (new-state)])
(set-state-data! s (vector 0 104 101 108 112 109 101 105
109 109 101 108 116 105 110 103 ))
(set-state-ptr! s 15)
(loop s
(loop s (decrement-byte s))
(decrement-ptr s #f))
(check-equal? 0 (state-ptr s))
(check-equal? (make-vector 16 0) (state-data s)))