summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/Makefile.am6
-rw-r--r--module/language/brainfuck/compile-scheme.scm71
-rw-r--r--module/language/brainfuck/parse.scm55
-rw-r--r--module/language/brainfuck/spec.scm34
4 files changed, 166 insertions, 0 deletions
diff --git a/module/Makefile.am b/module/Makefile.am
index 2df0232fb..10ff5eaa1 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -41,6 +41,7 @@ SOURCES = \
$(SCHEME_LANG_SOURCES) \
$(TREE_IL_LANG_SOURCES) \
$(GHIL_LANG_SOURCES) $(GLIL_LANG_SOURCES) \
+ $(BRAINFUCK_LANG_SOURCES) \
$(ASSEMBLY_LANG_SOURCES) $(BYTECODE_LANG_SOURCES) \
$(OBJCODE_LANG_SOURCES) $(VALUE_LANG_SOURCES) \
\
@@ -112,6 +113,11 @@ ECMASCRIPT_LANG_SOURCES = \
language/ecmascript/compile-ghil.scm \
language/ecmascript/spec.scm
+BRAINFUCK_LANG_SOURCES = \
+ language/brainfuck/spec.scm \
+ language/brainfuck/parse.scm \
+ language/brainfuck/compile-scheme.scm
+
SCRIPTS_SOURCES = \
scripts/PROGRAM.scm \
scripts/autofrisk.scm \
diff --git a/module/language/brainfuck/compile-scheme.scm b/module/language/brainfuck/compile-scheme.scm
new file mode 100644
index 000000000..1b37076ff
--- /dev/null
+++ b/module/language/brainfuck/compile-scheme.scm
@@ -0,0 +1,71 @@
+;;; Brainfuck for GNU Guile
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (language brainfuck compile-scheme)
+ #:export (compile-scheme))
+
+(define tape-size 30000)
+
+(define (compile-scheme exp env opts)
+ (values
+ `(let ((pointer 0)
+ (tape (make-vector ,tape-size 0)))
+ ,@(if (not (eq? '<brainfuck> (car exp)))
+ (error "expected brainfuck program")
+ `(begin
+ ,@(compile-body (cdr exp))
+ (write-char #\newline))))
+ env
+ env))
+
+(define (compile-body instructions)
+ (let iterate ((cur instructions)
+ (result '()))
+ (if (null? cur)
+ (reverse result)
+ (let ((compiled (compile-instruction (car cur))))
+ (iterate (cdr cur) (cons compiled result))))))
+
+(define (compile-instruction ins)
+ (case (car ins)
+
+ ((<bf-move>)
+ (let ((dir (cadr ins)))
+ `(set! pointer (+ pointer ,dir))))
+
+ ((<bf-increment>)
+ (let ((inc (cadr ins)))
+ `(vector-set! tape pointer (+ (vector-ref tape pointer) ,inc))))
+
+ ((<bf-print>)
+ '(write-char (integer->char (vector-ref tape pointer))))
+
+ ((<bf-read>)
+ '(vector-set! tape pointer (char->integer (read-char))))
+
+ ((<bf-loop>)
+ `(let iter ()
+ (if (not (= (vector-ref tape pointer) 0))
+ (begin
+ ,@(compile-body (cdr ins))
+ (iter)))))
+
+ (else (error "unknown brainfuck instruction " (car ins)))))
diff --git a/module/language/brainfuck/parse.scm b/module/language/brainfuck/parse.scm
new file mode 100644
index 000000000..e272b61ac
--- /dev/null
+++ b/module/language/brainfuck/parse.scm
@@ -0,0 +1,55 @@
+;;; Brainfuck for GNU Guile.
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (language brainfuck parse)
+ #:export (read-brainfuck))
+
+(define (read-brainfuck p)
+ `(<brainfuck> ,@(read-body p)))
+
+(define (reverse-without-nops lst)
+ (let iterate ((cur lst)
+ (result '()))
+ (if (null? cur)
+ result
+ (let ((head (car cur))
+ (tail (cdr cur)))
+ (if (eq? (car head) '<bf-nop>)
+ (iterate tail result)
+ (iterate tail (cons head result)))))))
+
+(define (read-body p)
+ (let iterate ((parsed '()))
+ (let ((chr (read-char p)))
+ (if (or (eof-object? chr) (eq? #\] chr))
+ (reverse-without-nops parsed)
+ (iterate (cons (process-input-char chr p) parsed))))))
+
+(define (process-input-char chr p)
+ (case chr
+ ((#\>) '(<bf-move> 1))
+ ((#\<) '(<bf-move> -1))
+ ((#\+) '(<bf-increment> 1))
+ ((#\-) '(<bf-increment> -1))
+ ((#\.) '(<bf-print>))
+ ((#\,) '(<bf-read>))
+ ((#\[) `(<bf-loop> ,@(read-body p)))
+ (else '(<bf-nop>))))
diff --git a/module/language/brainfuck/spec.scm b/module/language/brainfuck/spec.scm
new file mode 100644
index 000000000..9df1df699
--- /dev/null
+++ b/module/language/brainfuck/spec.scm
@@ -0,0 +1,34 @@
+;;; Brainfuck for GNU Guile.
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (language brainfuck spec)
+ #:use-module (language brainfuck compile-scheme)
+ #:use-module (language brainfuck parse)
+ #:use-module (system base language)
+ #:export (brainfuck))
+
+(define-language brainfuck
+ #:title "Guile Brainfuck"
+ #:version "1.0"
+ #:reader (lambda () (read-brainfuck (current-input-port)))
+ #:compilers `((scheme . ,compile-scheme))
+ #:printer write
+ )