/prog/ - Brainfuck DSL for Scheme

Name: Anonymous 2013-02-11 3:06

To unshit the board a bit, here is a macro.


(define-syntax %%bf

  (syntax-rules ( > < + - |.| |,| >>>>> >>>> >>> >> <<<<< <<<< <<< << +++++ ++++ +++ ++ ----- ---- --- -- )

    ((%%bf ptr arr (gen ...) >>>>> bfcode ...) (%%bf ptr arr (gen ...) > > > > > bfcode ...))

    ((%%bf ptr arr (gen ...) >>>> bfcode ...) (%%bf ptr arr (gen ...) > > > > bfcode ...))

    ((%%bf ptr arr (gen ...) >>> bfcode ...) (%%bf ptr arr (gen ...) > > > bfcode ...))

    ((%%bf ptr arr (gen ...) >> bfcode ...) (%%bf ptr arr (gen ...) > > bfcode ...))

    

    ((%%bf ptr arr (gen ...) <<<<< bfcode ...) (%%bf ptr arr (gen ...) < < < < < bfcode ...))

    ((%%bf ptr arr (gen ...) <<<< bfcode ...) (%%bf ptr arr (gen ...) < < < < bfcode ...))

    ((%%bf ptr arr (gen ...) <<< bfcode ...) (%%bf ptr arr (gen ...) < < < bfcode ...))

    ((%%bf ptr arr (gen ...) << bfcode ...) (%%bf ptr arr (gen ...) < < bfcode ...))

    

    ((%%bf ptr arr (gen ...) +++++ bfcode ...) (%%bf ptr arr (gen ...) + + + + + bfcode ...))

    ((%%bf ptr arr (gen ...) ++++ bfcode ...) (%%bf ptr arr (gen ...) + + + + bfcode ...))

    ((%%bf ptr arr (gen ...) +++ bfcode ...) (%%bf ptr arr (gen ...) + + + bfcode ...))

    ((%%bf ptr arr (gen ...) ++ bfcode ...) (%%bf ptr arr (gen ...) + + bfcode ...))

    

    ((%%bf ptr arr (gen ...) ----- bfcode ...) (%%bf ptr arr (gen ...) - - - - - bfcode ...))

    ((%%bf ptr arr (gen ...) ---- bfcode ...) (%%bf ptr arr (gen ...) - - - - bfcode ...))

    ((%%bf ptr arr (gen ...) --- bfcode ...) (%%bf ptr arr (gen ...) - - - bfcode ...))

    ((%%bf ptr arr (gen ...) -- bfcode ...) (%%bf ptr arr (gen ...) - - bfcode ...))

    

    ((%%bf ptr arr (gen ...) > bfcode ...)

     (%%bf ptr arr (gen ... (set! ptr (+ ptr 1)) (if (> ptr 255) (set! ptr 0) #f)) bfcode ...))

    ((%%bf ptr arr (gen ...) < bfcode ...)

     (%%bf ptr arr (gen ... (set! ptr (- ptr 1)) (if (< ptr 0) (set! ptr 255) #f)) bfcode ...))

    ((%%bf ptr arr (gen ...) + bfcode ...)

     (%%bf ptr arr (gen ... (vector-set! arr ptr (+ (vector-ref arr ptr) 1))) bfcode ...))

    ((%%bf ptr arr (gen ...) - bfcode ...)

     (%%bf ptr arr (gen ... (vector-set! arr ptr (- (vector-ref arr ptr) 1))) bfcode ...))

    ((%%bf ptr arr (gen ...) |.| bfcode ...)

     (%%bf ptr arr (gen ... (display (integer->char (vector-ref arr ptr)))) bfcode ...))

    ((%%bf ptr arr (gen ...) (inner ...) bfcode ...)

     (%%bf ptr arr (gen ... (let lp () (if (> (vector-ref arr ptr) 0) (begin (%%bf ptr arr (begin) inner ...) (lp)) #f))) bfcode ...))

    ((%%bf ptr arr (gen ...) comments bfcode ...)

     (%%bf ptr arr (gen ...) bfcode ...))

    

    ((%%bf ptr arr (gen ...))

     (gen ...))))



(define-syntax bf

  (syntax-rules ()

    ((bf bfcode ...)

     (let ((ptr 0)

           (arr (make-vector 10)))

       (%%bf ptr arr (begin) bfcode ...)

       arr))))
Brainfuck DSL for Scheme

1 Name: Anonymous 2013-02-11 3:06

9 Name: Anonymous 2013-02-11 5:31

Name: Anonymous 2013-02-11 3:06

Name: Anonymous 2013-02-11 5:31
