From 88aa36b2a6152624afd3403e58c7d620546998f6 Mon Sep 17 00:00:00 2001
From: Peter Hart <cinphart@gmail.com>
Date: Tue, 3 Mar 2020 20:35:20 -0500
Subject: [PATCH] implement bf as a module, with a real parser

---
 .gitignore         |  4 +++-
 bf/atsign.rkt      |  4 ++++
 bf/bf-expander.rkt | 40 ++++++++++++++++++++++++++++++++++++++++
 bf/bf-parser.rkt   |  4 ++++
 bf/bf-reader.rkt   | 18 ++++++++++++++++++
 bf/main.rkt        |  4 ++++
 bf/parser-test.rkt |  3 +++
 7 files changed, 76 insertions(+), 1 deletion(-)
 create mode 100644 bf/atsign.rkt
 create mode 100644 bf/bf-expander.rkt
 create mode 100644 bf/bf-parser.rkt
 create mode 100644 bf/bf-reader.rkt
 create mode 100644 bf/main.rkt
 create mode 100644 bf/parser-test.rkt

diff --git a/.gitignore b/.gitignore
index bfd9047..82c3c6b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,4 @@
 **/compiled/**
-*~
\ No newline at end of file
+*~
+*.zo
+*.dep
diff --git a/bf/atsign.rkt b/bf/atsign.rkt
new file mode 100644
index 0000000..7d947f7
--- /dev/null
+++ b/bf/atsign.rkt
@@ -0,0 +1,4 @@
+#lang reader "bf-reader.rkt"
+Greatest language ever!
+++++-+++-++-++[>++++-+++-++-++<-]>.
+
diff --git a/bf/bf-expander.rkt b/bf/bf-expander.rkt
new file mode 100644
index 0000000..52d25fc
--- /dev/null
+++ b/bf/bf-expander.rkt
@@ -0,0 +1,40 @@
+#lang br/quicklang
+
+(define-macro (bf-module-begin PARSE-TREE)
+  #'(#%module-begin PARSE-TREE))
+
+(provide (rename-out [bf-module-begin #%module-begin]))
+
+(define-macro (bf-program OP-OR-LOOP-ARG ...)
+  #'(void OP-OR-LOOP-ARG ...))
+(provide bf-program)
+
+(define-macro (bf-loop "[" OP-OR-LOOP-ARG ... "]")
+  #'(until (zero? (current-byte))
+      OP-OR-LOOP-ARG ...))
+(provide bf-loop)
+
+(define-macro-cases bf-op
+  [(bf-op ">") #'(gt)]
+  [(bf-op "<") #'(lt)]
+  [(bf-op "+") #'(plus)]
+  [(bf-op "-") #'(minus)]
+  [(bf-op ".") #'(period)]
+  [(bf-op ",") #'(comma)]
+  )
+(provide bf-op)
+
+(define arr (make-vector 30000 0))
+(define ptr 0)
+
+(define (current-byte) (vector-ref arr ptr))
+(define (set-current-byte! val) (vector-set! arr ptr val))
+
+(define (gt) (set! ptr (add1 ptr)))
+(define (lt) (set! ptr (sub1 ptr)))
+
+(define (plus) (set-current-byte! (add1 (current-byte))))
+(define (minus) (set-current-byte! (sub1 (current-byte))))
+
+(define (period) (write-byte (current-byte)))
+(define (comma) (set-current-byte! (read-byte)))
diff --git a/bf/bf-parser.rkt b/bf/bf-parser.rkt
new file mode 100644
index 0000000..a5b7d38
--- /dev/null
+++ b/bf/bf-parser.rkt
@@ -0,0 +1,4 @@
+#lang brag
+bf-program : (bf-op|bf-loop)*
+bf-op      : ">" | "<" | "+" | "-" | "." | ","
+bf-loop    : "[" (bf-op|bf-loop)* "]"
diff --git a/bf/bf-reader.rkt b/bf/bf-reader.rkt
new file mode 100644
index 0000000..b1ac347
--- /dev/null
+++ b/bf/bf-reader.rkt
@@ -0,0 +1,18 @@
+#lang br/quicklang
+
+(require "bf-parser.rkt")
+(define (read-syntax path port)
+  (define parse-tree (parse path (make-tokenizer port)))
+  (define module-datum `(module bf-mod bf/bf-expander ,parse-tree))
+  (datum->syntax #f module-datum))
+(provide read-syntax)
+
+(require brag/support)
+(define (make-tokenizer port)
+  (define (next-token)
+    (define bf-lexer
+      (lexer
+       [(char-set "><-.,+[]") lexeme]
+       [any-char (next-token)]))
+    (bf-lexer port))
+  next-token)
diff --git a/bf/main.rkt b/bf/main.rkt
new file mode 100644
index 0000000..55b0525
--- /dev/null
+++ b/bf/main.rkt
@@ -0,0 +1,4 @@
+#lang br/quicklang
+(module reader br
+  (require "bf-reader.rkt")
+  (provide read-syntax))
diff --git a/bf/parser-test.rkt b/bf/parser-test.rkt
new file mode 100644
index 0000000..a1c6838
--- /dev/null
+++ b/bf/parser-test.rkt
@@ -0,0 +1,3 @@
+#lang br
+(require "bf-parser.rkt")
+(parse-to-datum "+++--[[+>]<,]++.")
\ No newline at end of file