improvements

dev-elider-3
Matthew Butterick 8 years ago
parent 96c14719cf
commit 948f40e002

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

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

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

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

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

Loading…
Cancel
Save