From 627ac5fe666b7fb55d555abd8795975edf1c1ec3 Mon Sep 17 00:00:00 2001
From: zongor <admin@alfrescocavern.com>
Date: Sat, 3 Sep 2022 23:32:08 -0400
Subject: [PATCH] first commit

---
 README.md            |  4 +++
 language.rkt         | 82 ++++++++++++++++++++++++++++++++++++++++++++
 parser.rkt           | 71 ++++++++++++++++++++++++++++++++++++++
 reader.rkt           | 11 ++++++
 semantics.rkt        | 62 +++++++++++++++++++++++++++++++++
 test/hello.bf        | 20 +++++++++++
 test/infiniteloop.bf | 22 ++++++++++++
 test/length.bf       | 20 +++++++++++
 test/length.test.bf  | 15 ++++++++
 test/palindrome.bf   |  5 +++
 test/sum.bf          | 28 +++++++++++++++
 test/sum.min.bf      |  2 ++
 12 files changed, 342 insertions(+)
 create mode 100755 README.md
 create mode 100755 language.rkt
 create mode 100755 parser.rkt
 create mode 100755 reader.rkt
 create mode 100755 semantics.rkt
 create mode 100755 test/hello.bf
 create mode 100755 test/infiniteloop.bf
 create mode 100755 test/length.bf
 create mode 100755 test/length.test.bf
 create mode 100755 test/palindrome.bf
 create mode 100755 test/sum.bf
 create mode 100755 test/sum.min.bf

diff --git a/README.md b/README.md
new file mode 100755
index 0000000..8c3185f
--- /dev/null
+++ b/README.md
@@ -0,0 +1,4 @@
+An interpreter for the [Brainf**k](https://esolangs.org/wiki/Brainfuck) esoteric programming language written in Racket Lisp.
+
+This implemetation includes the `!` operator which allows all following characters to be read into the input tape automatically.
+
diff --git a/language.rkt b/language.rkt
new file mode 100755
index 0000000..8d2f287
--- /dev/null
+++ b/language.rkt
@@ -0,0 +1,82 @@
+#lang racket
+(require "semantics.rkt")
+(provide greater-than
+         less-than
+         plus
+         minus
+         period
+         comma
+         colon
+         brackets
+         (rename-out [my-module-begin #%module-begin]))
+
+;; The current-state is a parameter used by the
+;; rest of this language.
+(define current-state (make-parameter (new-state)))
+
+;; Every module in this language will make sure that it
+;; uses a fresh state.
+(define-syntax-rule (my-module-begin body ...)
+  (#%plain-module-begin
+    (parameterize ([current-state (new-state)])
+body ...)))
+
+(define-syntax-rule (greater-than)
+  (increment-ptr (current-state)))
+
+(define-syntax-rule (less-than)
+  (decrement-ptr (current-state)))
+
+(define-syntax-rule (plus)
+  (increment-byte (current-state)))
+
+(define-syntax-rule (minus)
+  (decrement-byte (current-state)))
+
+(define-syntax-rule (period)
+  (write-byte-to-stdout (current-state)))
+
+(define-syntax-rule (comma)
+  (read-byte-from-stdin (current-state)))
+
+(define-syntax-rule (colon)
+  (write-number-to-stdout (current-state)))
+
+(define-syntax-rule (brackets body ...)
+  (loop (current-state) body ...))
+
+#|
+(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)
+(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)
+(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)
+(period)(minus)(minus)(minus)(period)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(period)(period)(plus)(plus)(plus)(period)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)
+(minus)(plus)(plus)(plus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)
+(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)
+(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(plus)(plus)(plus)(plus)(plus)(plus)
+(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(plus)(period)
+(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)
+(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)(comma)(period)(brackets(comma)(period))
+|#
+
+#|
+;Hello World!
+(plus)(plus)(plus)(plus)(plus) (plus)(plus)(plus)(plus)(plus)
+(brackets
+ (greater-than) (plus)(plus)(plus)(plus)(plus) (plus)(plus)
+ (greater-than) (plus)(plus)(plus)(plus)(plus) (plus)(plus)
+ (plus)(plus)(plus) (greater-than) (plus)(plus)(plus)
+ (greater-than) (plus) (less-than)(less-than)(less-than)
+ (less-than) (minus))
+(greater-than) (plus)(plus) (period)
+(greater-than) (plus) (period)
+(plus)(plus)(plus)(plus)(plus) (plus)(plus) (period)
+(period) (plus)(plus)(plus) (period)
+(greater-than) (plus)(plus) (period)
+(less-than)(less-than) (plus)(plus)(plus)(plus)(plus)
+(plus)(plus)(plus)(plus)(plus) (plus)(plus)(plus)(plus)(plus)
+(period) (greater-than) (period)
+(plus)(plus)(plus) (period)
+(minus)(minus)(minus)(minus)(minus)(minus)(period)
+(minus)(minus)(minus)(minus)(minus)(minus)(minus)(minus)
+(period)(greater-than) (plus) (period) (greater-than) (period)
+|#
diff --git a/parser.rkt b/parser.rkt
new file mode 100755
index 0000000..2174c51
--- /dev/null
+++ b/parser.rkt
@@ -0,0 +1,71 @@
+#lang racket
+(require rackunit)
+(require racket/port)
+
+;; The only visible export of this module will be parse-expr.
+(provide parse-expr)
+
+#|
+(define code "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.---.+++++++..+++.---------
+-+++------------------------------------------------------------------------++++++++++++++++++++++++++++++++.
+--------------------------------,.[,.]!Input")
+
+(cond [(regexp-match-positions "!" code) (substring code (cdar (regexp-match-positions "!" code)))])
+
+(cond [(regexp-match-positions "!" code) (open-input-bytes (string->bytes/utf-8 (substring code (cdar (regexp-match-positions "!" code)))))])
+|#
+
+;; parse-expr: any input-port -> (U syntax eof)
+;; Either produces a syntax object or the eof object.
+(define (parse-expr src in)
+  
+  (define code (file->string src));file to string
+  (cond [(regexp-match-positions "!" code) (current-input-port (open-input-bytes (string->bytes/utf-8 (substring code (cdar (regexp-match-positions "!" code))))))])
+
+  (define-values (line column position) (port-next-location in))
+  (define next-char (read-char in))
+  
+  ;; decorate/span: s-expression number -> syntax
+  ;; Wrap the s-expression with source location.
+  (define (decorate sexp span)
+    (datum->syntax #f sexp (list src line column position span)))
+
+  (cond
+    [(eof-object? next-char) eof]
+    [else
+     (case next-char
+       [(#\<) (decorate '(less-than) 1)]
+       [(#\>) (decorate '(greater-than) 1)]
+       [(#\+) (decorate '(plus) 1)]
+       [(#\-) (decorate '(minus) 1)]
+       [(#\,) (decorate '(comma) 1)]
+       [(#\.) (decorate '(period) 1)]
+       [(#\:) (decorate '(colon) 1)]
+       [(#\[)
+        ;; The slightly messy case is bracket.  We keep reading
+        ;; a list of exprs, and then construct a wrapping bracket
+        ;; around the whole thing.
+        (define elements (parse-exprs src in))
+        (define-values (l c tail-position) 
+          (port-next-location in))
+        (decorate `(brackets ,@elements)
+                  (- tail-position position))]
+       [else
+        (parse-expr src in)])]))
+
+;; parse-exprs: input-port -> (listof syntax)
+;; Parse a list of expressions.
+(define (parse-exprs source-name in)
+  (define peeked-char (peek-char in))
+  (cond
+    [(eof-object? peeked-char)
+     (error 'parse-exprs "Expected ], but read eof")]
+    [(char=? peeked-char #\])
+     (read-char in)
+     empty]
+    [(member peeked-char (list #\< #\> #\+ #\- #\, #\. #\[ #\:))
+     (cons (parse-expr source-name in)
+           (parse-exprs source-name in))]
+    [else
+     (read-char in)
+     (parse-exprs source-name in)]))
\ No newline at end of file
diff --git a/reader.rkt b/reader.rkt
new file mode 100755
index 0000000..0367984
--- /dev/null
+++ b/reader.rkt
@@ -0,0 +1,11 @@
+#lang s-exp syntax/module-reader "language.rkt"
+#:read my-read
+#:read-syntax my-read-syntax
+
+(require "parser.rkt")
+
+(define (my-read-syntax src in)
+  (parse-expr src in))
+
+(define (my-read in)  
+  (syntax->datum (my-read-syntax #f in)))
\ No newline at end of file
diff --git a/semantics.rkt b/semantics.rkt
new file mode 100755
index 0000000..465d4f5
--- /dev/null
+++ b/semantics.rkt
@@ -0,0 +1,62 @@
+#lang racket
+(require rackunit)
+(provide (all-defined-out))
+;; Our state contains two pieces.
+(define-struct state (data ptr) #:mutable)
+
+;; Creates a new state, with a byte array of 30000 zeros, and
+;; the pointer at index 0.
+(define (new-state)
+  (make-state (make-vector 30000 0) 0))
+
+;; increment the data pointer
+(define (increment-ptr a-state)
+  (set-state-ptr! a-state (add1 (state-ptr a-state))))
+
+;; decrement the data pointer
+(define (decrement-ptr a-state)
+  (set-state-ptr! a-state (sub1 (state-ptr a-state))))
+
+;; increment the byte at the data pointer
+(define (increment-byte a-state)
+  (define v (state-data a-state))
+  (define i (state-ptr a-state))
+  (vector-set! v i (add1 (vector-ref v i))))
+
+;; decrement the byte at the data pointer
+(define (decrement-byte a-state)
+  (define v (state-data a-state))
+  (define i (state-ptr a-state))
+  (vector-set! v i (sub1 (vector-ref v i))))
+
+;; print the byte at the data pointer
+(define (write-byte-to-stdout a-state)
+  (define v (state-data a-state))
+  (define i (state-ptr a-state))
+  ;(write-byte (vector-ref v i) (current-output-port)))
+  (cond
+    [(eof-object? (vector-ref v i));if the vector is pointing at eof; then set the current position to zero
+     (vector-set! v i 0)]
+    [else
+     (write-byte (vector-ref v i) (current-output-port))]))
+
+;;prints the byte as a number at the data pointer
+(define (write-number-to-stdout a-state)
+  (define v (state-data a-state))
+  (define i (state-ptr a-state))
+  (print (vector-ref v i) (current-output-port))) 
+
+;; read a byte from stdin into the data pointer
+(define (read-byte-from-stdin a-state)
+  (define v (state-data a-state))
+  (define i (state-ptr a-state))
+  (vector-set! v i (read-byte (current-input-port))))
+
+;; loops
+(define-syntax-rule (loop a-state body ...)
+  (local [(define (loop)
+            (unless (= (vector-ref (state-data a-state) (state-ptr a-state))
+0)
+body ...
+              (loop)))]
+(loop)))
\ No newline at end of file
diff --git a/test/hello.bf b/test/hello.bf
new file mode 100755
index 0000000..4030308
--- /dev/null
+++ b/test/hello.bf
@@ -0,0 +1,20 @@
+#lang reader "reader.rkt"
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.---.+++++++.
+.+++.----------+++
+------------------------------------------------------------------------
+++++++++++++++++++++++++++++++++.--------------------------------,.[,.]!World
+
+increments and decrements tape location 0 to write HELLO
+
+increments and decrements tape location 0 in the following way 79-10+3-72+32 = 32 {space}
+
+32-32 = 0; {NULL}
+
+Reads {W} from input and then prints {W}
+Reads {o} from input and then prints {o}
+Reads {r} from input and then prints {r}
+Reads {l} from input and then prints {l}
+Reads {d} from input and then prints {d}
+Reads {NULL} from input and then breaks loop since tape location 0 is now {0}
+
+(then prints all of this text because it is after the '!')
diff --git a/test/infiniteloop.bf b/test/infiniteloop.bf
new file mode 100755
index 0000000..f437420
--- /dev/null
+++ b/test/infiniteloop.bf
@@ -0,0 +1,22 @@
+#lang reader "reader.rkt"
+
+>
+I +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>
+N ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>
+F ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>
+I +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>
+N ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>
+I +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>
+T ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>
+E +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>
+  ++++++++++++++++++++++++++++++++.>
+L ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>
+O +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>
+O +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>
+P ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>
+  ++++++++++++++++++++++++++++++++.>
+<[[<]>.[>.]<]
+
+>,.[>,.]
+<[[<]>.[>.]<]
+!INFINITE LOOP 
\ No newline at end of file
diff --git a/test/length.bf b/test/length.bf
new file mode 100755
index 0000000..619dfff
--- /dev/null
+++ b/test/length.bf
@@ -0,0 +1,20 @@
+#lang reader "reader.rkt"
+
+,.>>+<<[,.>>+<<] this is the simple cat program it reads in a value then moves 2 to the right and adds 1 to the counter then moves back to the input cell again
+
+>++++++++++++++++++++++++++++++++.[-] we leave the 2nd print the space
+
+>- Have to subtract 1 because otherwise it will include the eof character
+
+>>++++++++++<<[->+>-[>+>>]>[+[-<+>]>+>>]<<<<<<]>> in cell  do N modulo 10
+[-]>>>++++++++++<[->-[>+>>]>[+[-<+>]>+>>]<<<<<]> in cell do N modulo 10
+[-]>>[>++++++[-<++++++++>]<. print hundreds
+<<+>+>[-]]<[<[->-<]++++++[->++++++++<]>.[-]] print tens
+<<++++++[-<++++++++>]<. print ones
+[-]<<[-<+>]< cleanup
+
+[-] reset the buffer
+++++++++++. print newline
+
+test input
+!Lorem ipsum dolor sit amet, consectetur adipiscing elit. Pellentesque gravida arcu id arcu eleifend pulvinar. Sed metus.
\ No newline at end of file
diff --git a/test/length.test.bf b/test/length.test.bf
new file mode 100755
index 0000000..7a68c59
--- /dev/null
+++ b/test/length.test.bf
@@ -0,0 +1,15 @@
+#lang reader "reader.rkt"
+
+,.>>+<<[,.>>+<<] this is the simple cat program it reads in a value then moves 2 to the right and adds 1 to the counter then moves back to the input cell again
+
+>++++++++++++++++++++++++++++++++. we leave the 2nd print the space
+
+>- Have to subtract 1 becuase otherwise it will incude the eof character
+
+: Print the value (using one of the bf extensions)
+
+[-] reset the buffer
+++++++++++. print newline
+
+test input
+!Input
\ No newline at end of file
diff --git a/test/palindrome.bf b/test/palindrome.bf
new file mode 100755
index 0000000..9d55214
--- /dev/null
+++ b/test/palindrome.bf
@@ -0,0 +1,5 @@
+#lang reader "reader.rkt"
+
+>,.[>,.]<<[.<]
+
+!race
\ No newline at end of file
diff --git a/test/sum.bf b/test/sum.bf
new file mode 100755
index 0000000..b7203ee
--- /dev/null
+++ b/test/sum.bf
@@ -0,0 +1,28 @@
+#lang reader "reader.rkt"
+
+     0         1         2         3           4              5
+(input 11)(input 12)(input 21)(input 22)(input 1 count)(input 2 count)
+
+,------------------------------------------------ in 0; read input ; subtract ascii zero
+[->>>>++++++++++<<<<]                             in 0; add 10 for each number in 0 to 4
+>                                                 goto 1
+,------------------------------------------------ in 1; read input ; subtract ascii zero
+[->>>+<<<]                                        in 1; add 1 for each number in 1 to 4
+>                                                 goto 2
+,------------------------------------------------ in 2; read input ; subtract ascii zero
+[->>>++++++++++<<<]                               in 2; add 10 for each number in 2 to 5
+>                                                 goto 3
+,------------------------------------------------ in 3; read input ; subtract ascii zero
+[->>+<<]                                          in 3; add 1 for each number in 3 to 5
+>                                                 goto 4
+>[<+>-]<                                          add each number in 5 to 4
+
+>>++++++++++<<[->+>-[>+>>]>[+[-<+>]>+>>]<<<<<<]>> in cell 4 do N modulo 10
+[-]>>>++++++++++<[->-[>+>>]>[+[-<+>]>+>>]<<<<<]> in cell 4 do N modulo 10
+[-]>>[>++++++[-<++++++++>]<. print hundreds
+<<+>+>[-]]<[<[->-<]++++++[->++++++++<]>.[-]] print tens
+<<++++++[-<++++++++>]<. print ones
+[-]<<[-<+>]< cleanup
+
+testing data
+!9999
\ No newline at end of file
diff --git a/test/sum.min.bf b/test/sum.min.bf
new file mode 100755
index 0000000..005066c
--- /dev/null
+++ b/test/sum.min.bf
@@ -0,0 +1,2 @@
+#lang reader "reader.rkt"
+,------------------------------------------------[->>>>++++++++++<<<<]>,------------------------------------------------[->>>+<<<]>,------------------------------------------------[->>>++++++++++<<<]>,------------------------------------------------[->>+<<]>>[<+>-]<>>++++++++++<<[->+>-[>+>>]>[+[-<+>]>+>>]<<<<<<]>>[-]>>>++++++++++<[->-[>+>>]>[+[-<+>]>+>>]<<<<<]>[-]>>[>++++++[-<++++++++>]<.<<+>+>[-]]<[<[->-<]++++++[->++++++++<]>.[-]]<<++++++[-<++++++++>]<.[-]<<[-<+>]<!9999
\ No newline at end of file