Rename propagate pass to simplify since it also does constant folding.

1 files changed, 45 insertions, 45 deletions

diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm
index 733157b..44965c2 100644
--- a/chickadee/graphics/seagull.scm
+++ b/chickadee/graphics/seagull.scm
@@ -39,8 +39,8 @@
 ;;
 ;; TODO:
 ;; - Loops
-;; - Dead code elimination (error when a uniform is eliminated)
 ;; - User defined structs
+;; - Dead code elimination (error when a uniform is eliminated)
 ;; - Multiple GLSL versions
 ;; - Better error messages (especially around type predicate failure)
 ;; - Refactor to add define-primitive syntax
@@ -544,7 +544,7 @@
 
 
 ;;;
-;;; Constant propagation and partial evaluation
+;;; Constant propagation and folding
 ;;;
 
 ;; Replace references to constants (variables that store an immediate
@@ -553,23 +553,23 @@
 ;; have constant arguments.  This will make the type inferencer's job
 ;; a bit easier.
 
-(define (propagate:if predicate consequent alternate env)
-  `(if ,(propagate-constants predicate env)
-       ,(propagate-constants consequent env)
-       ,(propagate-constants alternate env)))
+(define (simplify:if predicate consequent alternate env)
+  `(if ,(simplify-exp predicate env)
+       ,(simplify-exp consequent env)
+       ,(simplify-exp alternate env)))
 
-(define (propagate:lambda params body env)
-  `(lambda ,params ,(propagate-constants body env)))
+(define (simplify:lambda params body env)
+  `(lambda ,params ,(simplify-exp body env)))
 
-(define (propagate:values exps env)
+(define (simplify:values exps env)
   `(values ,@(map (lambda (exp)
-                    (propagate-constants exp env))
+                    (simplify-exp exp env))
                   exps)))
 
-(define (propagate:let names exps body env)
+(define (simplify:let names exps body env)
   (define exps*
     (map (lambda (exp)
-           (propagate-constants exp env))
+           (simplify-exp exp env))
          exps))
   ;; Extend environment with known constants.
   (define env*
@@ -587,28 +587,28 @@
                 names exps*))
   ;; If there are no bindings left, remove the 'let' entirely.
   (if (null? bindings)
-      (propagate-constants body env*)
+      (simplify-exp body env*)
       `(let ,bindings
-         ,(propagate-constants body env*))))
+         ,(simplify-exp body env*))))
 
-(define (propagate:primcall operator args env)
+(define (simplify:primcall operator args env)
   `(primcall ,operator
              ,@(map (lambda (arg)
-                      (propagate-constants arg env))
+                      (simplify-exp arg env))
                     args)))
 
-(define (propagate:call operator args env)
-  `(call ,(propagate-constants operator env)
+(define (simplify:call operator args env)
+  `(call ,(simplify-exp operator env)
          ,@(map (lambda (arg)
-                  (propagate-constants arg env))
+                  (simplify-exp arg env))
                 args)))
 
-(define (propagate:struct-ref exp field env)
-  `(struct-ref ,(propagate-constants exp env) ,field))
+(define (simplify:struct-ref exp field env)
+  `(struct-ref ,(simplify-exp exp env) ,field))
 
-(define (propagate:array-ref array-exp index-exp env)
-  `(array-ref ,(propagate-constants array-exp env)
-              ,(propagate-constants index-exp env)))
+(define (simplify:array-ref array-exp index-exp env)
+  `(array-ref ,(simplify-exp array-exp env)
+              ,(simplify-exp index-exp env)))
 
 ;; The division of two integers can result in a rational, non-integer,
 ;; such as 1/2.  This isn't how integer division works in GLSL, so we
@@ -619,9 +619,9 @@
         result
         (round result))))
 
-(define (propagate:arithmetic op x y env)
-  (define x* (propagate-constants x env))
-  (define y* (propagate-constants y env))
+(define (simplify:arithmetic op x y env)
+  (define x* (simplify-exp x env))
+  (define y* (simplify-exp y env))
   (if (or (and (exact-integer? x*) (exact-integer? y*))
           (and (float? x*) (float? y*)))
       (let ((op* (case op
@@ -632,42 +632,42 @@
         (op* x* y*))
       `(primcall ,op ,x* ,y*)))
 
-(define (propagate:top-level inputs body env)
+(define (simplify:top-level inputs body env)
   `(top-level ,inputs
-              ,(propagate-constants body env)))
+              ,(simplify-exp body env)))
 
-(define (propagate:outputs names exps env)
+(define (simplify:outputs names exps env)
   `(outputs ,@(map (lambda (name exp)
-                     (list name (propagate-constants exp env)))
+                     (list name (simplify-exp exp env)))
                    names exps)))
 
-(define (propagate-constants exp env)
+(define (simplify-exp exp env)
   (match exp
     ((? immediate?) exp)
     ((? symbol?)
      (or (lookup* exp env) exp))
     (('if predicate consequent alternate)
-     (propagate:if predicate consequent alternate env))
+     (simplify:if predicate consequent alternate env))
     (('lambda (params ...) body)
-     (propagate:lambda params body env))
+     (simplify:lambda params body env))
     (('values exps ...)
-     (propagate:values exps env))
+     (simplify:values exps env))
     (('let ((names exps) ...) body)
-     (propagate:let names exps body env))
+     (simplify:let names exps body env))
     (('primcall (and (or '+ '- '* '/) op) x y)
-     (propagate:arithmetic op x y env))
+     (simplify:arithmetic op x y env))
     (('primcall operator args ...)
-     (propagate:primcall operator args env))
+     (simplify:primcall operator args env))
     (('call operator args ...)
-     (propagate:call operator args env))
+     (simplify:call operator args env))
     (('struct-ref exp field)
-     (propagate:struct-ref exp field env))
+     (simplify:struct-ref exp field env))
     (('array-ref array-exp index-exp)
-     (propagate:array-ref array-exp index-exp env))
+     (simplify:array-ref array-exp index-exp env))
     (('outputs (names exps) ...)
-     (propagate:outputs names exps env))
+     (simplify:outputs names exps env))
     (('top-level inputs body)
-     (propagate:top-level inputs body env))))
+     (simplify:top-level inputs body env))))
 
 
 ;;;
@@ -2739,8 +2739,8 @@
                                ,source)))
       (define-values (expanded global-map)
         (expand source* stage (top-level-env)))
-      (let* ((propagated (propagate-constants expanded (empty-env)))
-             (hoisted (hoist-functions* propagated))
+      (let* ((simplified (simplify-exp expanded (empty-env)))
+             (hoisted (hoist-functions* simplified))
              (inferred (infer-types hoisted stage))
              (resolved (resolve-overloads inferred stage)))
         (values resolved global-map (unique-identifier-counter))))))