DouKaku?beta

Comment detail

BFコンパイラー (Nested Flatten)

無理矢理ですけど健全なマクロで解いてみました。

なお、出力されたコードもbf.scmを参照するのでロードパスを適切に設定しておく必要があります。

;;; bf-test.scm (サンプル)

(use bf)

(bf-compiler "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+." 32)

;;; gosh bf-test.scm | gosh で"Hello, world!"が出力されます

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
;;; bf.scm
(define-module bf
  (export-all))

(define-syntax %bf-compiler
  (syntax-rules (< > + - |.| |,|)
    ((_ proc)
     proc)
    ((_ proc < rest ...)
     (%bf-compiler (compose (lambda (tape)
                              (cons (cons (cadr tape) (car tape))
                                    (cddr tape)))
                            proc)
                   rest ...))
    ((_ proc > rest ...)
     (%bf-compiler (compose (lambda (tape)
                              (cons (cdar tape)
                                    (cons (caar tape) (cdr tape))))
                            proc)
                   rest ...))
    ((_ proc + rest ...)
     (%bf-compiler (compose (lambda (tape)
                              (cons (car tape) (cons (modulo (+ (cadr tape) 1) 256)
                                                     (cddr tape))))
                            proc)
                   rest ...))
    ((_ proc - rest ...)
     (%bf-compiler (compose (lambda (tape)
                              (cons (car tape) (cons (modulo (- (cadr tape) 1) 256)
                                                     (cddr tape))))
                            proc)
                   rest ...))
    ((_ proc |.| rest ...)
     (%bf-compiler (compose (lambda (tape)
                              (write-byte (cadr tape))
                              (flush)
                              tape)
                            proc)
                   rest ...))     
    ((_ proc |,| rest ...)
     (%bf-compiler (compose (lambda (tape)
                              (let1 c (read-byte)
                              (cons (car tape)
                                    (cons (if (eof-object? c) 0 c) (cddr tape)))))
                            proc)
                   rest ...))                   
    ((_ proc [body ...] rest ...)
     (%bf-compiler (compose (lambda (tape)
                              (if (eq? (cadr tape) 0)
                                  tape
                                  (let1 f (%bf-compiler values body ...)
                                    (let loop ((t (f tape)))
                                      (if (eq? (cadr t) 0)
                                          t
                                          (loop (f t)))))))
                            proc)
                   rest ...))))

(define (bf-compiler str n)
  (write '(use bf))
  (write `((%bf-compiler values ,@(with-input-from-string
                              (regexp-replace-all #/[.,+-<>]/ #`"(,str)" "|\\0|")
                            read))
           ',(tape n))))
                              
(define (tape n)
  (let1 t (make-list n 0)
    (cons t t)))

(provide "bf")

あっ、tapeの実装がちょっと変だった。前のやつだと<でポインタが戻りすぎたときに変な挙動になります(修正版ではエラーになるはず)。

まあ、変なプログラムを書かなければさっきのでも問題ないはずです。

1
2
3
(define (tape n)
  (let1 t (make-list n 0)
    (cons '() t)))

ぐぁ、ポインタの進む向き逆にしてた。コードをあげなおします。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
;;; bf.scm
(define-module bf
  (export-all))

(define-syntax %bf-compiler
  (syntax-rules (< > + - |.| |,|)
    ((_ proc)
     proc)
    ((_ proc > rest ...)
     (%bf-compiler (compose (lambda (tape)
                              (cons (cons (cadr tape) (car tape))
                                    (cddr tape)))
                            proc)
                   rest ...))
    ((_ proc < rest ...)
     (%bf-compiler (compose (lambda (tape)
                              (cons (cdar tape)
                                    (cons (caar tape) (cdr tape))))
                            proc)
                   rest ...))
    ((_ proc + rest ...)
     (%bf-compiler (compose (lambda (tape)
                              (cons (car tape) (cons (modulo (+ (cadr tape) 1) 256)
                                                     (cddr tape))))
                            proc)
                   rest ...))
    ((_ proc - rest ...)
     (%bf-compiler (compose (lambda (tape)
                              (cons (car tape) (cons (modulo (- (cadr tape) 1) 256)
                                                     (cddr tape))))
                            proc)
                   rest ...))
    ((_ proc |.| rest ...)
     (%bf-compiler (compose (lambda (tape)
                              (write-byte (cadr tape))
                              (flush)
                              tape)
                            proc)
                   rest ...))     
    ((_ proc |,| rest ...)
     (%bf-compiler (compose (lambda (tape)
                              (let1 c (read-byte)
                              (cons (car tape)
                                    (cons (if (eof-object? c) 0 c) (cddr tape)))))
                            proc)
                   rest ...))                   
    ((_ proc [body ...] rest ...)
     (%bf-compiler (compose (lambda (tape)
                              (if (eq? (cadr tape) 0)
                                  tape
                                  (let1 f (%bf-compiler values body ...)
                                    (let loop ((t (f tape)))
                                      (if (eq? (cadr t) 0)
                                          t
                                          (loop (f t)))))))
                            proc)
                   rest ...))))

(define (bf-compiler str n)
  (write '(use bf))
  (write `((%bf-compiler values ,@(with-input-from-string
                              (regexp-replace-all #/[.,+-<>]/ #`"(,str)" "|\\0|")
                            read))
           ',(tape n))))
                              
(define (tape n)
  (let1 t (make-list n 0)
    (cons '() t)))

(provide "bf")

Index

Feed

Other

Link

Pathtraq

loading...
Creative Commons License このサイトの内容は、 クリエイティブ・コモンズ・ライセンスの下でライセンスされています。 [詳細]