diff --git a/beautiful-racket/br/bf.rkt b/beautiful-racket/br/bf.rkt new file mode 100644 index 0000000..d0b1bbd --- /dev/null +++ b/beautiful-racket/br/bf.rkt @@ -0,0 +1,5 @@ +#lang br + +(module reader br + (require "bf/bf-reader.rkt") + (provide read-syntax)) diff --git a/beautiful-racket/br/bf/#hello-world.rkt#2# b/beautiful-racket/br/bf/#bf-atsign.rkt#1# similarity index 93% rename from beautiful-racket/br/bf/#hello-world.rkt#2# rename to beautiful-racket/br/bf/#bf-atsign.rkt#1# index aebb7cf..1f05494 100644 --- a/beautiful-racket/br/bf/#hello-world.rkt#2# +++ b/beautiful-racket/br/bf/#bf-atsign.rkt#1# @@ -231,37 +231,18 @@ -1 -1 2 1 #"\0" 0 75 1 #"\0" 0 4 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0 -1 --1 0 33 0 26 3 11 #"#lang reade" -0 0 26 3 2 #"r " -0 0 26 3 8 #"\"bf.rkt\"" +-1 0 14 0 26 3 28 #"#lang reader \"bf-reader.rkt\"" 0 0 24 29 1 #"\n" -0 0 14 3 6 #"++++++" -0 0 24 3 1 #"[" -0 0 14 3 15 #">++++++++++++<-" -0 0 24 3 1 #"]" -0 0 14 3 2 #">." -0 0 24 29 1 #"\n" -0 0 14 3 11 #">++++++++++" -0 0 24 3 1 #"[" -0 0 14 3 13 #">++++++++++<-" -0 0 24 3 1 #"]" -0 0 14 3 3 #">+." +0 0 14 3 8 #"Greatest" +0 0 24 3 1 #" " +0 0 14 3 8 #"language" +0 0 24 3 1 #" " +0 0 14 3 5 #"ever!" 0 0 24 29 1 #"\n" -0 0 14 3 18 #"+++++++..+++.>++++" +0 0 14 3 8 #"++++++++" 0 0 24 3 1 #"[" -0 0 14 3 14 #">+++++++++++<-" +0 0 14 3 11 #">++++++++<-" 0 0 24 3 1 #"]" 0 0 14 3 2 #">." -0 0 24 29 1 #"\n" -0 0 14 3 4 #"<+++" -0 0 24 3 1 #"[" -0 0 14 3 7 #">----<-" -0 0 24 3 1 #"]" -0 0 14 3 10 #">.<<<<<+++" 0 0 24 3 1 #"[" -0 0 14 3 8 #">+++++<-" -0 0 24 3 1 #"]" -0 0 14 3 2 #">." -0 0 24 29 1 #"\n" -0 0 14 3 27 #">>.+++.------.--------.>>+." 0 0 diff --git a/beautiful-racket/br/bf/bf-atsign-sexp.rkt b/beautiful-racket/br/bf/bf-atsign-sexp.rkt new file mode 100644 index 0000000..3c9f767 --- /dev/null +++ b/beautiful-racket/br/bf/bf-atsign-sexp.rkt @@ -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 ".")) \ No newline at end of file diff --git a/beautiful-racket/br/bf/bf-atsign.rkt b/beautiful-racket/br/bf/bf-atsign.rkt new file mode 100644 index 0000000..5ada6f4 --- /dev/null +++ b/beautiful-racket/br/bf/bf-atsign.rkt @@ -0,0 +1,2 @@ +#lang reader "bf-reader.rkt" ++++++++[>+++++<-]>. diff --git a/beautiful-racket/br/bf/bf-expander.rkt b/beautiful-racket/br/bf/bf-expander.rkt new file mode 100644 index 0000000..78aa25a --- /dev/null +++ b/beautiful-racket/br/bf/bf-expander.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 ...) + #'(begin ...)) + +;; 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 "[" ... "]") + #'(until (zero? (get-pointer-byte)) + ...)) + +;; 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))) \ No newline at end of file diff --git a/beautiful-racket/br/bf/bf-hash.rkt b/beautiful-racket/br/bf/bf-hash.rkt index f849c29..5ada6f4 100644 --- a/beautiful-racket/br/bf/bf-hash.rkt +++ b/beautiful-racket/br/bf/bf-hash.rkt @@ -1,2 +1,2 @@ -#lang reader "bf.rkt" +#lang reader "bf-reader.rkt" +++++++[>+++++<-]>. diff --git a/beautiful-racket/br/bf/bf-parser.rkt b/beautiful-racket/br/bf/bf-parser.rkt new file mode 100644 index 0000000..82a4777 --- /dev/null +++ b/beautiful-racket/br/bf/bf-parser.rkt @@ -0,0 +1,4 @@ +#lang ragg +bf-program : (op | loop)* +op : ">" | "<" | "+" | "-" | "." | "," +loop : "[" (op | loop)* "]" \ No newline at end of file diff --git a/beautiful-racket/br/bf/bf-reader.rkt b/beautiful-racket/br/bf/bf-reader.rkt new file mode 100644 index 0000000..cc2397f --- /dev/null +++ b/beautiful-racket/br/bf/bf-reader.rkt @@ -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) diff --git a/beautiful-racket/br/bf/bf.rkt b/beautiful-racket/br/bf/bf.rkt deleted file mode 100644 index 36aa536..0000000 --- a/beautiful-racket/br/bf/bf.rkt +++ /dev/null @@ -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 ...) - #'(begin ...)) - -;; 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 "[" ... "]") - #'(until (zero? (get-pointer-byte)) - ...)) - -;; 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))) \ No newline at end of file diff --git a/beautiful-racket/br/bf/hello-world.rkt b/beautiful-racket/br/bf/hello-world.rkt index 4e189f8..7ce18c1 100644 --- a/beautiful-racket/br/bf/hello-world.rkt +++ b/beautiful-racket/br/bf/hello-world.rkt @@ -1,4 +1,4 @@ -#lang br/bf +#lang reader "bf-reader.rkt" ++++++[>++++++++++++<-]>. >++++++++++[>++++++++++<-]>+. +++++++..+++.>++++[>+++++++++++<-]>. diff --git a/beautiful-racket/br/bf/parser.rkt b/beautiful-racket/br/bf/parser.rkt deleted file mode 100644 index a5ce3b1..0000000 --- a/beautiful-racket/br/bf/parser.rkt +++ /dev/null @@ -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 "]" -