Fix GLSL type descriptor emission.

1 files changed, 35 insertions, 33 deletions

diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm
index f19dc90..be479ba 100644
--- a/chickadee/graphics/seagull.scm
+++ b/chickadee/graphics/seagull.scm
@@ -2212,10 +2212,30 @@
 
 ;; Transform a fully typed Seagull program into a string of GLSL code.
 
-(define (type-name type)
-  (if (struct-type? type)
-      (struct-type-name type)
-      (primitive-type-name type)))
+(define %type-name-map
+  '((sampler-2d . sampler2D)))
+
+(define (type-descriptor->glsl desc)
+  (match desc
+    ((? symbol?)
+     (or (assq-ref %type-name-map desc) desc))
+    (('array desc* length)
+     (format #f "~a[~a]"
+             (type-descriptor->glsl desc*)
+             length))))
+
+(define (type->type-descriptor type)
+  (cond
+   ((primitive-type? type)
+    (primitive-type-name type))
+   ((struct-type? type)
+    (struct-type-name type))
+   ((array-type? type)
+    `(array ,(type->type-descriptor (array-type-ref type))
+            ,(array-type-length type)))))
+
+(define (type->glsl type)
+  (type-descriptor->glsl (type->type-descriptor type)))
 
 (define (single-temp temps)
   (match temps
@@ -2253,7 +2273,7 @@
   (define temp (unique-identifier))
   (indent level port)
   (format port "~a ~a = ~a ~a ~a;\n"
-          (type-name type) temp a-temp op* b-temp)
+          (type->glsl type) temp a-temp op* b-temp)
   (list temp))
 
 (define (emit:unary-operator type op a version port level)
@@ -2265,14 +2285,14 @@
   (define temp (unique-identifier))
   (indent level port)
   (format port "~a ~a = ~a(~a);\n"
-          (type-name type) temp op* a-temp)
+          (type->glsl type) temp op* a-temp)
   (list temp))
 
 (define (emit:declaration type lhs rhs port level)
   (indent level port)
   (if rhs
-      (format port "~a ~a = ~a;\n" (type-name type) lhs rhs)
-      (format port "~a ~a;\n" (type-name type) lhs)))
+      (format port "~a ~a = ~a;\n" (type->glsl type) lhs rhs)
+      (format port "~a ~a;\n" (type->glsl type) lhs)))
 
 (define (emit:declarations types lhs-list rhs-list port level)
   (define rhs-list* (if rhs-list rhs-list (make-list (length lhs-list) #f)))
@@ -2303,7 +2323,7 @@
        (unless first?
          (display ", " port))
        (format port "~a ~a ~a"
-               qualifier (type-name type) name)
+               qualifier (type->glsl type) name)
        (loop rest #f))))
   (display ") {\n" port)
   (define body-temps (emit-glsl body version port (+ level 1)))
@@ -2368,7 +2388,7 @@
   (define output-temp (unique-identifier))
   (indent level port)
   (format port "~a ~a = ~a(~a);\n"
-          (type-name type)
+          (type->glsl type)
           output-temp
           operator*
           (string-join (map symbol->string arg-temps) ", "))
@@ -2390,46 +2410,28 @@
   output-temps)
 
 (define (emit:struct-ref type exp field version port level)
-  (define input-temp
-    (match (emit-glsl exp version port level)
-      ((temp) temp)))
+  (define input-temp (single-temp (emit-glsl exp version port level)))
   (define output-temp (unique-identifier))
   (indent level port)
   (format port "~a ~a = ~a.~a;\n"
-          (type-name type)
+          (type->glsl type)
           output-temp
           input-temp
           field)
   (list output-temp))
 
 (define (emit:array-ref type array-exp index-exp version port level)
-  (define array-temp
-    (match (emit-glsl array-exp version port level)
-      ((temp) temp)))
-  (define index-temp
-    (match (emit-glsl index-exp version port level)
-      ((temp) temp)))
+  (define array-temp (single-temp (emit-glsl array-exp version port level)))
+  (define index-temp (single-temp (emit-glsl index-exp version port level)))
   (define output-temp (unique-identifier))
   (indent level port)
   (format port "~a ~a = ~a[~a];\n"
-          (type-name type)
+          (type->glsl type)
           output-temp
           array-temp
           index-temp)
   (list output-temp))
 
-(define %type-name-map
-  '((sampler-2d . sampler2D)))
-
-(define (type-descriptor->glsl desc)
-  (match desc
-    ((? symbol?)
-     (or (assq-ref %type-name-map desc) desc))
-    (('array desc* length)
-     (format #f "~a[~a]"
-             (type-descriptor->glsl desc*)
-             length))))
-
 (define (emit:top-level bindings body version port level)
   (for-each (match-lambda
               (((? top-level-qualifier? qualifier) type-desc name)