You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
beautiful-racket/br-bf/main.rkt

56 lines
1.7 KiB
Racket

9 years ago
#lang br
9 years ago
(module reader br
(provide read-syntax)
9 years ago
(require "tokenizer.rkt" "parser.rkt")
9 years ago
(define (read-syntax src-path src-port)
9 years ago
(define parsed-syntax (parse src-path (tokenize src-port)))
;; `strip-context` because `read-syntax` promises
;; a "clean" syntax object without context
;; (so later operations can add it)
(strip-context
(inject-syntax ([parsed-syntax])
#'(module bf-interpreter br-bf
parsed-syntax)))))
9 years ago
(provide (rename-out [bf-module-begin #%module-begin])
#%top-interaction bf-program op loop)
;; just relying on br's #%module-begin.
;; Could just as easily pass through that one.
(define #'bf-module-begin #'#%module-begin)
;; macros to expand our parse tree into local functions
;; bf-program doesn't do anything
9 years ago
(define #'(bf-program <op-or-loop> ...)
#'(begin <op-or-loop> ...))
9 years ago
;; op branches. Note that string & number literals are
;; matched literally in syntax patterns.
9 years ago
(define-cases #'op
9 years ago
[#'(_ ">") #'(move-pointer 1)]
[#'(_ "<") #'(move-pointer -1)]
[#'(_ "+") #'(set-pointer-byte! (add1 (get-pointer-byte)))]
[#'(_ "-") #'(set-pointer-byte! (sub1 (get-pointer-byte)))]
[#'(_ ".") #'(write-byte (get-pointer-byte))]
[#'(_ ",") #'(set-pointer-byte! (read-byte))])
9 years ago
9 years ago
9 years ago
(define #'(loop "[" <op-or-loop> ... "]")
#'(until (zero? (get-pointer-byte))
<op-or-loop> ...))
9 years ago
;; bf implementation
;; state: one vector, one pointer
9 years ago
(define bf-vector (make-vector 1000 0))
9 years ago
(define bf-pointer 0)
9 years ago
;; gets and sets
9 years ago
(define (get-pointer-byte) (vector-ref bf-vector bf-pointer))
9 years ago
(define (set-pointer-byte! val) (vector-set! bf-vector bf-pointer val))
9 years ago
;; pointer mover
(define (move-pointer how-far) (set! bf-pointer (+ bf-pointer how-far)))