adjusts
parent
da48bd845a
commit
63a88ee103
@ -0,0 +1,5 @@
|
||||
#lang br
|
||||
|
||||
(module reader br
|
||||
(require "bf/bf-reader.rkt")
|
||||
(provide read-syntax))
|
||||
@ -0,0 +1,26 @@
|
||||
#lang s-exp "bf-expander.rkt"
|
||||
(bf-program
|
||||
(op "+")
|
||||
(op "+")
|
||||
(op "+")
|
||||
(op "+")
|
||||
(op "+")
|
||||
(op "+")
|
||||
(op "+")
|
||||
(op "+")
|
||||
(loop
|
||||
"["
|
||||
(op ">")
|
||||
(op "+")
|
||||
(op "+")
|
||||
(op "+")
|
||||
(op "+")
|
||||
(op "+")
|
||||
(op "+")
|
||||
(op "+")
|
||||
(op "+")
|
||||
(op "<")
|
||||
(op "-")
|
||||
"]")
|
||||
(op ">")
|
||||
(op "."))
|
||||
@ -0,0 +1,2 @@
|
||||
#lang reader "bf-reader.rkt"
|
||||
+++++++[>+++++<-]>.
|
||||
@ -0,0 +1,44 @@
|
||||
#lang br
|
||||
(provide (rename-out [bf-module-begin #%module-begin])
|
||||
#%top-interaction)
|
||||
|
||||
(define #'(bf-module-begin BF-PARSE-TREE ...)
|
||||
#'(#%module-begin
|
||||
BF-PARSE-TREE ...))
|
||||
|
||||
|
||||
;; macros to expand our parse tree into local functions
|
||||
|
||||
(provide bf-program op loop)
|
||||
|
||||
;; bf-program doesn't do anything
|
||||
(define #'(bf-program <op-or-loop> ...)
|
||||
#'(begin <op-or-loop> ...))
|
||||
|
||||
;; op branches. Note that string & number literals are
|
||||
;; matched literally in syntax patterns.
|
||||
(define-cases #'op
|
||||
[#'(_ ">") #'(move-pointer 1)]
|
||||
[#'(_ "<") #'(move-pointer -1)]
|
||||
[#'(_ "+") #'(set-pointer-byte! (add1 (get-pointer-byte)))]
|
||||
[#'(_ "-") #'(set-pointer-byte! (sub1 (get-pointer-byte)))]
|
||||
[#'(_ ".") #'(write-byte (get-pointer-byte))]
|
||||
[#'(_ ",") #'(set-pointer-byte! (read-byte))])
|
||||
|
||||
|
||||
(define #'(loop "[" <op-or-loop> ... "]")
|
||||
#'(until (zero? (get-pointer-byte))
|
||||
<op-or-loop> ...))
|
||||
|
||||
;; bf implementation
|
||||
|
||||
;; state: one vector, one pointer
|
||||
(define bf-vector (make-vector 30000 0))
|
||||
(define bf-pointer 0)
|
||||
|
||||
;; gets and sets
|
||||
(define (get-pointer-byte) (vector-ref bf-vector bf-pointer))
|
||||
(define (set-pointer-byte! val) (vector-set! bf-vector bf-pointer val))
|
||||
|
||||
;; pointer mover
|
||||
(define (move-pointer how-far) (set! bf-pointer (+ bf-pointer how-far)))
|
||||
@ -1,2 +1,2 @@
|
||||
#lang reader "bf.rkt"
|
||||
#lang reader "bf-reader.rkt"
|
||||
+++++++[>+++++<-]>.
|
||||
|
||||
@ -0,0 +1,4 @@
|
||||
#lang ragg
|
||||
bf-program : (op | loop)*
|
||||
op : ">" | "<" | "+" | "-" | "." | ","
|
||||
loop : "[" (op | loop)* "]"
|
||||
@ -0,0 +1,21 @@
|
||||
#lang br
|
||||
(require parser-tools/lex ragg/support)
|
||||
(define (tokenize input-port)
|
||||
(define (next-token)
|
||||
(define get-token
|
||||
(lexer
|
||||
[(char-set "><-.,+[]") lexeme]
|
||||
[(char-complement (char-set "><-.,+[]"))
|
||||
(token 'OTHER #:skip? #t)]
|
||||
[(eof) eof]))
|
||||
(get-token input-port))
|
||||
next-token)
|
||||
|
||||
(require "bf-parser.rkt")
|
||||
(define (read-syntax source-path input-port)
|
||||
(define parse-tree (parse source-path (tokenize input-port)))
|
||||
(strip-context
|
||||
(inject-syntax ([#'PARSE-TREE parse-tree])
|
||||
#'(module bf-mod "bf-expander.rkt"
|
||||
PARSE-TREE))))
|
||||
(provide read-syntax)
|
||||
@ -1,82 +0,0 @@
|
||||
#lang br
|
||||
(require parser-tools/lex ragg/support "parser.rkt")
|
||||
|
||||
(define (tokenize src-port)
|
||||
(define (next-token)
|
||||
(define get-token
|
||||
(lexer
|
||||
[(char-set "><-.,+[]") lexeme]
|
||||
[(char-complement (char-set "><-.,+[]")) (token 'OTHER #:skip? #t)]
|
||||
[(eof) eof]))
|
||||
(get-token src-port))
|
||||
next-token)
|
||||
|
||||
|
||||
(define+provide (read-syntax src-path src-port)
|
||||
(define parsed-syntax (parse src-path (tokenize src-port)))
|
||||
(strip-context
|
||||
(inject-syntax ([parsed-syntax])
|
||||
#'(module bf-interpreter br/bf
|
||||
parsed-syntax))))
|
||||
|
||||
#;(module reader br
|
||||
(provide read-syntax)
|
||||
(require "bf/tokenizer.rkt" "bf/parser.rkt")
|
||||
(define (read-syntax src-path src-port)
|
||||
(define parsed-syntax (parse src-path (tokenize src-port)))
|
||||
;; `strip-context` because `read-syntax` promises
|
||||
;; a "clean" syntax object without context
|
||||
;; (so later operations can add it)
|
||||
(strip-context
|
||||
(inject-syntax ([parsed-syntax])
|
||||
#'(module bf-interpreter br/bf
|
||||
parsed-syntax)))))
|
||||
|
||||
;; compact version
|
||||
#;(module reader br
|
||||
(require br/reader-utils "tokenizer.rkt" "parser.rkt")
|
||||
(define-read-and-read-syntax (src-path src-port)
|
||||
#`(module bf-interpreter br/bf
|
||||
#,(parse src-path (tokenize src-port)))))
|
||||
|
||||
(provide (rename-out [bf-module-begin #%module-begin])
|
||||
#%top-interaction bf-program op loop)
|
||||
|
||||
;; just relying on br's #%module-begin.
|
||||
;; Could just as easily pass through that one.
|
||||
(define #'bf-module-begin #'#%module-begin)
|
||||
|
||||
|
||||
;; macros to expand our parse tree into local functions
|
||||
|
||||
;; bf-program doesn't do anything
|
||||
(define #'(bf-program <op-or-loop> ...)
|
||||
#'(begin <op-or-loop> ...))
|
||||
|
||||
;; op branches. Note that string & number literals are
|
||||
;; matched literally in syntax patterns.
|
||||
(define-cases #'op
|
||||
[#'(_ ">") #'(move-pointer 1)]
|
||||
[#'(_ "<") #'(move-pointer -1)]
|
||||
[#'(_ "+") #'(set-pointer-byte! (add1 (get-pointer-byte)))]
|
||||
[#'(_ "-") #'(set-pointer-byte! (sub1 (get-pointer-byte)))]
|
||||
[#'(_ ".") #'(write-byte (get-pointer-byte))]
|
||||
[#'(_ ",") #'(set-pointer-byte! (read-byte))])
|
||||
|
||||
|
||||
(define #'(loop "[" <op-or-loop> ... "]")
|
||||
#'(until (zero? (get-pointer-byte))
|
||||
<op-or-loop> ...))
|
||||
|
||||
;; bf implementation
|
||||
|
||||
;; state: one vector, one pointer
|
||||
(define bf-vector (make-vector 30000 0))
|
||||
(define bf-pointer 0)
|
||||
|
||||
;; gets and sets
|
||||
(define (get-pointer-byte) (vector-ref bf-vector bf-pointer))
|
||||
(define (set-pointer-byte! val) (vector-set! bf-vector bf-pointer val))
|
||||
|
||||
;; pointer mover
|
||||
(define (move-pointer how-far) (set! bf-pointer (+ bf-pointer how-far)))
|
||||
@ -1,27 +0,0 @@
|
||||
#lang ragg
|
||||
;; use uppercase TOKEN-IDENTIFIERS for classes of tokens
|
||||
;; too numerous to indicate individually
|
||||
;; (e.g., numbers, strings)
|
||||
|
||||
;; parser imposes structure:
|
||||
;; takes a flat list of tokens
|
||||
;; and arranges them into an (often hierarchical / recursive) shape.
|
||||
;; produces a parse tree, which is like an annotated, structured version of the source code.
|
||||
;; gives us the parenthesized expressions we need for the expander.
|
||||
|
||||
|
||||
bf-program : (op | loop)*
|
||||
op : ">" | "<" | "+" | "-" | "." | ","
|
||||
loop : "[" (op | loop)* "]"
|
||||
|
||||
|
||||
;; Alternate ways of specifying grammar
|
||||
;; bf-program : op*
|
||||
;; op : ">" | "<" | "+" | "-" | "." | "," | loop
|
||||
;; loop : "[" op* "]"
|
||||
|
||||
;; bf-program : expr*
|
||||
;; expr : op | loop
|
||||
;; op : ">" | "<" | "+" | "-" | "." | ","
|
||||
;; loop : "[" bf-program "]"
|
||||
|
||||
Loading…
Reference in New Issue