add while
and until
This commit is contained in:
parent
948f40e002
commit
2712ffa472
|
@ -20,25 +20,22 @@
|
|||
(for-each println (map syntax->datum result))
|
||||
result))
|
||||
|
||||
(define #'(bf-program <op> ...)
|
||||
#'(begin <op> ...))
|
||||
|
||||
(define #'(bf-program arg ...)
|
||||
#'(begin arg ...))
|
||||
(define #'(op <arg>)
|
||||
(syntax-case #'(op <arg>) ()
|
||||
[(op ">") #'(move-pointer 1)]
|
||||
[(op "<") #'(move-pointer -1)]
|
||||
[(op "+") #'(set-pointer-byte! (add1 (pointer-byte)))]
|
||||
[(op "-") #'(set-pointer-byte! (sub1 (pointer-byte)))]
|
||||
[(op ".") #'(write-byte (pointer-byte))]
|
||||
[(op ",") #'(set-pointer-byte! (read-byte))]
|
||||
[else #'<arg>])) ; <arg> must therefore be a loop
|
||||
|
||||
(define #'(op arg)
|
||||
(case (syntax->datum #'arg)
|
||||
[(">") #'(move-pointer 1)]
|
||||
[("<") #'(move-pointer -1)]
|
||||
[("+") #'(set-pointer-byte! (add1 (pointer-byte)))]
|
||||
[("-") #'(set-pointer-byte! (sub1 (pointer-byte)))]
|
||||
[(".") #'(write-byte (pointer-byte))]
|
||||
[(",") #'(set-pointer-byte! (read-byte (current-input-port)))]
|
||||
[else #'arg]))
|
||||
|
||||
(define #'(loop lb arg ... rb)
|
||||
#'(let loop ()
|
||||
(unless (zero? (pointer-byte))
|
||||
arg ...
|
||||
(loop))))
|
||||
(define #'(loop "[" <op> ... "]")
|
||||
#'(until (zero? (pointer-byte))
|
||||
<op> ...))
|
||||
|
||||
(define bf-vector (make-vector 10 0))
|
||||
(define bf-pointer 0)
|
||||
|
|
15
br/conditional.rkt
Normal file
15
br/conditional.rkt
Normal file
|
@ -0,0 +1,15 @@
|
|||
#lang racket/base
|
||||
(require (for-syntax racket/base))
|
||||
(provide (all-defined-out))
|
||||
|
||||
(define-syntax-rule (until cond expr ...)
|
||||
(let loop ()
|
||||
(unless cond
|
||||
expr ...
|
||||
(loop))))
|
||||
|
||||
(define-syntax-rule (while cond expr ...)
|
||||
(let loop ()
|
||||
(when cond
|
||||
expr ...
|
||||
(loop))))
|
|
@ -1,10 +1,10 @@
|
|||
#lang racket/base
|
||||
(require racket/provide racket/list racket/string racket/format racket/match racket/port
|
||||
br/define br/syntax br/datum br/debug
|
||||
br/define br/syntax br/datum br/debug br/conditional
|
||||
(for-syntax racket/base racket/syntax br/syntax br/define))
|
||||
(provide (except-out (all-from-out racket/base) define)
|
||||
(all-from-out racket/list racket/string racket/format racket/match racket/port
|
||||
br/syntax br/datum br/debug)
|
||||
br/syntax br/datum br/debug br/conditional)
|
||||
(for-syntax (all-from-out racket/base racket/syntax br/syntax))
|
||||
(filtered-out
|
||||
(λ (name)
|
||||
|
|
Loading…
Reference in New Issue
Block a user