improvements

br-bf/bf-test-sexp.rkt

@@ -0,0 +1,2 @@
+#lang s-exp br-bf
+(bf-program (op "+") (op "+") (op "+") (op "+") (op "+") (op "+") (op "+") (op (loop "[" (op ">") (op "+") (op "+") (op "+") (op "+") (op "+") (op "<") (op "-") "]")) (op ">") (op "."))

br-bf/bf-test.rkt

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

br-bf/main.rkt

@@ -1,46 +1,57 @@
 #lang br
-(provide (all-from-out br)
-         (all-defined-out))
+(provide #%module-begin #%top-interaction
+         bf-program op loop)
 
-(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))
+(module reader syntax/module-reader
+  #:language 'br-bf
+  #:read bf-read
+  #:read-syntax bf-read-syntax
+  ;; need this because we keep state,
+  ;; therefore expansion is "all or nothing"
+  #:whole-body-readers? #t 
   
-(define (change-pointer how-far)
-  (set! bf-pointer (+ bf-pointer how-far)))
+  (require "tokenizer.rkt" "parser.rkt")
+  (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 (change-pointer-val how-much)
-  (change-byte-at-pointer (+ (byte-at-pointer) how-much)))
 
 (define #'(bf-program arg ...)
   #'(begin arg ...))
 
-(define #'(expr arg)
+(define #'(op 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)))]
+    [(">") #'(move-pointer 1)]
+    [("<") #'(move-pointer -1)]
+    [("+") #'(set-pointer-byte! (add1 (pointer-byte)))]
+    [("-") #'(set-pointer-byte! (sub1 (pointer-byte)))]
+    [(".") #'(write-byte (pointer-byte))]
+    [(",") #'(set-pointer-byte! (read-byte (current-input-port)))]
     [else #'arg]))
 
 (define #'(loop lb arg ... rb)
   #'(let loop ()
-      (unless (zero? (vector-ref bf-vector bf-pointer))
+      (unless (zero? (pointer-byte))
         arg ...
         (loop))))
 
-(module reader syntax/module-reader
-  #:language 'br-bf
-  #:read bf-read
-  #:read-syntax bf-read-syntax
-  #:whole-body-readers? #t
+(define bf-vector (make-vector 10 0))
+(define bf-pointer 0)
+(define (pointer-byte) (vector-ref bf-vector bf-pointer))
+(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 (dump)
+  (displayln "")
+  (displayln bf-pointer)
+  (displayln bf-vector))
+
 
-  (require "tokenizer.rkt" "parser.rkt")
-  (define (bf-read in)
-    (syntax->datum (bf-read-syntax #f in)))
 
-  (define (bf-read-syntax src ip)
-    (list (parse src (tokenize ip)))))

br-bf/parser.rkt

@@ -1,10 +1,7 @@
 #lang ragg
-bf-program : expr*
-expr : ">"
-       | "<" 
-       | "+" 
-       | "-" 
-       | "." 
-       | "," 
-       | loop
-loop : "[" expr* "]"
+;; use uppercase TOKEN-IDENTIFIERS for classes of tokens
+;; too numerous to indicate individually
+;; (e.g., numbers, strings)
+bf-program : op*
+op : ">" | "<" | "+" | "-" | "." | "," | loop
+loop : "[" op* "]"

br-bf/tokenizer.rkt

@@ -1,14 +1,15 @@
 #lang racket/base
-(require parser-tools/lex ragg/support racket/function)
-(provide tokenize lex)
+(require parser-tools/lex ragg/support)
+(provide tokenize)
 
-(define lex
-  (lexer-src-pos
+(define (tokenize ip)
+  (port-count-lines! ip)
+  
+  (define lex
+    (lexer
      [(char-set "><-.,+[]") lexeme]
-   [whitespace (token '_ lexeme #:skip? #t)]
+     [whitespace (token 'white #:skip? #t)]
      [(eof) (void)]))
   
-(define (tokenize ip)
-  (port-count-lines! ip)  
-  (define next-token-thunk (thunk (lex ip)))
-  next-token-thunk)
+  (define next-token-func (λ _ (lex ip)))
+  next-token-func)