From d737274d6fe5e804e356576d3245123089418d7e Mon Sep 17 00:00:00 2001 From: Eric Holk Date: Thu, 16 Jan 2014 16:38:41 -0500 Subject: [PATCH] Seriously turn down the let lifting so we get correct results on mandelbrot.kfc again. Issues #116 and #56. --- harlan/middle/lifting.scm | 38 ++++++++++++++++++++++---------------- harlanc.scm | 2 +- lib/harlan/graphics.kfc | 1 + test/mandelbrot.kfc | 5 ++--- 4 files changed, 26 insertions(+), 20 deletions(-) diff --git a/harlan/middle/lifting.scm b/harlan/middle/lifting.scm index f9cf679..62ad807 100644 --- a/harlan/middle/lifting.scm +++ b/harlan/middle/lifting.scm @@ -94,16 +94,22 @@ ,[Expr -> end end-bindings] ,[Expr -> step step-bindings]) ,[body bindings]) - (let-values (((liftable pinned) - ((split-bindings (list x)) bindings))) - (values - `(for (,x ,start ,end ,step) - ,(make-let pinned body)) - (append start-bindings end-bindings step-bindings liftable)))) + ;; We don't lift any body bindings out of the for loop, in case + ;; side effects mess with them. Again, we need a proper assigned + ;; variable analysis. + (values + `(for (,x ,start ,end ,step) + ,(make-let bindings body)) + (append start-bindings end-bindings step-bindings))) ((while ,[Expr -> test test-bindings] ,[body bindings]) - (values `(while ,test ,body) - (append test-bindings bindings))) + ;; We don't lift any bindings in the body outside of the while + ;; loop. This avoids problems when there are side effects. That + ;; said, this is exactly the situation where we do want to lift + ;; bindings, so we should probably do a proper assigned variable + ;; analysis instead. + (values `(while ,test ,(make-let bindings body)) + test-bindings)) ((if ,[Expr -> e bindings] ,c) (values `(if ,e ,c) bindings)) ((if ,[Expr -> e bindings] ,c ,a) @@ -128,15 +134,15 @@ `(begin ,@(map make-let bindings* stmt*) ,(make-let bindings e)) `())) ((kernel ,kt ,d (((,x* ,t) (,e ,es) ,dim) ...) ,[body bindings]) - (let-values (((liftable pinned) ((split-bindings x*) bindings))) - (values `(kernel ,kt ,d (((,x* ,t) (,e ,es) ,dim) ...) - ,(make-let pinned body)) - liftable))) + ;; Don't lift out of kernels, in case there are side + ;; effects. Again, we need an assigned variable analysis. + (values `(kernel ,kt ,d (((,x* ,t) (,e ,es) ,dim) ...) + ,(make-let bindings body)) + '())) ((kernel ,kt ,r ,d (((,x* ,t) (,e ,es) ,dim) ...) ,[body bindings]) - (let-values (((liftable pinned) ((split-bindings x*) bindings))) - (values `(kernel ,kt ,r ,d (((,x* ,t) (,e ,es) ,dim) ...) - ,(make-let pinned body)) - liftable))) + (values `(kernel ,kt ,r ,d (((,x* ,t) (,e ,es) ,dim) ...) + ,(make-let bindings body)) + '())) (,e (values e `()))) (define-match free-vars-Expr diff --git a/harlanc.scm b/harlanc.scm index 9869b02..3c93727 100644 --- a/harlanc.scm +++ b/harlanc.scm @@ -41,6 +41,6 @@ (let ((filename (car args))) (print-compile-harlan filename))))) -;;(trace-pass 'typecheck) +;(trace-pass 'optimize-lift-lets) (harlanc (command-line)) diff --git a/lib/harlan/graphics.kfc b/lib/harlan/graphics.kfc index 609454d..0948136 100644 --- a/lib/harlan/graphics.kfc +++ b/lib/harlan/graphics.kfc @@ -73,6 +73,7 @@ (for (i 0 rows 1) (for (j 0 cols 1) (let ((p (vector-ref (vector-ref data i) j))) + ;;(println* i "\t" j "\t" p) (print (cond ((< p 0) 0) ((> p 255) 255) diff --git a/test/mandelbrot.kfc b/test/mandelbrot.kfc index ebc1c97..c9ee70b 100644 --- a/test/mandelbrot.kfc +++ b/test/mandelbrot.kfc @@ -22,12 +22,11 @@ (set! xi xip) (let ((m (+ (* xr xr) (* xi xi)))) (if (< m 4.0) - ;; Why do the pixels all turn white - ;; if I just do (set! escape idx)? - (set! escape (- idx 1))) + (set! escape idx)) (set! idx (+ idx 1))))) escape))))) (let ((stop (nanotime))) + (println* (length img) "x" (length (vector-ref img 0))) (write-pgm "test.bin/mandelbrot.pgm" img) (print "Time to generate Mandelbrot Set in milliseconds:\n") (print (/ (- stop start) 1000000))