mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 14:21:10 +02:00
Code Activity

basic brainfuck -> scheme example compiler.

Browse source 
* module/Makefile.am: Install the brainfuck compiler modules.
* module/language/brainfuck/spec.scm: New file.
* module/language/brainfuck/parse.scm: New file.
* module/language/brainfuck/compile-scheme.scm: New file.
This commit is contained in:
Daniel Kraft 2009-05-23 09:58:54 +02:00 • committed by Andy Wingo
parent cf6d8d344c
commit 6370a6ad25
4 changed files with 166 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

6
module/Makefile.am
View file

@ -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 \

71
module/language/brainfuck/compile-scheme.scm Normal file
View file

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

55
module/language/brainfuck/parse.scm Normal file
View file

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

34
module/language/brainfuck/spec.scm Normal file
View file

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