Add bf
This commit is contained in:
parent
2858c36827
commit
78f0a782b1
|
@ -0,0 +1,3 @@
|
|||
#lang reader "reader.rkt"
|
||||
Greatest language ever!
|
||||
++++-+++-++-++[>++++-+++-++-++<-]>.
|
|
@ -0,0 +1,64 @@
|
|||
#lang br/quicklang
|
||||
|
||||
(define-macro (bf-module-begin PARSE-TREE)
|
||||
#'(#%module-begin
|
||||
PARSE-TREE))
|
||||
(provide (rename-out [bf-module-begin #%module-begin]))
|
||||
|
||||
(define (fold-funcs apl bf-funcs)
|
||||
(for/fold ([current-apl apl])
|
||||
([bf-func (in-list bf-funcs)])
|
||||
(apply bf-func current-apl)))
|
||||
|
||||
(define-macro (bf-program OP-OR-LOOP-ARG ...)
|
||||
#'(begin
|
||||
(define first-apl (list (make-vector 30000 0) 0))
|
||||
(void (fold-funcs first-apl (list OP-OR-LOOP-ARG ...)))))
|
||||
(provide bf-program)
|
||||
|
||||
(define-macro (bf-loop "[" OP-OR-LOOP-ARG ... "]")
|
||||
#'(lambda (arr ptr)
|
||||
(for/fold ([current-apl (list arr ptr)])
|
||||
([i (in-naturals)]
|
||||
#:break (zero? (apply current-byte
|
||||
current-apl)))
|
||||
(fold-funcs current-apl (list 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 (current-byte arr ptr) (vector-ref arr ptr))
|
||||
|
||||
(define (set-current-byte arr ptr val)
|
||||
(define new-arr (vector-copy arr))
|
||||
(vector-set! new-arr ptr val)
|
||||
new-arr)
|
||||
|
||||
(define (gt arr ptr) (list arr (add1 ptr)))
|
||||
|
||||
(define (lt arr ptr) (list arr (sub1 ptr)))
|
||||
|
||||
(define (plus arr ptr)
|
||||
(list
|
||||
(set-current-byte arr ptr (add1 (current-byte arr ptr)))
|
||||
ptr))
|
||||
|
||||
(define (minus arr ptr)
|
||||
(list
|
||||
(set-current-byte arr ptr (sub1 (current-byte arr ptr)))
|
||||
ptr))
|
||||
|
||||
(define (period arr ptr)
|
||||
(write-byte (current-byte arr ptr))
|
||||
(list arr ptr))
|
||||
|
||||
(define (comma arr ptr)
|
||||
(list (set-current-byte arr ptr (read-byte)) ptr))
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
bf-program : (bf-op | bf-loop)*
|
||||
bf-op : ">" | "<" | "+" | "-" | "." | ","
|
||||
bf-loop : "[" (bf-op | bf-loop)* "]"
|
|
@ -0,0 +1,3 @@
|
|||
#lang br
|
||||
(require "parser.rkt")
|
||||
(parse-to-datum "++++-+++-++-++[>++++-+++-++-++<-]>.")
|
|
@ -0,0 +1,4 @@
|
|||
#lang brag
|
||||
bf-program : (bf-op | bf-loop)*
|
||||
bf-op : ">" | "<" | "+" | "-" | "." | ","
|
||||
bf-loop : "[" (bf-op | bf-loop)* "]"
|
|
@ -0,0 +1,19 @@
|
|||
#lang br/quicklang
|
||||
(require "parser.rkt")
|
||||
|
||||
(define (read-syntax path port)
|
||||
(define parse-tree (parse path (make-tokenizer port)))
|
||||
(define module-datum `(module bf-mod "expander.rkt"
|
||||
,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)
|
Loading…
Reference in New Issue