1;;; Brainfuck for GNU Guile
2
3;; Copyright (C) 2009, 2011 Free Software Foundation, Inc.
4
5;; This library is free software; you can redistribute it and/or
6;; modify it under the terms of the GNU Lesser General Public
7;; License as published by the Free Software Foundation; either
8;; version 3 of the License, or (at your option) any later version.
9;;
10;; This library is distributed in the hope that it will be useful,
11;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13;; Lesser General Public License for more details.
14;;
15;; You should have received a copy of the GNU Lesser General Public
16;; License along with this library; if not, write to the Free Software
17;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
18;; 02110-1301 USA
19
20;;; Commentary:
21
22;; Brainfuck is a simple language that mostly mimics the operations of a
23;; Turing machine. This file implements a compiler from Brainfuck to
24;; Guile's Tree-IL.
25
26;;; Code:
27
28(define-module (language brainfuck compile-tree-il)
29  #:use-module (system base pmatch)
30  #:use-module (language tree-il)
31  #:export (compile-tree-il))
32
33;; Compilation of Brainfuck is pretty straight-forward. For all of
34;; brainfuck's instructions, there are basic representations in Tree-IL
35;; we only have to generate.
36;;
37;; Brainfuck's pointer and data-tape are stored in the variables pointer and
38;; tape, where tape is a vector of integer values initially set to zero.  Pointer
39;; starts out at position 0.
40;; Our tape is thus of finite length, with an address range of 0..n for
41;; some defined upper bound n depending on the length of our tape.
42
43
44;; Define the length to use for the tape.
45
46(define tape-size 30000)
47
48
49;; This compiles a whole brainfuck program. This constructs a Tree-IL
50;; code equivalent to Scheme code like this:
51;;
52;;    (let ((pointer 0)
53;;          (tape (make-vector tape-size 0)))
54;;      (begin
55;;       <body>
56;;       (write-char #\newline)))
57;;
58;; So first the pointer and tape variables are set up correctly, then the
59;; program's body is executed in this context, and finally we output an
60;; additional newline character in case the program does not output one.
61;;
62;; The fact that we are compiling to Guile primitives gives this
63;; implementation a number of interesting characteristics. First, the
64;; values of the tape cells do not underflow or overflow. We could make
65;; them do otherwise via compiling calls to "modulo" at certain points.
66;;
67;; In addition, tape overruns or underruns will be detected, and will
68;; throw an error, whereas a number of Brainfuck compilers do not detect
69;; this.
70;;
71;; Note that we're generating the S-expression representation of
72;; Tree-IL, then using parse-tree-il to turn it into the actual Tree-IL
73;; data structures. This makes the compiler more pleasant to look at,
74;; but we do lose is the ability to propagate source information. Since
75;; Brainfuck is so obtuse anyway, this shouldn't matter ;-)
76;;
77;; `compile-tree-il' takes as its input the read expression, the
78;; environment, and some compile options. It returns the compiled
79;; expression, the environment appropriate for the next pass of the
80;; compiler -- in our case, just the environment unchanged -- and the
81;; continuation environment.
82;;
83;; The normal use of a continuation environment is if compiling one
84;; expression changes the environment, and that changed environment
85;; should be passed to the next compiled expression -- for example,
86;; changing the current module. But Brainfuck is incapable of that, so
87;; for us, the continuation environment is just the same environment we
88;; got in.
89;;
90;; FIXME: perhaps use options or the env to set the tape-size?
91
92(define (compile-tree-il exp env opts)
93  (values
94   (parse-tree-il
95    `(let (pointer tape) (pointer tape)
96          ((const 0)
97           (call (primitive make-vector) (const ,tape-size) (const 0)))
98          ,(compile-body exp)))
99   env
100   env))
101
102
103;; Compile a list of instructions to a Tree-IL expression.
104
105(define (compile-body instructions)
106  (let lp ((in instructions) (out '()))
107    (define (emit x)
108      (lp (cdr in) (cons x out)))
109    (cond
110     ((null? in)
111      ;; No more input, build our output.
112      (cond
113       ((null? out) '(void))             ; no output
114       ((null? (cdr out)) (car out))     ; single expression
115       (else `(begin ,@(reverse out))))  ; sequence
116      )
117     (else
118      (pmatch (car in)
119
120        ;; Pointer moves >< are done simply by something like:
121        ;;   (set! pointer (+ pointer +-1))
122        ((<bf-move> ,dir)
123         (emit `(set! (lexical pointer)
124                      (call (primitive +) (lexical pointer) (const ,dir)))))
125
126        ;; Cell increment +- is done as:
127        ;;   (vector-set! tape pointer (+ (vector-ref tape pointer) +-1))
128        ((<bf-increment> ,inc)
129         (emit `(call (primitive vector-set!) (lexical tape) (lexical pointer)
130                      (call (primitive +)
131                            (call (primitive vector-ref)
132                                  (lexical tape) (lexical pointer))
133                            (const ,inc)))))
134
135        ;; Output . is done by converting the cell's integer value to a
136        ;; character first and then printing out this character:
137        ;;   (write-char (integer->char (vector-ref tape pointer)))
138        ((<bf-print>)
139         (emit `(call (primitive write-char)
140                      (call (primitive integer->char)
141                            (call (primitive vector-ref)
142                                  (lexical tape) (lexical pointer))))))
143
144        ;; Input , is done similarly, read in a character, get its ASCII
145        ;; code and store it into the current cell:
146        ;;   (vector-set! tape pointer (char->integer (read-char)))
147        ((<bf-read>)
148         (emit `(call (primitive vector-set!)
149                      (lexical tape) (lexical pointer)
150                      (call (primitive char->integer)
151                            (call (primitive read-char))))))
152
153        ;; For loops [...] we use a letrec construction to execute the body until
154        ;; the current cell gets zero.  The body is compiled via a recursive call
155        ;; back to (compile-body).
156        ;;   (let iterate ()
157        ;;     (if (not (= (vector-ref! tape pointer) 0))
158        ;;         (begin
159        ;;          <body>
160        ;;          (iterate))))
161        ;;
162        ;; Indeed, letrec is the only way we have to loop in Tree-IL.
163        ;; Note that this does not mean that the closure must actually
164        ;; be created; later passes can compile tail-recursive letrec
165        ;; calls into inline code with gotos. Admittedly, that part of
166        ;; the compiler is not yet in place, but it will be, and in the
167        ;; meantime the code is still reasonably efficient.
168        ((<bf-loop> . ,body)
169         (let ((iterate (gensym)))
170           (emit `(letrec (iterate) (,iterate)
171                          ((lambda ()
172                             (lambda-case
173                              ((() #f #f #f () ())
174                               (if (call (primitive =)
175                                         (call (primitive vector-ref)
176                                               (lexical tape) (lexical pointer))
177                                         (const 0))
178                                   (void)
179                                   (begin ,(compile-body body)
180                                          (call (lexical ,iterate)))))
181                              #f)))
182                          (call (lexical ,iterate))))))
183
184        (else (error "unknown brainfuck instruction" (car in))))))))
185