Rename simplify-exp to simplify and add metacommand.

1 files changed, 29 insertions, 19 deletions

diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm
index abd4429..70ff46b 100644
--- a/chickadee/graphics/seagull.scm
+++ b/chickadee/graphics/seagull.scm
@@ -1191,15 +1191,15 @@
 ;; a bit easier.
 
 (define (simplify:list exps env)
-  (map (lambda (exp) (simplify-exp exp env)) exps))
+  (map (lambda (exp) (simplify exp env)) exps))
 
 (define (simplify:if predicate consequent alternate env)
-  `(if ,(simplify-exp predicate env)
-       ,(simplify-exp consequent env)
-       ,(simplify-exp alternate env)))
+  `(if ,(simplify predicate env)
+       ,(simplify consequent env)
+       ,(simplify alternate env)))
 
 (define (simplify:lambda params body env)
-  `(lambda ,params ,(simplify-exp body env)))
+  `(lambda ,params ,(simplify body env)))
 
 (define (simplify:values exps env)
   `(values ,@(simplify:list exps env)))
@@ -1222,9 +1222,9 @@
                 names exps*))
   ;; If there are no bindings left, remove the 'let' entirely.
   (if (null? bindings)
-      (simplify-exp body env*)
+      (simplify body env*)
       `(let ,bindings
-         ,(simplify-exp body env*))))
+         ,(simplify body env*))))
 
 (define (simplify:let-values names exps body env)
   (define exps* (simplify:list exps env))
@@ -1264,9 +1264,9 @@
                 names exps*))
   ;; If there are no bindings left, remove the 'let' entirely.
   (if (null? bindings)
-      (simplify-exp body env*)
+      (simplify body env*)
       `(let-values ,bindings
-         ,(simplify-exp body env*))))
+         ,(simplify body env*))))
 
 (define (simplify:primcall op args env)
   (let* ((primitive (lookup-seagull-primitive op))
@@ -1277,30 +1277,30 @@
         `(primcall ,op ,@args*))))
 
 (define (simplify:call operator args env)
-  `(call ,(simplify-exp operator env)
+  `(call ,(simplify operator env)
          ,@(simplify:list args env)))
 
 (define (simplify:struct-ref exp field env)
-  `(struct-ref ,(simplify-exp exp env) ,field))
+  `(struct-ref ,(simplify exp env) ,field))
 
 (define (simplify:array-ref array-exp index-exp env)
-  `(array-ref ,(simplify-exp array-exp env)
-              ,(simplify-exp index-exp env)))
+  `(array-ref ,(simplify array-exp env)
+              ,(simplify index-exp env)))
 
 (define (simplify:top-level inputs body env)
   `(top-level ,inputs
-              ,(simplify-exp body env)))
+              ,(simplify body env)))
 
 (define (simplify:outputs names exps env)
   `(outputs ,@(map (lambda (name exp)
-                     (list name (simplify-exp exp env)))
+                     (list name (simplify exp env)))
                    names exps)))
 
-(define (simplify-exp exp env)
+(define (simplify exp env)
   (match exp
     ((? constant?) exp)
     ((? symbol?)
-     (or (lookup* exp env) exp))
+     (lookup* exp env exp))
     (('if predicate consequent alternate)
      (simplify:if predicate consequent alternate env))
     (('lambda (params ...) body)
@@ -1324,6 +1324,9 @@
     (('top-level inputs body)
      (simplify:top-level inputs body env))))
 
+(define (simplify* exp)
+  (simplify exp (empty-env)))
+
 
 ;;;
 ;;; Dead code elimination
@@ -3209,7 +3212,7 @@
                                ,body)))
       (define-values (expanded global-map)
         (expand* source* stage))
-      (let* ((simplified (simplify-exp expanded (empty-env)))
+      (let* ((simplified (simplify expanded (empty-env)))
              (pruned (prune simplified))
              (hoisted (hoist-functions* pruned))
              (inferred (infer-types hoisted stage))
@@ -3483,7 +3486,14 @@ vec4 texture(samplerCube tex, vec3 coord) {
 (define-meta-command ((seagull-expand chickadee) repl stage exp)
   "seagull-expand STAGE EXP
 Run the expander on EXP for shader STAGE."
-  (pretty-print (expand exp stage (empty-env))))
+  (parameterize ((unique-identifier-counter 0))
+    (pretty-print (expand* exp stage))))
+
+(define-meta-command ((seagull-simplify chickadee) repl stage exp)
+  "seagull-simplify STAGE EXP
+Run the partial evaluator on EXP for shader STAGE."
+  (parameterize ((unique-identifier-counter 0))
+    (pretty-print (simplify* (expand* exp stage)))))
 
 (define-meta-command ((seagull-inspect chickadee) repl module)
   "seagull-inspect MODULE