fork download
copy 
  1. #!/usr/bin/env racket
  2. #lang racket/base
  3.  
  4. (define (brainfuck ptr memory c)
  5.   (if (eof-object? c)
  6.      memory
  7.      (case c
  8.        ((#\>) (let ((ptr (+ ptr 1)))
  9.                 (brainfuck ptr `(inc-ptr ,ptr ,memory) (read-char))))
  10.        ((#\<) (brainfuck (- ptr 1) `(dec-ptr ,(- ptr 1) ,memory) (read-char)))
  11.        ((#\+) (brainfuck ptr `(inc-val ,ptr ,memory) (read-char)))
  12.        ((#\-) (brainfuck ptr `(dec-val ,ptr ,memory) (read-char)))
  13.        ((#\.) (brainfuck ptr `(putchar ,ptr ,memory) (read-char)))
  14.        ((#\,) (brainfuck ptr `(getchar ,ptr ,memory) (read-char)))
  15.        ((#\[) (brainfuck ptr
  16.                         `(do ((memory ,memory ,(brainfuck ptr 'memory (read-char))))
  17.                            ((zero? (list-ref memory (- (length memory) ,ptr 1))) memory))
  18.                         (read-char)))
  19.        ((#\]) memory)
  20.        (else (brainfuck ptr memory (read-char))))))
  21.  
  22. (define (compile file0 file1)
  23.   (with-input-from-file file0
  24.     (lambda ()
  25.       (with-output-to-file file1
  26.         (lambda ()
  27.           (for-each display
  28.                    `("#!/usr/bin/env racket\n"
  29.                      "#lang racket\n"
  30.                      (require srfi/1)
  31.                      "\n"
  32.                      (define (inc-ptr k lst)
  33.                        (let ((n (+ k 1)))
  34.                          (if (> n (length lst))
  35.                             (cons 0 lst)
  36.                             lst)))
  37.                      "\n"
  38.                      (define (dec-ptr k lst)
  39.                        lst)
  40.                      "\n"
  41.                      (define (inc-val k lst)
  42.                        (let ((n (- (length lst) k 1)))
  43.                          (let-values (((head tail) (split-at lst n)))
  44.                            (let ((val (+ (car tail) 1)))
  45.                              (append head (cons val (cdr tail)))))))
  46.                      "\n"
  47.                      (define (dec-val k lst)
  48.                        (let ((n (- (length lst) k 1)))
  49.                          (let-values (((head tail) (split-at lst n)))
  50.                            (let ((val (- (car tail) 1)))
  51.                              (append head (cons val (cdr tail)))))))
  52.                      "\n"
  53.                      (define (putchar k lst)
  54.                        (let ((n (- (length lst) k 1)))
  55.                          (display (integer->char (list-ref lst n)))
  56.                          lst))
  57.                      "\n"
  58.                      (define (getchar k lst)
  59.                        (let ((n (- (length lst) k 1)))
  60.                          (let-values (((head tail) (split-at lst n)))
  61.                            (append head (cons (char->integer (read-char)) (cdr tail))))))
  62.                      "\n"
  63.                      ,(brainfuck 0 ''(0) (read-char)))
  64.                    ))))))
Success #stdin #stdout 0.64s 68336KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/xdWzvQ
language:
Racket (racket 7.0)
created:
5 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!