br-bf starts to work

dev-elider-3
Matthew Butterick 9 years ago
parent d267498935
commit 96c14719cf

@ -0,0 +1,12 @@
#lang br-bf
+++++++++++
>+>>>>++++++++++++++++++++++++++++++++++++++++++++
>++++++++++++++++++++++++++++++++<<<<<<[>[>>>>>>+>
+<<<<<<<-]>>>>>>>[<<<<<<<+>>>>>>>-]<[>++++++++++[-
<-[>>+>+<<<-]>>>[<<<+>>>-]+<[>[-]<[-]]>[<<[>>>+<<<
-]>>[-]]<<]>>>[>>+>+<<<-]>>>[<<<+>>>-]+<[>[-]<[-]]
>[<<+>>[-]]<<<<<<<]>>>>>[+++++++++++++++++++++++++
+++++++++++++++++++++++.[-]]++++++++++<[->-<]>++++
++++++++++++++++++++++++++++++++++++++++++++.[-]<<
<<<<<<<<<<[>>>+>+<<<<-]>>>>[<<<<+>>>>-]<-[>>.>.<<<
[-]]<<[>>+>+<<<-]>>>[<<<+>>>-]<<[<+>-]>[<+>-]<<<-]

@ -1,10 +1,42 @@
#lang br
(provide (all-from-out br)
(all-defined-out))
(define bf-vector (make-vector 1000 0))
(define bf-pointer 0)
(define (byte-at-pointer) (vector-ref bf-vector bf-pointer))
(define (change-byte-at-pointer val) (vector-set! bf-vector bf-pointer val))
(define (change-pointer how-far)
(set! bf-pointer (+ bf-pointer how-far)))
(define (change-pointer-val how-much)
(change-byte-at-pointer (+ (byte-at-pointer) how-much)))
(define #'(bf-program arg ...)
#'(begin arg ...))
(define #'(expr arg)
(case (syntax->datum #'arg)
[(">") #'(change-pointer 1)]
[("<") #'(change-pointer -1)]
[("+") #'(change-pointer-val 1)]
[("-") #'(change-pointer-val -1)]
[(".") #'(write-byte (byte-at-pointer))]
[(",") #'(change-byte-at-pointer (read-byte (current-input-port)))]
[else #'arg]))
(define #'(loop lb arg ... rb)
#'(let loop ()
(unless (zero? (vector-ref bf-vector bf-pointer))
arg ...
(loop))))
(module reader syntax/module-reader
#:language 'br-bf
#:read bf-read
#:read-syntax bf-read-syntax
#:whole-body-readers? #t
(require "tokenizer.rkt" "parser.rkt")
(define (bf-read in)

@ -0,0 +1,4 @@
#lang racket
(require "tokenizer.rkt" "parser.rkt" ragg/support)
(syntax->datum (parse (tokenize (open-input-string "[+-]>"))))

@ -1,10 +1,10 @@
#lang ragg
<expr> : ">"
bf-program : expr*
expr : ">"
| "<"
| "+"
| "-"
| "."
| ","
| <loop>
<loop> : "["<expr>*"]"
| loop
loop : "[" expr* "]"

@ -1,24 +1,14 @@
#lang racket/base
(require parser-tools/lex ragg/support)
(provide tokenize)
(require parser-tools/lex ragg/support racket/function)
(provide tokenize lex)
(define lex
(lexer-src-pos
[(char-set "><-.,+[]") lexeme]
[whitespace (token '_ lexeme #:skip? #t)]
[(eof) (void)]))
(define (tokenize ip)
(port-count-lines! ip)
(define my-lexer
(lexer-src-pos
[(repetition 1 +inf.0 numeric)
(token 'INTEGER (string->number lexeme))]
[upper-case
(token 'STRING lexeme)]
["b"
(token 'STRING " ")]
[";"
(token ";" lexeme)]
[whitespace
(token 'WHITESPACE lexeme #:skip? #t)]
[(eof)
(void)]))
(define (next-token) (my-lexer ip))
next-token)
(define next-token-thunk (thunk (lex ip)))
next-token-thunk)

@ -6,4 +6,3 @@
(define build-deps '("racket-doc"))
(define test-omit-paths '("br-bf"))
(define compile-omit-paths '("br-bf"))
Loading…
Cancel
Save