mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +02:00
Code Activity

formatting changes to (language brainfuck compile-scheme)

Browse source 
* module/language/brainfuck/compile-scheme.scm: Standalone comments
  should have more than one semicolon, and update copyright to LGPLv3+.
This commit is contained in:
Andy Wingo 2009-06-21 13:36:39 +02:00
parent 4e432dab1f
commit fe2400b214
1 changed files with 57 additions and 58 deletions
Download patch file Download diff file Expand all files Collapse all files

115
module/language/brainfuck/compile-scheme.scm
View file

@ -2,55 +2,54 @@
;; Copyright (C) 2009 Free Software Foundation, Inc. ;; Copyright (C) 2009 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or modify ;; This library is free software; you can redistribute it and/or
;; it under the terms of the GNU General Public License as published by ;; modify it under the terms of the GNU Lesser General Public
;; the Free Software Foundation; either version 2, or (at your option) ;; License as published by the Free Software Foundation; either
;; any later version. ;; 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 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; GNU General Public License for more details. ;; Lesser General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU Lesser General Public
;; along with this program; see the file COPYING. If not, write to ;; License along with this library; if not, write to the Free Software
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;; Boston, MA 02111-1307, USA.
;;; Code: ;;; Code:
(define-module (language brainfuck compile-scheme) (define-module (language brainfuck compile-scheme)
#:export (compile-scheme)) #:export (compile-scheme))
; Compilation of Brainfuck to Scheme is pretty straight-forward. For all of ;; Compilation of Brainfuck to Scheme is pretty straight-forward. For all of
; brainfuck's instructions, there are basic representations in Scheme we ;; brainfuck's instructions, there are basic representations in Scheme we
; only have to generate. ;; only have to generate.
; ;;
; Brainfuck's pointer and data-tape are stored in the variables pointer and ;; 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 ;; tape, where tape is a vector of integer values initially set to zero. Pointer
; starts out at position 0. ;; starts out at position 0.
; Our tape is thus of finite length, with an address range of 0..n for ;; 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. ;; some defined upper bound n depending on the length of our tape.
; Define the length to use for the tape. ;; Define the length to use for the tape.
(define tape-size 30000) (define tape-size 30000)
; This compiles a whole brainfuck program. This constructs a Scheme code like: ;; This compiles a whole brainfuck program. This constructs a Scheme code like:
; (let ((pointer 0) ;; (let ((pointer 0)
; (tape (make-vector tape-size 0))) ;; (tape (make-vector tape-size 0)))
; (begin ;; (begin
; <body> ;; <body>
; (write-char #\newline))) ;; (write-char #\newline)))
; ;;
; So first the pointer and tape variables are set up correctly, then the ;; 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 ;; program's body is executed in this context, and finally we output an
; additional newline character in case the program does not output one. ;; additional newline character in case the program does not output one.
; ;;
; TODO: Find out and explain the details about env, the three return values and ;; 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. ;; how to use the options. Implement options to set the tape-size, maybe.
(define (compile-scheme exp env opts) (define (compile-scheme exp env opts)
(values (values
@ -65,10 +64,10 @@
env)) env))
; Compile a list of instructions to get a list of Scheme codes. As we always ;; Compile a list of instructions to get a list of Scheme codes. As we always
; strip off the car of the instructions-list and cons the result onto the ;; strip off the car of the instructions-list and cons the result onto the
; result-list, it will get out in reversed order first; so we have to (reverse) ;; result-list, it will get out in reversed order first; so we have to (reverse)
; it on return. ;; it on return.
(define (compile-body instructions) (define (compile-body instructions)
(let iterate ((cur instructions) (let iterate ((cur instructions)
@ -79,44 +78,44 @@
(iterate (cdr cur) (cons compiled result)))))) (iterate (cdr cur) (cons compiled result))))))
; Compile a single instruction to Scheme, using the direct representations ;; Compile a single instruction to Scheme, using the direct representations
; all of Brainfuck's instructions have. ;; all of Brainfuck's instructions have.
(define (compile-instruction ins) (define (compile-instruction ins)
(case (car ins) (case (car ins)
; Pointer moval >< is done simply by something like: ;; Pointer moval >< is done simply by something like:
; (set! pointer (+ pointer +-1)) ;; (set! pointer (+ pointer +-1))
((<bf-move>) ((<bf-move>)
(let ((dir (cadr ins))) (let ((dir (cadr ins)))
`(set! pointer (+ pointer ,dir)))) `(set! pointer (+ pointer ,dir))))
; Cell increment +- is done as: ;; Cell increment +- is done as:
; (vector-set! tape pointer (+ (vector-ref tape pointer) +-1)) ;; (vector-set! tape pointer (+ (vector-ref tape pointer) +-1))
((<bf-increment>) ((<bf-increment>)
(let ((inc (cadr ins))) (let ((inc (cadr ins)))
`(vector-set! tape pointer (+ (vector-ref tape pointer) ,inc)))) `(vector-set! tape pointer (+ (vector-ref tape pointer) ,inc))))
; Output . is done by converting the cell's integer value to a character ;; Output . is done by converting the cell's integer value to a character
; first and then printing out this character: ;; first and then printing out this character:
; (write-char (integer->char (vector-ref tape pointer))) ;; (write-char (integer->char (vector-ref tape pointer)))
((<bf-print>) ((<bf-print>)
'(write-char (integer->char (vector-ref tape pointer)))) '(write-char (integer->char (vector-ref tape pointer))))
; Input , is done similarly, read in a character, get its ASCII code and ;; Input , is done similarly, read in a character, get its ASCII code and
; store it into the current cell: ;; store it into the current cell:
; (vector-set! tape pointer (char->integer (read-char))) ;; (vector-set! tape pointer (char->integer (read-char)))
((<bf-read>) ((<bf-read>)
'(vector-set! tape pointer (char->integer (read-char)))) '(vector-set! tape pointer (char->integer (read-char))))
; For loops [...] we use a named let construction to execute the body until ;; For loops [...] we use a named let construction to execute the body until
; the current cell gets zero. The body is compiled via a recursive call ;; the current cell gets zero. The body is compiled via a recursive call
; back to (compile-body). ;; back to (compile-body).
; (let iterate () ;; (let iterate ()
; (if (not (= (vector-ref! tape pointer) 0)) ;; (if (not (= (vector-ref! tape pointer) 0))
; (begin ;; (begin
; <body> ;; <body>
; (iterate)))) ;; (iterate))))
((<bf-loop>) ((<bf-loop>)
`(let iterate () `(let iterate ()
(if (not (= (vector-ref tape pointer) 0)) (if (not (= (vector-ref tape pointer) 0))