diff options
| -rw-r--r-- | chickadee/graphics/seagull.scm | 90 |
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)))))) |