From d03ff769e2645be1dca51a4920e293d25764dec5 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 14 Apr 2016 13:10:29 -0700 Subject: [PATCH] adds and changes --- .../{#bf-atsign.rkt#1# => #bf-atsign.rkt#2#} | 33 ++++++++--- beautiful-racket/br/bf/bf-atsign.rkt | 3 +- beautiful-racket/br/bf/bf-expander.rkt | 58 ++++++++----------- beautiful-racket/br/bf/bf-factorial.rkt | 7 +++ 4 files changed, 59 insertions(+), 42 deletions(-) rename beautiful-racket/br/bf/{#bf-atsign.rkt#1# => #bf-atsign.rkt#2#} (93%) create mode 100644 beautiful-racket/br/bf/bf-factorial.rkt diff --git a/beautiful-racket/br/bf/#bf-atsign.rkt#1# b/beautiful-racket/br/bf/#bf-atsign.rkt#2# similarity index 93% rename from beautiful-racket/br/bf/#bf-atsign.rkt#1# rename to beautiful-racket/br/bf/#bf-atsign.rkt#2# index 1f05494..faf606c 100644 --- a/beautiful-racket/br/bf/#bf-atsign.rkt#1# +++ b/beautiful-racket/br/bf/#bf-atsign.rkt#2# @@ -231,18 +231,35 @@ -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 14 0 26 3 28 #"#lang reader \"bf-reader.rkt\"" +-1 0 31 0 26 3 28 #"#lang reader \"bf-reader.rkt\"" 0 0 24 29 1 #"\n" -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 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 24 29 1 #"\n" -0 0 14 3 8 #"++++++++" +0 0 14 3 18 #"+++++++..+++.>++++" 0 0 24 3 1 #"[" -0 0 14 3 11 #">++++++++<-" +0 0 14 3 14 #">+++++++++++<-" 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.rkt b/beautiful-racket/br/bf/bf-atsign.rkt index 5ada6f4..dd149f7 100644 --- a/beautiful-racket/br/bf/bf-atsign.rkt +++ b/beautiful-racket/br/bf/bf-atsign.rkt @@ -1,2 +1,3 @@ #lang reader "bf-reader.rkt" -+++++++[>+++++<-]>. +Greatest language ever! +++++++++[>++++++++<-]>. \ No newline at end of file diff --git a/beautiful-racket/br/bf/bf-expander.rkt b/beautiful-racket/br/bf/bf-expander.rkt index 78aa25a..6794d6a 100644 --- a/beautiful-racket/br/bf/bf-expander.rkt +++ b/beautiful-racket/br/bf/bf-expander.rkt @@ -1,44 +1,36 @@ #lang br -(provide (rename-out [bf-module-begin #%module-begin]) - #%top-interaction) -(define #'(bf-module-begin BF-PARSE-TREE ...) +(define #'(bf-module-begin PARSE-TREE ...) #'(#%module-begin - BF-PARSE-TREE ...)) - - -;; macros to expand our parse tree into local functions - -(provide bf-program op loop) + PARSE-TREE ...)) +(provide (rename-out [bf-module-begin #%module-begin]) + #%top-interaction) -;; bf-program doesn't do anything -(define #'(bf-program ...) - #'(begin ...)) +(define #'(bf-program OP-OR-LOOP ...) + #'(begin OP-OR-LOOP ...)) +(provide bf-program) -;; 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)) - ...)) + [#'(op ">") #'(move-pointer 1)] + [#'(op "<") #'(move-pointer -1)] + [#'(op "+") #'(set-current-byte! (add1 (get-current-byte)))] + [#'(op "-") #'(set-current-byte! (sub1 (get-current-byte)))] + [#'(op ".") #'(write-byte (get-current-byte))] + [#'(op ",") #'(set-current-byte! (read-byte))]) +(provide op) -;; 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)) +(define (move-pointer how-far) + (set! bf-pointer (+ bf-pointer how-far))) + +(define (get-current-byte) + (vector-ref bf-vector bf-pointer)) +(define (set-current-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 +(define #'(loop "[" OP-OR-LOOP ... "]") + #'(until (zero? (get-current-byte)) + OP-OR-LOOP ...)) +(provide loop) diff --git a/beautiful-racket/br/bf/bf-factorial.rkt b/beautiful-racket/br/bf/bf-factorial.rkt new file mode 100644 index 0000000..f4973c8 --- /dev/null +++ b/beautiful-racket/br/bf/bf-factorial.rkt @@ -0,0 +1,7 @@ +#lang reader "bf-reader.rkt" +>++++++++++>>>+>+[>>>+[-[<<<<<[+<<<<<]>>[[-]>[<<+>+>-] +<[>+<-]<[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<- +[>[-]>>>>+>+<<<<<<-[>+<-]]]]]]]]]]]>[<+>-]+>>>>>]<<<<< +[<<<<<]>>>>>>>[>>>>>]++[-<<<<<]>>>>>>-]+>>>>>]<[>++<-] +<<<<[<[>+<-]<<<<]>>[->[-]++++++[<++++++++>-]>>>>]<<<<< +[<[>+>+<<-]>.<<<<<]>.>>>>] \ No newline at end of file