change op & loop to use bf- prefix

pull/10/head
Matthew Butterick 7 years ago
parent 7a7e162988
commit 2eb46aaa81

@ -9,19 +9,19 @@
#'(void OP-OR-LOOP-ARG ...)) #'(void OP-OR-LOOP-ARG ...))
(provide bf-program) (provide bf-program)
(define-macro (loop "[" OP-OR-LOOP-ARG ... "]") (define-macro (bf-loop "[" OP-OR-LOOP-ARG ... "]")
#'(until (zero? (current-byte)) #'(until (zero? (current-byte))
OP-OR-LOOP-ARG ...)) OP-OR-LOOP-ARG ...))
(provide loop) (provide bf-loop)
(define-macro-cases op (define-macro-cases bf-op
[(op ">") #'(gt)] [(bf-op ">") #'(gt)]
[(op "<") #'(lt)] [(bf-op "<") #'(lt)]
[(op "+") #'(plus)] [(bf-op "+") #'(plus)]
[(op "-") #'(minus)] [(bf-op "-") #'(minus)]
[(op ".") #'(period)] [(bf-op ".") #'(period)]
[(op ",") #'(comma)]) [(bf-op ",") #'(comma)])
(provide op) (provide bf-op)
(define arr (make-vector 30000 0)) (define arr (make-vector 30000 0))
(define ptr 0) (define ptr 0)

@ -16,23 +16,23 @@
(void (fold-funcs first-apl (list OP-OR-LOOP-ARG ...))))) (void (fold-funcs first-apl (list OP-OR-LOOP-ARG ...)))))
(provide bf-program) (provide bf-program)
(define-macro (loop "[" OP-OR-LOOP-ARG ... "]") (define-macro (bf-loop "[" OP-OR-LOOP-ARG ... "]")
#'(lambda (arr ptr) #'(lambda (arr ptr)
(for/fold ([current-apl (list arr ptr)]) (for/fold ([current-apl (list arr ptr)])
([i (in-naturals)] ([i (in-naturals)]
#:break (zero? (apply current-byte #:break (zero? (apply current-byte
current-apl))) current-apl)))
(fold-funcs current-apl (list OP-OR-LOOP-ARG ...))))) (fold-funcs current-apl (list OP-OR-LOOP-ARG ...)))))
(provide loop) (provide bf-loop)
(define-macro-cases op (define-macro-cases bf-op
[(op ">") #'gt] [(bf-op ">") #'gt]
[(op "<") #'lt] [(bf-op "<") #'lt]
[(op "+") #'plus] [(bf-op "+") #'plus]
[(op "-") #'minus] [(bf-op "-") #'minus]
[(op ".") #'period] [(bf-op ".") #'period]
[(op ",") #'comma]) [(bf-op ",") #'comma])
(provide op) (provide bf-op)
(define (current-byte arr ptr) (vector-ref arr ptr)) (define (current-byte arr ptr) (vector-ref arr ptr))

@ -16,23 +16,23 @@
(void (fold-funcs first-apl (list OP-OR-LOOP-ARG ...))))) (void (fold-funcs first-apl (list OP-OR-LOOP-ARG ...)))))
(provide bf-program) (provide bf-program)
(define-macro (loop "[" OP-OR-LOOP-ARG ... "]") (define-macro (bf-loop "[" OP-OR-LOOP-ARG ... "]")
#'(lambda (arr ptr) #'(lambda (arr ptr)
(for/fold ([current-apl (list arr ptr)]) (for/fold ([current-apl (list arr ptr)])
([i (in-naturals)] ([i (in-naturals)]
#:break (zero? (apply current-byte #:break (zero? (apply current-byte
current-apl))) current-apl)))
(fold-funcs current-apl (list OP-OR-LOOP-ARG ...))))) (fold-funcs current-apl (list OP-OR-LOOP-ARG ...)))))
(provide loop) (provide bf-loop)
(define-macro-cases op (define-macro-cases bf-op
[(op ">") #'gt] [(bf-op ">") #'gt]
[(op "<") #'lt] [(bf-op "<") #'lt]
[(op "+") #'plus] [(bf-op "+") #'plus]
[(op "-") #'minus] [(bf-op "-") #'minus]
[(op ".") #'period] [(bf-op ".") #'period]
[(op ",") #'comma]) [(bf-op ",") #'comma])
(provide op) (provide bf-op)
(define (current-byte arr ptr) (vector-ref arr ptr)) (define (current-byte arr ptr) (vector-ref arr ptr))

@ -1,4 +1,4 @@
#lang brag #lang brag
bf-program : (op | loop)* bf-program : (bf-op | bf-loop)*
op : ">" | "<" | "+" | "-" | "." | "," bf-op : ">" | "<" | "+" | "-" | "." | ","
loop : "[" (op | loop)* "]" bf-loop : "[" (bf-op | bf-loop)* "]"
Loading…
Cancel
Save