diff options
author | Andy Wingo <wingo@pobox.com> | 2009-10-16 17:56:39 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-10-23 15:10:25 +0200 |
commit | 8753fd537c4eadf7495f4ba867def99e77246dfc (patch) | |
tree | 75f3346261ae62909bc3d9776df0571990d44943 /module | |
parent | 8a4ca0ea3bd3e378fc63ef719ce828b7252b3985 (diff) | |
download | guile-8753fd537c4eadf7495f4ba867def99e77246dfc.tar.gz |
fix brainfuck for new tree-il, and add tests
* test-suite/Makefile.am:
* test-suite/tests/brainfuck.test: Add a brainfuck test.
* module/system/base/compile.scm: Also export read-and-compile.
* module/language/tree-il/spec.scm (join): Fix the joiner in the
0-expression case.
* module/language/tree-il/primitives.scm (+): Recognize (+ x -1) as 1-.
* module/language/brainfuck/parse.scm (read-brainfuck): Return EOF if we
actually received EOF, and there were no expressions read.
* module/language/brainfuck/compile-tree-il.scm (compile-body): Fix the
compiler for the new format of "lambda" in tree-il.
Diffstat (limited to 'module')
-rw-r--r-- | module/language/brainfuck/compile-tree-il.scm | 19 | ||||
-rw-r--r-- | module/language/brainfuck/parse.scm | 13 | ||||
-rw-r--r-- | module/language/tree-il/primitives.scm | 14 | ||||
-rw-r--r-- | module/language/tree-il/spec.scm | 6 | ||||
-rw-r--r-- | module/system/base/compile.scm | 5 |
5 files changed, 39 insertions, 18 deletions
diff --git a/module/language/brainfuck/compile-tree-il.scm b/module/language/brainfuck/compile-tree-il.scm index 0aaa11274..d478aebba 100644 --- a/module/language/brainfuck/compile-tree-il.scm +++ b/module/language/brainfuck/compile-tree-il.scm @@ -168,14 +168,17 @@ ((<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)))))) + ((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)))))))) diff --git a/module/language/brainfuck/parse.scm b/module/language/brainfuck/parse.scm index 0a71638d8..81dbdd94a 100644 --- a/module/language/brainfuck/parse.scm +++ b/module/language/brainfuck/parse.scm @@ -66,9 +66,16 @@ (define (read-brainfuck 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)))))) + (cond + ((eof-object? chr) + (let ((parsed (reverse-without-nops parsed))) + (if (null? parsed) + chr ;; pass on the EOF object + parsed))) + ((eqv? chr #\]) + (reverse-without-nops parsed)) + (else + (iterate (cons (process-input-char chr p) parsed))))))) ; This routine processes a single character of input and builds the diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index 98633f07a..8d9376042 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -210,11 +210,15 @@ (let ((y (const-exp y))) (and (number? y) (exact? y) (= y 1)))) (1+ x) - (if (and (const? x) - (let ((x (const-exp x))) - (and (number? y) (exact? x) (= x 1)))) - (1+ y) - (+ x y))) + (if (and (const? y) + (let ((y (const-exp y))) + (and (number? y) (exact? y) (= y -1)))) + (1- x) + (if (and (const? x) + (let ((x (const-exp x))) + (and (number? y) (exact? x) (= x 1)))) + (1+ y) + (+ x y)))) (x y z . rest) (+ x (+ y z . rest))) (define-primitive-expander * diff --git a/module/language/tree-il/spec.scm b/module/language/tree-il/spec.scm index c47134ed8..b2ebcfcab 100644 --- a/module/language/tree-il/spec.scm +++ b/module/language/tree-il/spec.scm @@ -20,6 +20,7 @@ (define-module (language tree-il spec) #:use-module (system base language) + #:use-module (system base pmatch) #:use-module (language glil) #:use-module (language tree-il) #:use-module (language tree-il compile-glil) @@ -29,7 +30,10 @@ (apply write (unparse-tree-il exp) port)) (define (join exps env) - (make-sequence #f exps)) + (pmatch exps + (() (make-void #f)) + ((,x) x) + (else (make-sequence #f exps)))) (define-language tree-il #:title "Tree Intermediate Language" diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm index 4d1c92fd8..da3f7cd98 100644 --- a/module/system/base/compile.scm +++ b/module/system/base/compile.scm @@ -28,7 +28,10 @@ #:use-module (ice-9 receive) #:export (syntax-error *current-language* - compiled-file-name compile-file compile-and-load + compiled-file-name + compile-file + compile-and-load + read-and-compile compile decompile) #:export-syntax (call-with-compile-error-catch)) |