summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/graphics/seagull.scm90
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))))))