implement bf as a module, with a real parser
This commit is contained in:
parent
c7616458b7
commit
88aa36b2a6
4
.gitignore
vendored
4
.gitignore
vendored
@ -1,2 +1,4 @@
|
|||||||
**/compiled/**
|
**/compiled/**
|
||||||
*~
|
*~
|
||||||
|
*.zo
|
||||||
|
*.dep
|
||||||
|
|||||||
4
bf/atsign.rkt
Normal file
4
bf/atsign.rkt
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
#lang reader "bf-reader.rkt"
|
||||||
|
Greatest language ever!
|
||||||
|
++++-+++-++-++[>++++-+++-++-++<-]>.
|
||||||
|
|
||||||
40
bf/bf-expander.rkt
Normal file
40
bf/bf-expander.rkt
Normal file
@ -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)))
|
||||||
4
bf/bf-parser.rkt
Normal file
4
bf/bf-parser.rkt
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
#lang brag
|
||||||
|
bf-program : (bf-op|bf-loop)*
|
||||||
|
bf-op : ">" | "<" | "+" | "-" | "." | ","
|
||||||
|
bf-loop : "[" (bf-op|bf-loop)* "]"
|
||||||
18
bf/bf-reader.rkt
Normal file
18
bf/bf-reader.rkt
Normal file
@ -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)
|
||||||
4
bf/main.rkt
Normal file
4
bf/main.rkt
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
#lang br/quicklang
|
||||||
|
(module reader br
|
||||||
|
(require "bf-reader.rkt")
|
||||||
|
(provide read-syntax))
|
||||||
3
bf/parser-test.rkt
Normal file
3
bf/parser-test.rkt
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
#lang br
|
||||||
|
(require "bf-parser.rkt")
|
||||||
|
(parse-to-datum "+++--[[+>]<,]++.")
|
||||||
Loading…
x
Reference in New Issue
Block a user