|
|
@ -1,24 +1,16 @@
|
|
|
|
#lang br
|
|
|
|
#lang br
|
|
|
|
(provide #%module-begin #%top-interaction
|
|
|
|
(provide #%module-begin #%top-interaction bf-program op loop)
|
|
|
|
bf-program op loop)
|
|
|
|
|
|
|
|
|
|
|
|
(module reader br
|
|
|
|
(module reader syntax/module-reader
|
|
|
|
(require "tokenizer.rkt" "parser.rkt" syntax/strip-context)
|
|
|
|
#:language 'br-bf
|
|
|
|
(provide read-syntax)
|
|
|
|
#:read bf-read
|
|
|
|
(define (read-syntax src-path src-port)
|
|
|
|
#:read-syntax bf-read-syntax
|
|
|
|
(define src-exprs (list (parse src-path (tokenize src-port))))
|
|
|
|
;; need this because we keep state,
|
|
|
|
;; todo: why is `replace-context` necessary ; why does #'here work
|
|
|
|
;; therefore expansion is "all or nothing"
|
|
|
|
(replace-context #'here
|
|
|
|
#:whole-body-readers? #t
|
|
|
|
(inject-syntax ([#'(<src-expr> ...) src-exprs])
|
|
|
|
|
|
|
|
#'(module bf-interpreter br-bf
|
|
|
|
(require "tokenizer.rkt" "parser.rkt")
|
|
|
|
<src-expr> ...)))))
|
|
|
|
(define (bf-read in)
|
|
|
|
|
|
|
|
(syntax->datum (bf-read-syntax #f in)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define (bf-read-syntax src ip)
|
|
|
|
|
|
|
|
(define result (list (parse src (tokenize ip))))
|
|
|
|
|
|
|
|
;; prints out corresponding s-exp source
|
|
|
|
|
|
|
|
(for-each println (map syntax->datum result))
|
|
|
|
|
|
|
|
result))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define #'(bf-program <op-or-loop> ...)
|
|
|
|
(define #'(bf-program <op-or-loop> ...)
|
|
|
|
#'(begin <op-or-loop> ...))
|
|
|
|
#'(begin <op-or-loop> ...))
|
|
|
@ -31,10 +23,6 @@
|
|
|
|
[#'(_ ".") #'(write-byte (get-pointer-byte))]
|
|
|
|
[#'(_ ".") #'(write-byte (get-pointer-byte))]
|
|
|
|
[#'(_ ",") #'(set-pointer-byte! (read-byte))])
|
|
|
|
[#'(_ ",") #'(set-pointer-byte! (read-byte))])
|
|
|
|
|
|
|
|
|
|
|
|
(define-cases f
|
|
|
|
|
|
|
|
[(_ arg) (add1 arg)]
|
|
|
|
|
|
|
|
[(_ arg1 arg2) (+ arg1 arg2)])
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define #'(loop "[" <op-or-loop> ... "]")
|
|
|
|
(define #'(loop "[" <op-or-loop> ... "]")
|
|
|
|
#'(until (zero? (get-pointer-byte))
|
|
|
|
#'(until (zero? (get-pointer-byte))
|
|
|
|
<op-or-loop> ...))
|
|
|
|
<op-or-loop> ...))
|
|
|
@ -44,11 +32,3 @@
|
|
|
|
(define (get-pointer-byte) (vector-ref bf-vector bf-pointer))
|
|
|
|
(define (get-pointer-byte) (vector-ref bf-vector bf-pointer))
|
|
|
|
(define (set-pointer-byte! val) (vector-set! bf-vector bf-pointer val))
|
|
|
|
(define (set-pointer-byte! val) (vector-set! bf-vector bf-pointer val))
|
|
|
|
(define (move-pointer how-far) (set! bf-pointer (+ bf-pointer how-far)))
|
|
|
|
(define (move-pointer how-far) (set! bf-pointer (+ bf-pointer how-far)))
|
|
|
|
|
|
|
|
|
|
|
|
(define (dump)
|
|
|
|
|
|
|
|
(displayln "")
|
|
|
|
|
|
|
|
(displayln bf-pointer)
|
|
|
|
|
|
|
|
(displayln bf-vector))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|