"semantics.rkt"
#lang racket
 
;; unsafe operations for speed.
;; But be very careful!
(require racket/unsafe/ops)
 
(provide (all-defined-out))
 
;; We use a customized error structure that supports
;; source location reporting.
(define-struct (exn:fail:out-of-bounds exn:fail)
  (srcloc)
  #:property prop:exn:srclocs
  (lambda (a-struct)
    (list (exn:fail:out-of-bounds-srcloc a-struct))))
 
;; Provides two values: a byte array of 30000 zeros, and
;; the pointer at index 0.
(define-syntax-rule (new-state)
  (values (make-vector 30000 0)
          0))
 
;; increment the data pointer
(define-syntax-rule (increment-ptr data ptr loc)
  (begin
    (set! ptr (unsafe-fx+ ptr 1))
    (when (unsafe-fx>= ptr (unsafe-vector-length data))
      (raise (make-exn:fail:out-of-bounds
              "out of bounds"
              (current-continuation-marks)
              loc)))))
 
;; decrement the data pointer
(define-syntax-rule (decrement-ptr data ptr loc)
  (begin
    (set! ptr (unsafe-fx- ptr 1))
    (when (unsafe-fx< ptr 0)
      (raise (make-exn:fail:out-of-bounds
              "out of bounds"
              (current-continuation-marks)
              loc)))))
 
 
 
;; increment the byte at the data pointer
(define-syntax-rule (increment-byte data ptr)
  (unsafe-vector-set! data ptr
                      (unsafe-fxmodulo
                       (unsafe-fx+
                        (unsafe-vector-ref data ptr) 1)
                       256)))
 
;; decrement the byte at the data pointer
(define-syntax-rule (decrement-byte data ptr)
  (unsafe-vector-set! data ptr
                      (unsafe-fxmodulo
                       (unsafe-fx-
                        (unsafe-vector-ref data ptr) 1)
                       256)))
 
;; print the byte at the data pointer
(define-syntax-rule (write-byte-to-stdout data ptr)
  (write-byte (unsafe-vector-ref data ptr)
              (current-output-port)))
 
;; read a byte from stdin into the data pointer
(define-syntax-rule (read-byte-from-stdin data ptr)
  (unsafe-vector-set! data ptr
                      (let ([a-value (read-byte
                                      (current-input-port))])
                        (if (eof-object? a-value)
                            0
                            a-value))))
 
;; we know how to do loops!
(define-syntax-rule (loop data ptr body ...)
  (let loop ()
    (unless (unsafe-fx= (unsafe-vector-ref data ptr)
                        0)
      body ...
      (loop))))