#lang racket/base
(require "semantics.rkt"
racket/stxparam
(for-syntax racket/base))
(provide greater-than
less-than
plus
minus
period
comma
brackets
(rename-out [my-module-begin #%module-begin]))
(define-syntax-parameter current-data #f)
(define-syntax-parameter current-ptr #f)
(define-syntax (my-module-begin stx)
(syntax-case stx ()
[(_ body ...)
(syntax/loc stx
(#%plain-module-begin
(define (run)
(let-values ([(fresh-state fresh-ptr) (new-state)])
(syntax-parameterize ([current-data
(make-rename-transformer #'fresh-state)]
[current-ptr
(make-rename-transformer #'fresh-ptr)])
(begin body ... (void)))))
(run)))]))
(define-syntax (greater-than stx)
(syntax-case stx ()
[(_)
(quasisyntax/loc stx
(increment-ptr current-data current-ptr
(srcloc '#,(syntax-source stx)
'#,(syntax-line stx)
'#,(syntax-column stx)
'#,(syntax-position stx)
'#,(syntax-span stx))))]))
(define-syntax (less-than stx)
(syntax-case stx ()
[(_)
(quasisyntax/loc stx
(decrement-ptr current-data current-ptr
(srcloc '#,(syntax-source stx)
'#,(syntax-line stx)
'#,(syntax-column stx)
'#,(syntax-position stx)
'#,(syntax-span stx))))]))
(define-syntax-rule (plus)
(increment-byte current-data current-ptr))
(define-syntax-rule (minus)
(decrement-byte current-data current-ptr))
(define-syntax-rule (period)
(write-byte-to-stdout current-data current-ptr))
(define-syntax-rule (comma)
(read-byte-from-stdin current-data current-ptr))
(define-syntax-rule (brackets body ...)
(loop current-data current-ptr body ...))