suzanne.soy/beautiful-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

simplify br-bf

Browse Source
This commit is contained in:
Matthew Butterick 2016-04-08 10:47:25 -07:00
parent 43d8464743
commit 780b656543
1 changed files with 17 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
br-bf/main.rkt
View File

@ -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 syntax/module-reader (module reader br
#:language 'br-bf (require "tokenizer.rkt" "parser.rkt" syntax/strip-context)
#:read bf-read (provide read-syntax)
#:read-syntax bf-read-syntax (define (read-syntax src-path src-port)
;; need this because we keep state, (define src-exprs (list (parse src-path (tokenize src-port))))
;; therefore expansion is "all or nothing" ;; todo: why is `replace-context` necessary ; why does #'here work
#:whole-body-readers? #t (replace-context #'here
(inject-syntax ([#'(<src-expr> ...) src-exprs])
(require "tokenizer.rkt" "parser.rkt") #'(module bf-interpreter br-bf
(define (bf-read in) <src-expr> ...)))))
(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))