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

add brainfuck->tree-il compiler

Browse source 
* module/Makefile.am (BRAINFUCK_LANG_SOURCES): Compile at the end. Add
  compile-tree-il.scm.

* module/language/brainfuck/compile-tree-il.scm: New compiler, compiles
  to tree-il instead of scheme. I thought it would be more illustrative,
  though there are some uncommented bits.

* module/language/brainfuck/parse.scm: Modify not to put a header on the
  scheme representation. After all, we don't put <scheme> before scheme
  code, do we? :)

* module/language/brainfuck/spec.scm: Add tree-il compiler.

* module/language/tree-il.scm: Understand (set! (lexical foo) ...).

* module/system/base/language.scm: Update license. Actually, updates
  licenses on all these.
This commit is contained in:
Andy Wingo 2009-06-21 14:53:33 +02:00
parent fe2400b214
commit 5c27902e5e
6 changed files with 200 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

7
module/Makefile.am
View file

@ -41,7 +41,6 @@ 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) \
\
@ -51,6 +50,7 @@ SOURCES = \
$(OOP_SOURCES) \
$(SYSTEM_SOURCES) \
$(ECMASCRIPT_LANG_SOURCES) \
$(BRAINFUCK_LANG_SOURCES) \
$(SCRIPTS_SOURCES)
## test.scm is not currently installed.
@ -114,9 +114,10 @@ ECMASCRIPT_LANG_SOURCES = \
language/ecmascript/spec.scm
BRAINFUCK_LANG_SOURCES = \
language/brainfuck/spec.scm \
language/brainfuck/parse.scm \
language/brainfuck/compile-scheme.scm
language/brainfuck/compile-scheme.scm \
language/brainfuck/compile-tree-il.scm \
language/brainfuck/spec.scm
SCRIPTS_SOURCES = \
scripts/PROGRAM.scm \

153
module/language/brainfuck/compile-tree-il.scm Normal file
View file

@ -0,0 +1,153 @@
;;; Brainfuck for GNU Guile
;; Copyright (C) 2009 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 3 of the License, or (at your option) any later version.
;;
;; This library 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
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;; 02110-1301 USA
;;; Commentary:
;; Brainfuck is a simple language that mostly mimics the operations of a
;; Turing machine. This file implements a compiler from Brainfuck to
;; Guile's Tree-IL.
;;; Code:
(define-module (language brainfuck compile-tree-il)
#:use-module (system base pmatch)
#:use-module (language tree-il)
#:export (compile-tree-il))
;; Compilation of Brainfuck is pretty straight-forward. For all of
;; brainfuck's instructions, there are basic representations in Tree-IL
;; we only have to generate.
;;
;; Brainfuck's pointer and data-tape are stored in the variables pointer and
;; tape, where tape is a vector of integer values initially set to zero. Pointer
;; starts out at position 0.
;; Our tape is thus of finite length, with an address range of 0..n for
;; some defined upper bound n depending on the length of our tape.
;; Define the length to use for the tape.
(define tape-size 30000)
;; This compiles a whole brainfuck program. This constructs a Tree-IL
;; code equivalent to Scheme code like this:
;;
;; (let ((pointer 0)
;; (tape (make-vector tape-size 0)))
;; (begin
;; <body>
;; (write-char #\newline)))
;;
;; So first the pointer and tape variables are set up correctly, then the
;; program's body is executed in this context, and finally we output an
;; additional newline character in case the program does not output one.
;;
;; Note that we're generating the S-expression representation of
;; Tree-IL, then using parse-tree-il to turn it into the actual Tree-IL
;; data structures. This makes the compiler more pleasant to look at,
;; but we do lose is the ability to propagate source information. Since
;; Brainfuck is so obtuse anyway, this shouldn't matter ;-)
;;
;; TODO: Find out and explain the details about env, the three return values and
;; how to use the options. Implement options to set the tape-size, maybe.
(define (compile-tree-il exp env opts)
(values
(parse-tree-il
`(let (pointer tape) (pointer tape)
((const 0)
(apply (primitive make-vector) (const ,tape-size) (const 0)))
,(compile-body exp)))
env
env))
;; Compile a list of instructions to a Tree-IL expression.
(define (compile-body instructions)
(let lp ((in instructions) (out '()))
(define (emit x)
(lp (cdr in) (cons x out)))
(cond
((null? in)
;; No more input, build our output.
(cond
((null? out) '(void)) ; no output
((null? (cdr out)) (car out)) ; single expression
(else `(begin ,@(reverse out)))) ; sequence
)
(else
(pmatch (car in)
;; Pointer moves >< are done simply by something like:
;; (set! pointer (+ pointer +-1))
((<bf-move> ,dir)
(emit `(set! (lexical pointer)
(apply (primitive +) (lexical pointer) (const ,dir)))))
;; Cell increment +- is done as:
;; (vector-set! tape pointer (+ (vector-ref tape pointer) +-1))
((<bf-increment> ,inc)
(emit `(apply (primitive vector-set!) (lexical tape) (lexical pointer)
(apply (primitive +)
(apply (primitive vector-ref)
(lexical tape) (lexical pointer))
(const ,inc)))))
;; Output . is done by converting the cell's integer value to a
;; character first and then printing out this character:
;; (write-char (integer->char (vector-ref tape pointer)))
((<bf-print>)
(emit `(apply (primitive write-char)
(apply (primitive integer->char)
(apply (primitive vector-ref)
(lexical tape) (lexical pointer))))))
;; Input , is done similarly, read in a character, get its ASCII
;; code and store it into the current cell:
;; (vector-set! tape pointer (char->integer (read-char)))
((<bf-read>)
(emit `(apply (primitive vector-set!)
(lexical tape) (lexical pointer)
(apply (primitive char->integer)
(apply (primitive read-char))))))
;; For loops [...] we use a letrec construction to execute the body until
;; the current cell gets zero. The body is compiled via a recursive call
;; back to (compile-body).
;; (let iterate ()
;; (if (not (= (vector-ref! tape pointer) 0))
;; (begin
;; <body>
;; (iterate))))
((<bf-loop> . ,body)
(let ((iterate (gensym)))
(emit `(letrec (iterate) (,iterate)
((lambda () ()
(if (apply (primitive =)
(apply (primitive vector-ref)
(lexical tape) (lexical pointer))
(const 0))
(void)
(begin ,(compile-body body)
(apply (lexical ,iterate))))))
(apply (lexical ,iterate))))))
(else (error "unknown brainfuck instruction" (car in))))))))

35
module/language/brainfuck/parse.scm
View file

@ -2,20 +2,20 @@
;; 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 library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 3 of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; This library 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.
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser 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.
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;; 02110-1301 USA
;;; Code:
@ -35,13 +35,6 @@
; object.
; Read a brainfuck program from an input port. We construct the <brainfuck>
; program and read in the instructions using (read-body).
(define (read-brainfuck p)
`(<brainfuck> ,@(read-body p)))
; While reading a number of instructions in sequence, all of them are cons'ed
; onto a list of instructions; thus this list gets out in reverse order.
; Additionally, for "comment characters" (everything not an instruction) we
@ -70,7 +63,7 @@
; For instance, the basic program so just echo one character would be:
; ,.]
(define (read-body p)
(define (read-brainfuck p)
(let iterate ((parsed '()))
(let ((chr (read-char p)))
(if (or (eof-object? chr) (eq? #\] chr))
@ -80,7 +73,7 @@
; This routine processes a single character of input and builds the
; corresponding instruction. Loop bodies are read by recursively calling
; back (read-body).
; back (read-brainfuck).
;
; For the poiner movement commands >< and the cell increment/decrement +-
; commands, we only use one instruction form each and specify the direction of
@ -94,5 +87,5 @@
((#\-) '(<bf-increment> -1))
((#\.) '(<bf-print>))
((#\,) '(<bf-read>))
((#\[) `(<bf-loop> ,@(read-body p)))
((#\[) `(<bf-loop> ,@(read-brainfuck p)))
(else '(<bf-nop>))))

26
module/language/brainfuck/spec.scm
View file

@ -2,24 +2,25 @@
;; 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 library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 3 of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; This library 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.
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser 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.
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;; 02110-1301 USA
;;; Code:
(define-module (language brainfuck spec)
#:use-module (language brainfuck compile-tree-il)
#:use-module (language brainfuck compile-scheme)
#:use-module (language brainfuck parse)
#:use-module (system base language)
@ -37,6 +38,7 @@
#:title "Guile Brainfuck"
#:version "1.0"
#:reader (lambda () (read-brainfuck (current-input-port)))
#:compilers `((scheme . ,compile-scheme))
#:compilers `((tree-il . ,compile-tree-il)
(scheme . ,compile-scheme))
#:printer write
)

3
module/language/tree-il.scm
View file

@ -94,6 +94,9 @@
((lexical ,name ,sym) (guard (symbol? name) (symbol? sym))
(make-lexical-ref loc name sym))
((set! (lexical ,name) ,exp) (guard (symbol? name))
(make-lexical-set loc name name (retrans exp)))
((set! (lexical ,name ,sym) ,exp) (guard (symbol? name) (symbol? sym))
(make-lexical-set loc name sym (retrans exp)))

24
module/system/base/language.scm
View file

@ -1,21 +1,21 @@
;;; Multi-language support
;; Copyright (C) 2001 Free Software Foundation, Inc.
;; Copyright (C) 2001, 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 library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 3 of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; This library 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.
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser 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.
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;; 02110-1301 USA
;;; Code: