[bpt/guile.git] / module / language / brainfuck / compile-tree-il.scm

;;; 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.
;;
;; The fact that we are compiling to Guile primitives gives this
;; implementation a number of interesting characteristics. First, the
;; values of the tape cells do not underflow or overflow. We could make
;; them do otherwise via compiling calls to "modulo" at certain points.
;;
;; In addition, tape overruns or underruns will be detected, and will
;; throw an error, whereas a number of Brainfuck compilers do not detect
;; this.
;;
;; 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 ;-)
;;
;; `compile-tree-il' takes as its input the read expression, the
;; environment, and some compile options. It returns the compiled
;; expression, the environment appropriate for the next pass of the
;; compiler -- in our case, just the environment unchanged -- and the
;; continuation environment.
;;
;; The normal use of a continuation environment is if compiling one
;; expression changes the environment, and that changed environment
;; should be passed to the next compiled expression -- for example,
;; changing the current module. But Brainfuck is incapable of that, so
;; for us, the continuation environment is just the same environment we
;; got in.
;;
;; FIXME: perhaps use options or the env to set the tape-size?

(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))))
        ;;
        ;; Indeed, letrec is the only way we have to loop in Tree-IL.
        ;; Note that this does not mean that the closure must actually
        ;; be created; later passes can compile tail-recursive letrec
        ;; calls into inline code with gotos. Admittedly, that part of
        ;; the compiler is not yet in place, but it will be, and in the
        ;; meantime the code is still reasonably efficient.
        ((<bf-loop> . ,body)
         (let ((iterate (gensym)))
           (emit `(letrec (iterate) (,iterate)
                          ((lambda ()
                             (lambda-case
                              ((() #f #f #f () #f)
                               (if (apply (primitive =)
                                          (apply (primitive vector-ref)
                                                 (lexical tape) (lexical pointer))
                                          (const 0))
                                   (void)
                                   (begin ,(compile-body body)
                                          (apply (lexical ,iterate)))))
                              #f)))
                     (apply (lexical ,iterate))))))

        (else (error "unknown brainfuck instruction" (car in))))))))
Commit	Line	Data
5c27902e AW	1	;;; Brainfuck for GNU Guile
	2
	3	;; Copyright (C) 2009 Free Software Foundation, Inc.
	4
	5	;; This library is free software; you can redistribute it and/or
	6	;; modify it under the terms of the GNU Lesser General Public
	7	;; License as published by the Free Software Foundation; either
	8	;; version 3 of the License, or (at your option) any later version.
	9	;;
	10	;; This library is distributed in the hope that it will be useful,
	11	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	12	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	13	;; Lesser General Public License for more details.
	14	;;
	15	;; You should have received a copy of the GNU Lesser General Public
	16	;; License along with this library; if not, write to the Free Software
	17	;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
	18	;; 02110-1301 USA
	19
	20	;;; Commentary:
	21
	22	;; Brainfuck is a simple language that mostly mimics the operations of a
	23	;; Turing machine. This file implements a compiler from Brainfuck to
	24	;; Guile's Tree-IL.
	25
	26	;;; Code:
	27
	28	(define-module (language brainfuck compile-tree-il)
	29	#:use-module (system base pmatch)
	30	#:use-module (language tree-il)
	31	#:export (compile-tree-il))
	32
	33	;; Compilation of Brainfuck is pretty straight-forward. For all of
	34	;; brainfuck's instructions, there are basic representations in Tree-IL
	35	;; we only have to generate.
	36	;;
	37	;; Brainfuck's pointer and data-tape are stored in the variables pointer and
	38	;; tape, where tape is a vector of integer values initially set to zero. Pointer
	39	;; starts out at position 0.
	40	;; Our tape is thus of finite length, with an address range of 0..n for
	41	;; some defined upper bound n depending on the length of our tape.
	42
	43
	44	;; Define the length to use for the tape.
	45
	46	(define tape-size 30000)
	47
	48
	49	;; This compiles a whole brainfuck program. This constructs a Tree-IL
	50	;; code equivalent to Scheme code like this:
	51	;;
b674d471 AW	52	;; (let ((pointer 0)
	53	;; (tape (make-vector tape-size 0)))
	54	;; (begin
	55	;; <body>
a84673a6	56	;; (write-char #\newline)))
5c27902e AW	57	;;
	58	;; So first the pointer and tape variables are set up correctly, then the
	59	;; program's body is executed in this context, and finally we output an
	60	;; additional newline character in case the program does not output one.
	61	;;
b674d471 AW	62	;; The fact that we are compiling to Guile primitives gives this
	63	;; implementation a number of interesting characteristics. First, the
	64	;; values of the tape cells do not underflow or overflow. We could make
	65	;; them do otherwise via compiling calls to "modulo" at certain points.
	66	;;
	67	;; In addition, tape overruns or underruns will be detected, and will
	68	;; throw an error, whereas a number of Brainfuck compilers do not detect
	69	;; this.
	70	;;
5c27902e AW	71	;; Note that we're generating the S-expression representation of
	72	;; Tree-IL, then using parse-tree-il to turn it into the actual Tree-IL
	73	;; data structures. This makes the compiler more pleasant to look at,
	74	;; but we do lose is the ability to propagate source information. Since
	75	;; Brainfuck is so obtuse anyway, this shouldn't matter ;-)
	76	;;
b674d471 AW	77	;; `compile-tree-il' takes as its input the read expression, the
	78	;; environment, and some compile options. It returns the compiled
	79	;; expression, the environment appropriate for the next pass of the
	80	;; compiler -- in our case, just the environment unchanged -- and the
	81	;; continuation environment.
	82	;;
	83	;; The normal use of a continuation environment is if compiling one
	84	;; expression changes the environment, and that changed environment
	85	;; should be passed to the next compiled expression -- for example,
	86	;; changing the current module. But Brainfuck is incapable of that, so
	87	;; for us, the continuation environment is just the same environment we
	88	;; got in.
	89	;;
	90	;; FIXME: perhaps use options or the env to set the tape-size?
5c27902e AW	91
	92	(define (compile-tree-il exp env opts)
	93	(values
	94	(parse-tree-il
a84673a6 AW	95	`(let (pointer tape) (pointer tape)
	96	((const 0)
	97	(apply (primitive make-vector) (const ,tape-size) (const 0)))
	98	,(compile-body exp)))
5c27902e AW	99	env
	100	env))
	101
	102
	103	;; Compile a list of instructions to a Tree-IL expression.
	104
	105	(define (compile-body instructions)
	106	(let lp ((in instructions) (out '()))
	107	(define (emit x)
	108	(lp (cdr in) (cons x out)))
	109	(cond
	110	((null? in)
	111	;; No more input, build our output.
	112	(cond
	113	((null? out) '(void)) ; no output
	114	((null? (cdr out)) (car out)) ; single expression
	115	(else `(begin ,@(reverse out)))) ; sequence
	116	)
	117	(else
	118	(pmatch (car in)
	119
	120	;; Pointer moves >< are done simply by something like:
	121	;; (set! pointer (+ pointer +-1))
	122	((<bf-move> ,dir)
	123	(emit `(set! (lexical pointer)
	124	(apply (primitive +) (lexical pointer) (const ,dir)))))
	125
	126	;; Cell increment +- is done as:
	127	;; (vector-set! tape pointer (+ (vector-ref tape pointer) +-1))
	128	((<bf-increment> ,inc)
	129	(emit `(apply (primitive vector-set!) (lexical tape) (lexical pointer)
	130	(apply (primitive +)
	131	(apply (primitive vector-ref)
	132	(lexical tape) (lexical pointer))
	133	(const ,inc)))))
	134
	135	;; Output . is done by converting the cell's integer value to a
	136	;; character first and then printing out this character:
	137	;; (write-char (integer->char (vector-ref tape pointer)))
	138	((<bf-print>)
	139	(emit `(apply (primitive write-char)
	140	(apply (primitive integer->char)
	141	(apply (primitive vector-ref)
	142	(lexical tape) (lexical pointer))))))
	143
	144	;; Input , is done similarly, read in a character, get its ASCII
	145	;; code and store it into the current cell:
	146	;; (vector-set! tape pointer (char->integer (read-char)))
	147	((<bf-read>)
	148	(emit `(apply (primitive vector-set!)
	149	(lexical tape) (lexical pointer)
	150	(apply (primitive char->integer)
	151	(apply (primitive read-char))))))
	152
	153	;; For loops [...] we use a letrec construction to execute the body until
	154	;; the current cell gets zero. The body is compiled via a recursive call
	155	;; back to (compile-body).
	156	;; (let iterate ()
	157	;; (if (not (= (vector-ref! tape pointer) 0))
	158	;; (begin
	159	;; <body>
	160	;; (iterate))))
b674d471 AW	161	;;
	162	;; Indeed, letrec is the only way we have to loop in Tree-IL.
	163	;; Note that this does not mean that the closure must actually
	164	;; be created; later passes can compile tail-recursive letrec
	165	;; calls into inline code with gotos. Admittedly, that part of
	166	;; the compiler is not yet in place, but it will be, and in the
	167	;; meantime the code is still reasonably efficient.
5c27902e AW	168	((<bf-loop> . ,body)
	169	(let ((iterate (gensym)))
	170	(emit `(letrec (iterate) (,iterate)
8753fd53 AW	171	((lambda ()
	172	(lambda-case
	173	((() #f #f #f () #f)
	174	(if (apply (primitive =)
	175	(apply (primitive vector-ref)
	176	(lexical tape) (lexical pointer))
	177	(const 0))
	178	(void)
	179	(begin ,(compile-body body)
	180	(apply (lexical ,iterate)))))
	181	#f)))
5c27902e AW	182	(apply (lexical ,iterate))))))
	183
	184	(else (error "unknown brainfuck instruction" (car in))))))))