diff options
-rw-r--r-- | module/Makefile.am | 6 | ||||
-rw-r--r-- | module/language/brainfuck/compile-scheme.scm | 71 | ||||
-rw-r--r-- | module/language/brainfuck/parse.scm | 55 | ||||
-rw-r--r-- | module/language/brainfuck/spec.scm | 34 |
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 + ) |