From 96c14719cf19ef8654f0c6abba9d9c52cd5d8863 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Thu, 7 Apr 2016 17:04:17 -0700
Subject: [PATCH] br-bf starts to work

---
 br-bf/fib.rkt         | 12 ++++++++++++
 br-bf/main.rkt        | 32 ++++++++++++++++++++++++++++++++
 br-bf/parser-test.rkt |  4 ++++
 br-bf/parser.rkt      |  8 ++++----
 br-bf/tokenizer.rkt   | 32 +++++++++++---------------------
 info.rkt              |  3 +--
 6 files changed, 64 insertions(+), 27 deletions(-)
 create mode 100644 br-bf/fib.rkt
 create mode 100644 br-bf/parser-test.rkt

diff --git a/br-bf/fib.rkt b/br-bf/fib.rkt
new file mode 100644
index 0000000..b1e61dc
--- /dev/null
+++ b/br-bf/fib.rkt
@@ -0,0 +1,12 @@
+#lang br-bf
++++++++++++
+>+>>>>++++++++++++++++++++++++++++++++++++++++++++
+>++++++++++++++++++++++++++++++++<<<<<<[>[>>>>>>+>
++<<<<<<<-]>>>>>>>[<<<<<<<+>>>>>>>-]<[>++++++++++[-
+<-[>>+>+<<<-]>>>[<<<+>>>-]+<[>[-]<[-]]>[<<[>>>+<<<
+-]>>[-]]<<]>>>[>>+>+<<<-]>>>[<<<+>>>-]+<[>[-]<[-]]
+>[<<+>>[-]]<<<<<<<]>>>>>[+++++++++++++++++++++++++
++++++++++++++++++++++++.[-]]++++++++++<[->-<]>++++
+++++++++++++++++++++++++++++++++++++++++++++.[-]<<
+<<<<<<<<<<[>>>+>+<<<<-]>>>>[<<<<+>>>>-]<-[>>.>.<<<
+[-]]<<[>>+>+<<<-]>>>[<<<+>>>-]<<[<+>-]>[<+>-]<<<-]
\ No newline at end of file
diff --git a/br-bf/main.rkt b/br-bf/main.rkt
index 4e95b69..a3d3bd5 100644
--- a/br-bf/main.rkt
+++ b/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)
diff --git a/br-bf/parser-test.rkt b/br-bf/parser-test.rkt
new file mode 100644
index 0000000..4325329
--- /dev/null
+++ b/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 "[+-]>"))))
\ No newline at end of file
diff --git a/br-bf/parser.rkt b/br-bf/parser.rkt
index b80844d..0cfe50c 100644
--- a/br-bf/parser.rkt
+++ b/br-bf/parser.rkt
@@ -1,10 +1,10 @@
 #lang ragg
-
-<expr> : ">"
+bf-program : expr*
+expr : ">"
        | "<" 
        | "+" 
        | "-" 
        | "." 
        | "," 
-       | <loop>
-<loop> : "["<expr>*"]"
\ No newline at end of file
+       | loop
+loop : "[" expr* "]"
\ No newline at end of file
diff --git a/br-bf/tokenizer.rkt b/br-bf/tokenizer.rkt
index d68b7f7..f6d04a9 100644
--- a/br-bf/tokenizer.rkt
+++ b/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)
\ No newline at end of file
+(define (tokenize ip)
+  (port-count-lines! ip)  
+  (define next-token-thunk (thunk (lex ip)))
+  next-token-thunk)
diff --git a/info.rkt b/info.rkt
index f5fc658..841b043 100644
--- a/info.rkt
+++ b/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"))
\ No newline at end of file
+(define test-omit-paths '("br-bf"))
\ No newline at end of file