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