brainsuck：高级语言到 brainfuck 编译器（支持函数与递归）

[cjxgm]

忙了两个礼拜，终于用 perl 写成了
有类似于C语言的语法，支持函数与递归！
欢迎围观：https://github.com/cjxgm/brainsuck


Q：这是啥？
A：把一个类似C语言的语言编译成 brainfuck 语言的编译器。

Q：编译成 brainfuck 有意义吗？
A：有。至少你可以用它来装13。用高级语言写个程序，然后轻松转成 brainfuck，然后分享给别人……别人一定会说：Is your brain fucked?

Q：真的类似C语言？
A：嗯嗯，还是有点小区别的。看示例程序：
[c]# test

main()
{
@ x;

while (x != 'x') {
"what? ";
x = getc();
while (x == 10 || x == 13) x = getc(); # skip newline

if (x == 'a') "Hi!";
else if (x-'0' == 2) "Wow!";
else {"> "; putc(x);}
putc(10); # newline
}
}[/c]

Q：编译以后是什么样的？
A：[c]>>>+[<[->-]>[-<>+>->]<+[<[->-]>[-<<[->+>+<<]>>[-<<+>>]++++++++++++++++
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++++++++++++++++++++++++++++[-<->]<[[-]>+<]+>[-<+>>]<[++>]->]<+[
<[->-]>[-<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]+++++++
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+++++++++++++++++++++++++++.[-]+++++++++++++++++++++++++++++++++++++++
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]++++++++
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++++++++++++++++++++++++++++++++.[-]++++++++++++++++++++++++++++
+++++++++++++++++++++++++++++++++++.[-]+++++++++++++++++++++++++++++++
+.[-],<[-]>[-<+>]++++>->]<+[<[->-]>[-<<[-]>>+<<->]<+[<[->-]>[-<<[->+>+
<<]>>[-<<+>>]++++++++++[-<->]<[[-]>+<]+>[-<->]<[[-]>+<]>[-<+>]<<[->>+>
+<<<]>>>[-<<<+>>>]+++++++++++++[-<->]<[[-]>+<]+>[-<->]<[[-]>+<]>[-<+>]
<[-<+>]<[[-]>+<]+>[-<++++>>]<[+++++>]->]<+[<[->-]>[-<,<[-]>[-<+>]++++>
->]<+[<[->-]>[-<<[->+>+<<]>>[-<<+>>]++++++++++++++++++++++++++++++++++
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++[-<->]<
[[-]>+<]+>[-<->]<[[-]>+<]+>[-<++++++++>+++++++>>]<[++++++++>++++++++>]
->]<+[<[->-]>[-<++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++++++++++++.[-]++++++++++++++++++++++++++++++++++++++++++++++++
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++.[-]+++++++++
++++++++++++++++++++++++.[-]->]<+[<[->-]>[-<<<[->>+>+<<<]>>>[-<<<+>>>]
++++++++++++++++++++++++++++++++++++++++++++++++[-<->]++[-<->]<[[-]>+<
]+>[-<->]<[[-]>+<]+>[-<+++++++++++>++++++++++>>]<[+++++++++++>++++++++
+++>]->]<+[<[->-]>[-<++++++++++.[-][-]+>->]<+[<[->-]>[-<++++++++++++++
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+++.[-]+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++++++++++++++++++++++++++++++++++++++++++.[-]++++++++++++++++++
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+++++++++++++++++++++++++++++++.[-]+++++++++++++++++++++++++++++++++.[
-]->]<+[<[->-]>[-<++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++++.[-]++++++++++++++++++++++++++++++++.[-]<<<[->>>+>+<<<<]>>>>
[-<<<<+>>>>]<.[-][-]->]<+[<[->-]>[-<->]<+[-]]]]]]]]]]]]]+>>[-<<->>]<<]
<<[/c]

[JiangHui]

good job
装逼利器

[ee.zsy]

好可怕

----

模仿着写了一下，刚开个头，特性还没啥

代码： 全选

#lang scheme
(define (o x) 
  (define (op name identity)
    (letrec ((self
              (case-lambda
                (() (list identity))
                ((x) (self identity x))
                ((x y) (list x y name))
                ((x y . z)
                 (append 
                  (self x y)
                  (apply append (map (lambda (x) (list x name)) z))))
                )))self))
  (let ((+ (op '+ 0))
        (- (op '- 0))
        (* (op '* 1))
        (/ (op '/ 1)))
    (apply(cadr (assoc(car x)`((+,+)(-,-)(*,*)(/,/))) )(cdr x))))
(define (p x) (if (pair? x) (o (cons (car x) (map p (cdr x)))) x))
(define (q x) (apply append (map (lambda (x) (case x
                                               ((+) '("[-<+>]<"))
                                               ((-) '("[-<->]<"))
                                               ((*) '("<[->" "[->+>+<<]" ">>[-<<+>>]<<" "<]" ">[-]" ">[-<<+>>]<<"))
                                               ((/) '("<[>" "[->+>+<<]" ">>[-<<+>>]<" "[-<<->>]>>+<<<" "<]" ">[-]" ">>>[-<<<<+>>>>]<<<<"))
                                               (else (list ">[-]" (make-string x #\+) ""))
                                               )) x)))
(define (flat x)(if (pair? x) (apply append (map flat x)) (list x)))
(define (compile x)(list (apply string-append (q (flat (p x)))) (eval x (make-base-namespace))))
(compile '(* 2 (/ 8 2 2) 3 (+ 1 2) 1))

运行得到

代码： 全选

>[-]++>[-]++++++++>[-]++<[>[->+>+<<]>>[-<<+>>]<[-<<->>]>>+<<<<]>[-]>>>[-<<<<+>>>>]<<<<>[-]++<[>[->+>+<<]>>[-<<+>>]<[-<<->>]>>+<<<<]>[-]>>>[-<<<<+>>>>]<<<<<[->[->+>+<<]>>[-<<+>>]<<<]>[-]>[-<<+>>]<<>[-]+++<[->[->+>+<<]>>[-<<+>>]<<<]>[-]>[-<<+>>]<<>[-]+>[-]++[-<+>]<<[->[->+>+<<]>>[-<<+>>]<<<]>[-]>[-<<+>>]<<>[-]+<[->[->+>+<<]>>[-<<+>>]<<<]>[-]>[-<<+>>]<<

执行

代码： 全选

http://www.iamcal.com/misc/bf_debug/

说明

代码： 全选

当前刚刚仅支持 +-*/ 的说，而且除法不整除时会执行错误（结果异常或者不停机）

TODO

代码： 全选

1.好想把 defun/funcall 给搞定...
2.把整数除法给实现对了...
3.把乘法中的那个减号移到循环结束的地方...

[liu滔]

从微博过来膜拜一下

[reverland]

从微薄过来仰望下

[枫叶饭团]

蛋碎.exe

[ee.zsy]

整数除法搞定了，虽然是取的上界，现在四则运算齐全了哈哈...

代码： 全选

#lang racket
(define (assert e m)(if (not e)(error m)#t))
(define (o x) 
  (define (op name identity)
    (letrec ((self
              (case-lambda
                (() (list identity))
                ((x) (self identity x))
                ((x y) (list x y name))
                ((x y . z)
                 (append 
                  (self x y)
                  (apply append (map (lambda (x) (list x name)) z))))
                )))self))
  (let ((+ (op '+ 0))
        (- (op '- 0))
        (* (op '* 1))
        (/ (op '/ 1)))
    (apply(cadr (or (assoc(car x)`((+,+)(-,-)(*,*)(/,/))) #f))(cdr x))))
(define (p x) (if (pair? x) (o (cons (car x) (map p (cdr x)))) x))
(define (str . xs)
  (apply string-append (map (lambda (x)(cond
                                         ((char? x) (make-string 1 x))
                                         (else x))) xs)))
(define (q x)
  (define inc #\+)
  (define dec #\-)
  (define rht #\>)
  (define lft #\<)
  (define next #\>)
  (define push #\>)
  (define pop #\<)
  (define (rep x n)
    (make-string (abs n) (if (>= n 0) x 
                             (cadr (assoc x '((#\< #\>)(#\> #\<)(#\+ #\-)(#\- #\+)))))))
  (define dup (string-append "[->+>+<<]" ">>[-<<+>>]<"))
  (define (cpy to) (str (tms (rep rht to) inc next inc pop (rep lft to)) (wth (+ 1 to) (mov (- 0 1 to)))))
  (define clr "[-]")
  (define (mov offset) (string-append "[-" (rep #\> offset) "+" (rep #\> (- offset)) "]"))
  (define (mov2 offset times) (string-append "[-" (rep #\> offset) (rep #\+ times) (rep #\> (- offset)) "]"))
  (define (wth offset . code) (string-append (rep #\> offset) (apply str code) (rep #\< offset)))
  (define (tms . code) (string-append "[" (apply str code) "-]"))
  (define (if-pos . code) (string-append "[" (apply str code) "[-]]"))
  (define (lop . code) (string-append "[" (apply str code) "]"))
  (apply append (map (lambda (x) (case x
                                   ((nop) '(""))
                                   ((dup) `(,(cpy 1) ">"))
                                   ((dup) '("[->+>+<<]" ">>[-<<+>>]<"))
                                   ((zro) '(">[-]"))
                                   ((clr) '("[-]"))
                                   ((+) `(,(mov -1) "<"))
                                   ((-) `(,(mov2 -1 -1) "<"))
                                   ((*) `("<" ,(tms (wth 1 dup "<")) ,(wth 1 clr) ,(wth 2 (mov -2))))
                                   ((/) `("<" ,(lop (wth 1 dup (tms (wth -2 (cpy 5) (wth 5 (if-pos (wth -5 "-"))))) "<") (wth 4 "+") )  ,(wth 1 clr) ,(wth 4 (mov -4))))
                                   ;((/) `("<" ,(lop (wth 1 dup (tms (wth -2 "-"))  "<") (wth 4 "+") )  ,(wth 1 clr) ,(wth 4 (mov -4))))
                                   (else (list ">[-]" (make-string x #\+) "#"))
                                   )) x)))
(define (flat x)(if (pair? x) (apply append (map flat x)) (list x)))
(define (compile x) (list (apply str (q (flat (p x)))) (eval x (make-base-namespace))))

(compile '(* 2 (/ 8 2 2) 3 (+ 1 2) 1))
(compile '(/ 3 2 1))

还有一个略复杂一些的例子 http://pastebin.com/ppzWXECh

[liu滔]

楼上好强

[jtshs256]

那个ee没来，来了这个ee

[liu滔]

这个ee很厉害的

[枫叶饭团]

又来膜拜锤子大大:)

[灰色小狼]

your left brain has nothing right
your right brain has nothing left