| 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)))))))) |