1 ;;; Brainfuck for GNU Guile
3 ;; Copyright (C) 2009, 2011 Free Software Foundation, Inc.
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.
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.
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
22 ;; Brainfuck is a simple language that mostly mimics the operations of a
23 ;; Turing machine. This file implements a compiler from Brainfuck to
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))
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.
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.
44 ;; Define the length to use for the tape.
46 (define tape-size 30000)
49 ;; This compiles a whole brainfuck program. This constructs a Tree-IL
50 ;; code equivalent to Scheme code like this:
53 ;; (tape (make-vector tape-size 0)))
56 ;; (write-char #\newline)))
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.
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.
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
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 ;-)
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.
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
90 ;; FIXME: perhaps use options or the env to set the tape-size?
92 (define (compile-tree-il exp env opts)
95 `(let (pointer tape) (pointer tape)
97 (call (primitive make-vector) (const ,tape-size) (const 0)))
103 ;; Compile a list of instructions to a Tree-IL expression.
105 (define (compile-body instructions)
106 (let lp ((in instructions) (out '()))
108 (lp (cdr in) (cons x out)))
111 ;; No more input, build our output.
113 ((null? out) '(void)) ; no output
114 ((null? (cdr out)) (car out)) ; single expression
115 (else `(begin ,@(reverse out)))) ; sequence
120 ;; Pointer moves >< are done simply by something like:
121 ;; (set! pointer (+ pointer +-1))
123 (emit `(set! (lexical pointer)
124 (call (primitive +) (lexical pointer) (const ,dir)))))
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)
131 (call (primitive vector-ref)
132 (lexical tape) (lexical pointer))
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)))
139 (emit `(call (primitive write-char)
140 (call (primitive integer->char)
141 (call (primitive vector-ref)
142 (lexical tape) (lexical pointer))))))
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)))
148 (emit `(call (primitive vector-set!)
149 (lexical tape) (lexical pointer)
150 (call (primitive char->integer)
151 (call (primitive read-char))))))
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).
157 ;; (if (not (= (vector-ref! tape pointer) 0))
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.
169 (let ((iterate (gensym)))
170 (emit `(letrec (iterate) (,iterate)
174 (if (call (primitive =)
175 (call (primitive vector-ref)
176 (lexical tape) (lexical pointer))
179 (begin ,(compile-body body)
180 (call (lexical ,iterate)))))
182 (call (lexical ,iterate))))))
184 (else (error "unknown brainfuck instruction" (car in))))))))