br-bf starts to work

br-bf/fib.rkt

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

br-bf/main.rkt

@@ -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)

br-bf/parser-test.rkt

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

br-bf/parser.rkt

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

br-bf/tokenizer.rkt

@@ -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 (tokenize ip)
-  (port-count-lines! ip)
+(define lex
+  (lexer-src-pos
+   [(char-set "><-.,+[]") lexeme]
+   [whitespace (token '_ lexeme #:skip? #t)]
+   [(eof) (void)]))
 
-  (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 (tokenize ip)
+  (port-count-lines! ip)  
+  (define next-token-thunk (thunk (lex ip)))
+  next-token-thunk)

info.rkt

@@ -5,5 +5,4 @@
 (define deps '("base" "sugar" "rackunit-lib" "ragg"))
 (define build-deps '("racket-doc"))
 
-(define test-omit-paths '("br-bf"))
-(define compile-omit-paths '("br-bf"))
+(define test-omit-paths '("br-bf"))