Commit | Line | Data |
---|---|---|
6370a6ad DK |
1 | ;;; Brainfuck for GNU Guile. |
2 | ||
7f710308 | 3 | ;; Copyright (C) 2009, 2013 Free Software Foundation, Inc. |
6370a6ad | 4 | |
5c27902e AW |
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. | |
6370a6ad | 9 | ;; |
5c27902e | 10 | ;; This library is distributed in the hope that it will be useful, |
6370a6ad | 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
5c27902e AW |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
13 | ;; Lesser General Public License for more details. | |
6370a6ad | 14 | ;; |
5c27902e AW |
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 | |
6370a6ad DK |
19 | |
20 | ;;; Code: | |
21 | ||
22 | (define-module (language brainfuck parse) | |
23 | #:export (read-brainfuck)) | |
24 | ||
e63d888e DK |
25 | ; Purpose of the parse module is to read in brainfuck in text form and produce |
26 | ; the corresponding tree representing the brainfuck code. | |
27 | ; | |
28 | ; Each object (representing basically a single instruction) is structured like: | |
29 | ; (<instruction> [arguments]) | |
30 | ; where <instruction> is a symbolic name representing the type of instruction | |
31 | ; and the optional arguments represent further data (for instance, the body of | |
32 | ; a [...] loop as a number of nested instructions). | |
e63d888e DK |
33 | |
34 | ||
e63d888e DK |
35 | ; While reading a number of instructions in sequence, all of them are cons'ed |
36 | ; onto a list of instructions; thus this list gets out in reverse order. | |
37 | ; Additionally, for "comment characters" (everything not an instruction) we | |
38 | ; generate <bf-nop> NOP instructions. | |
39 | ; | |
40 | ; This routine reverses a list of instructions and removes all <bf-nop>'s on the | |
41 | ; way to fix these two issues for a read-in list. | |
42 | ||
6370a6ad DK |
43 | (define (reverse-without-nops lst) |
44 | (let iterate ((cur lst) | |
45 | (result '())) | |
46 | (if (null? cur) | |
47 | result | |
48 | (let ((head (car cur)) | |
49 | (tail (cdr cur))) | |
50 | (if (eq? (car head) '<bf-nop>) | |
51 | (iterate tail result) | |
52 | (iterate tail (cons head result))))))) | |
53 | ||
e63d888e DK |
54 | |
55 | ; Read in a set of instructions until a terminating ] character is found (or | |
56 | ; end of file is reached). This is used both for loop bodies and whole | |
57 | ; programs, so that a program has to be either terminated by EOF or an | |
58 | ; additional ], too. | |
59 | ; | |
60 | ; For instance, the basic program so just echo one character would be: | |
61 | ; ,.] | |
62 | ||
5c27902e | 63 | (define (read-brainfuck p) |
6370a6ad DK |
64 | (let iterate ((parsed '())) |
65 | (let ((chr (read-char p))) | |
8753fd53 AW |
66 | (cond |
67 | ((eof-object? chr) | |
68 | (let ((parsed (reverse-without-nops parsed))) | |
69 | (if (null? parsed) | |
70 | chr ;; pass on the EOF object | |
71 | parsed))) | |
72 | ((eqv? chr #\]) | |
73 | (reverse-without-nops parsed)) | |
74 | (else | |
75 | (iterate (cons (process-input-char chr p) parsed))))))) | |
6370a6ad | 76 | |
e63d888e DK |
77 | |
78 | ; This routine processes a single character of input and builds the | |
79 | ; corresponding instruction. Loop bodies are read by recursively calling | |
5c27902e | 80 | ; back (read-brainfuck). |
e63d888e DK |
81 | ; |
82 | ; For the poiner movement commands >< and the cell increment/decrement +- | |
83 | ; commands, we only use one instruction form each and specify the direction of | |
84 | ; the pointer/value increment using an argument to the instruction form. | |
85 | ||
6370a6ad DK |
86 | (define (process-input-char chr p) |
87 | (case chr | |
88 | ((#\>) '(<bf-move> 1)) | |
89 | ((#\<) '(<bf-move> -1)) | |
90 | ((#\+) '(<bf-increment> 1)) | |
91 | ((#\-) '(<bf-increment> -1)) | |
92 | ((#\.) '(<bf-print>)) | |
93 | ((#\,) '(<bf-read>)) | |
5c27902e | 94 | ((#\[) `(<bf-loop> ,@(read-brainfuck p))) |
6370a6ad | 95 | (else '(<bf-nop>)))) |