diff --git a/br-bf/bf-test-sexp.rkt b/br-bf/bf-test-sexp.rkt new file mode 100644 index 0000000..017dc21 --- /dev/null +++ b/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 ".")) \ No newline at end of file diff --git a/br-bf/bf-test.rkt b/br-bf/bf-test.rkt new file mode 100644 index 0000000..2281219 --- /dev/null +++ b/br-bf/bf-test.rkt @@ -0,0 +1,2 @@ +#lang br-bf ++++++++[>+++++<-]>. diff --git a/br-bf/main.rkt b/br-bf/main.rkt index a3d3bd5..89c68b1 100644 --- a/br-bf/main.rkt +++ b/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)) - -(define (change-pointer how-far) - (set! bf-pointer (+ bf-pointer how-far))) +(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 + + (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 - - (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))))) +(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)) + + + diff --git a/br-bf/parser.rkt b/br-bf/parser.rkt index 0cfe50c..bc22ffa 100644 --- a/br-bf/parser.rkt +++ b/br-bf/parser.rkt @@ -1,10 +1,7 @@ #lang ragg -bf-program : expr* -expr : ">" - | "<" - | "+" - | "-" - | "." - | "," - | loop -loop : "[" expr* "]" \ No newline at end of file +;; use uppercase TOKEN-IDENTIFIERS for classes of tokens +;; too numerous to indicate individually +;; (e.g., numbers, strings) +bf-program : op* +op : ">" | "<" | "+" | "-" | "." | "," | loop +loop : "[" op* "]" \ No newline at end of file diff --git a/br-bf/tokenizer.rkt b/br-bf/tokenizer.rkt index f6d04a9..ceb0c83 100644 --- a/br-bf/tokenizer.rkt +++ b/br-bf/tokenizer.rkt @@ -1,14 +1,15 @@ #lang racket/base -(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)])) +(require parser-tools/lex ragg/support) +(provide tokenize) (define (tokenize ip) - (port-count-lines! ip) - (define next-token-thunk (thunk (lex ip))) - next-token-thunk) + (port-count-lines! ip) + + (define lex + (lexer + [(char-set "><-.,+[]") lexeme] + [whitespace (token 'white #:skip? #t)] + [(eof) (void)])) + + (define next-token-func (λ _ (lex ip))) + next-token-func)