Re-organize a bit.

1 files changed, 85 insertions, 85 deletions

diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm
index 278ca63..6af69eb 100644
--- a/chickadee/graphics/seagull.scm
+++ b/chickadee/graphics/seagull.scm
@@ -114,14 +114,6 @@
     ((fragment)
      (memq name '(gl-frag-depth gl-sample-mask)))))
 
-(define (difference a b)
-  (match a
-    (() b)
-    ((x . rest)
-     (if (memq x b)
-         (difference rest (delq x b))
-         (cons x (difference rest b))))))
-
 
 ;;;
 ;;; Lexical environments
@@ -326,7 +318,7 @@
 (define (expand:outputs names exps stage env)
   `(outputs
     ,@(map (lambda (name exp)
-             (list (if (built-in-output? name (current-shader-stage))
+             (list (if (built-in-output? name stage)
                        name
                        (lookup name env))
                    (expand exp stage env)))
@@ -808,6 +800,71 @@
       (function-type? obj)
       (overload-type? obj)))
 
+(define (apply-substitution-to-type type from to)
+  (cond
+   ((or (primitive-type? type)
+        (outputs-type? type))
+    type)
+   ((type-variable? type)
+    (if (equal? type from) to type))
+   ((function-type? type)
+    (function-type
+     (map (lambda (param-type)
+            (apply-substitution-to-type param-type from to))
+          (function-type-parameters type))
+     (map (lambda (return-type)
+            (apply-substitution-to-type return-type from to))
+          (function-type-returns type))))
+   ((overload-type? type)
+    (apply overload-type
+           (map (lambda (type)
+                  (apply-substitution-to-type type from to))
+                (overload-type-ref type))))
+   (else (error "invalid type" type))))
+
+(define (apply-substitutions-to-type type subs)
+  (env-fold (lambda (from to type*)
+              (apply-substitution-to-type type* from to))
+            type
+            subs))
+
+(define (apply-substitutions-to-types types subs)
+  (map (lambda (type)
+         (apply-substitutions-to-type type subs))
+       types))
+
+;; Typed expressions:
+(define (texp types exp)
+  `(t ,types ,exp))
+
+(define (texp? obj)
+  (match obj
+    (('t _ _) #t)
+    (_ #f)))
+
+(define (texp-types texp)
+  (match texp
+    (('t types _) types)))
+
+(define (texp-exp texp)
+  (match texp
+    (('t _ exp) exp)))
+
+(define (single-type texp)
+  (match (texp-types texp)
+    ((type) type)
+    (_ (error "expected only 1 type" texp))))
+
+
+;;;
+;;; Type annotation
+;;;
+
+;; Convert untyped Seagull expressions into typed expressions with
+;; type variables representing all unknown types.  This annotated
+;; version of a Seagull program can then be passed to the type
+;; inference algorithm to solve for all of the variables.
+
 (define add/sub-type
   (list (overload-type
          (function-type (list int-type int-type)
@@ -977,82 +1034,6 @@
          `((texture-2d ,(function-type (list sampler-2d-type vec2-type)
                                        (list vec4-type))))))))
 
-(define (occurs? a b)
-  (cond
-   ((and (type-variable? a) (type-variable? b))
-    (eq? a b))
-   ((and (type-variable? a) (function-type? b))
-    (or (occurs? a (function-type-parameters b))
-        (occurs? a (function-type-returns b))))
-   ((and (type? a) (list? b))
-    (any (lambda (b*) (occurs? a b*)) b))
-   (else #f)))
-
-(define (apply-substitution-to-type type from to)
-  (cond
-   ((or (primitive-type? type)
-        (outputs-type? type))
-    type)
-   ((type-variable? type)
-    (if (equal? type from) to type))
-   ((function-type? type)
-    (function-type
-     (map (lambda (param-type)
-            (apply-substitution-to-type param-type from to))
-          (function-type-parameters type))
-     (map (lambda (return-type)
-            (apply-substitution-to-type return-type from to))
-          (function-type-returns type))))
-   ((overload-type? type)
-    (apply overload-type
-           (map (lambda (type)
-                  (apply-substitution-to-type type from to))
-                (overload-type-ref type))))
-   (else (error "invalid type" type))))
-
-(define (apply-substitutions-to-type type subs)
-  (env-fold (lambda (from to type*)
-              (apply-substitution-to-type type* from to))
-            type
-            subs))
-
-(define (apply-substitutions-to-types types subs)
-  (map (lambda (type)
-         (apply-substitutions-to-type type subs))
-       types))
-
-;; Typed expressions:
-(define (texp types exp)
-  `(t ,types ,exp))
-
-(define (texp? obj)
-  (match obj
-    (('t _ _) #t)
-    (_ #f)))
-
-(define (texp-types texp)
-  (match texp
-    (('t types _) types)))
-
-(define (texp-exp texp)
-  (match texp
-    (('t _ exp) exp)))
-
-(define (single-type texp)
-  (match (texp-types texp)
-    ((type) type)
-    (_ (error "expected only 1 type" texp))))
-
-
-;;;
-;;; Type annotation
-;;;
-
-;; Convert untyped Seagull expressions into typed expressions with
-;; type variables representing all unknown types.  This annotated
-;; version of a Seagull program can then be passed to the type
-;; inference algorithm to solve for all of the variables.
-
 (define (lookup-type name env)
   (let ((type (lookup name env)))
     (if (for-all-type? type)
@@ -1075,6 +1056,14 @@
           (for-all-type-quantifiers type)))
    (else (error "unknown type" type))))
 
+(define (difference a b)
+  (match a
+    (() b)
+    ((x . rest)
+     (if (memq x b)
+         (difference rest (delq x b))
+         (cons x (difference rest b))))))
+
 (define (free-variables-in-for-all for-all)
   (difference (for-all-type-quantifiers for-all)
               (free-variables-in-type (for-all-type-ref for-all))))
@@ -1235,6 +1224,17 @@
 ;; thanks to type inference the user doesn't have to specify any types
 ;; expect for shader inputs, outputs, and uniforms.
 
+(define (occurs? a b)
+  (cond
+   ((and (type-variable? a) (type-variable? b))
+    (eq? a b))
+   ((and (type-variable? a) (function-type? b))
+    (or (occurs? a (function-type-parameters b))
+        (occurs? a (function-type-returns b))))
+   ((and (type? a) (list? b))
+    (any (lambda (b*) (occurs? a b*)) b))
+   (else #f)))
+
 (define (compose-substitutions a b)
   (define b*
     (map (match-lambda