More renaming.

1 files changed, 44 insertions, 44 deletions

diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm
index fdd1487..d5515be 100644
--- a/chickadee/graphics/seagull.scm
+++ b/chickadee/graphics/seagull.scm
@@ -52,10 +52,11 @@
 ;; GLSL code.
 
 ;; TODO:
+;; - Array types
 ;; - Loops
 ;; - Shader stage linking
-;; - Transform for-all functions into overloads
-;; - User functions that use overloaded functions need to be overloaded themselves
+;; - Input/uniform mapping for invoking shaders from Scheme
+;; - Scheme shader type -> GLSL struct translation
 
 
 ;;;
@@ -798,9 +799,10 @@
 
 ;; Walk the expression tree of a type annotated program and solve for
 ;; all of the type variables using a variant of the Hindley-Milner
-;; type inference algorithm.  GLSL is a statically typed language, but
-;; thanks to type inference the user doesn't have to specify any types
-;; expect for shader inputs, outputs, and uniforms.
+;; type inference algorithm extended to handle qualified types (types
+;; with predicates.)  GLSL is a statically typed language, but thanks
+;; to type inference the user doesn't have to specify any types expect
+;; for shader inputs, outputs, and uniforms.
 
 ;; Primitive types:
 (define (primitive-type name)
@@ -816,12 +818,10 @@
     (('primitive name) name)))
 
 ;; Outputs type:
-(define outputs-type '(outputs))
+(define type:outputs '(outputs))
 
 (define (outputs-type? obj)
-  (match obj
-    (('outputs) #t)
-    (_ #f)))
+  (eq? obj type:outputs))
 
 ;; Struct type:
 (define (struct-type name members)
@@ -889,22 +889,22 @@
   (match type
     (('-> _ returns) returns)))
 
-;; For all types:
-(define (for-all-type quantifiers type)
-  `(for-all ,quantifiers ,type))
+;; Type schemes:
+(define (type-scheme quantifiers type)
+  `(type-scheme ,quantifiers ,type))
 
-(define (for-all-type? obj)
+(define (type-scheme? obj)
   (match obj
-    (('for-all _ _) #t)
+    (('type-scheme _ _) #t)
     (_ #f)))
 
-(define (for-all-type-quantifiers type)
+(define (type-scheme-quantifiers type)
   (match type
-    (('for-all q _) q)))
+    (('type-scheme q _) q)))
 
-(define (for-all-type-ref type)
+(define (type-scheme-ref type)
   (match type
-    (('for-all _ t) t)))
+    (('type-scheme _ t) t)))
 
 ;; Qualified types:
 (define (qualified-type type pred)
@@ -946,7 +946,7 @@
      (map (lambda (return-type)
             (apply-substitution-to-type return-type from to))
           (function-type-returns type))))
-   ((for-all-type? type)
+   ((type-scheme? type)
     type)
    (else (error "invalid type" type))))
 
@@ -1056,7 +1056,7 @@
 
 (define (lookup-type name env)
   (let ((type (lookup name env)))
-    (if (for-all-type? type)
+    (if (type-scheme? type)
         (instantiate type)
         type)))
 
@@ -1349,10 +1349,10 @@
               (delete-duplicates
                (append-map free-variables-in-type
                            (function-type-returns type))))))
-   ((for-all-type? type)
+   ((type-scheme? type)
     (fold delete
-          (free-variables-in-type (for-all-type-ref type))
-          (for-all-type-quantifiers type)))
+          (free-variables-in-type (type-scheme-ref type))
+          (type-scheme-quantifiers type)))
    (else (error "unknown type" type))))
 
 (define (difference a b)
@@ -1363,9 +1363,9 @@
          (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))))
+(define (free-variables-in-type-scheme type-scheme)
+  (difference (type-scheme-quantifiers type-scheme)
+              (free-variables-in-type (type-scheme-ref type-scheme))))
 
 (define (free-variables-in-env env)
   (delete-duplicates
@@ -1374,8 +1374,8 @@
                 ((variable-type? type)
                  (cons (free-variables-in-type type)
                        vars))
-                ((for-all-type? type)
-                 (cons (free-variables-in-for-all type)
+                ((type-scheme? type)
+                 (cons (free-variables-in-type-scheme type)
                        vars))
                 (else vars)))
              '()
@@ -1416,16 +1416,16 @@
                          (free-variables-in-env env))
         (() type)
         ((quantifiers ...)
-         (for-all-type quantifiers (qualified-type type pred))))
+         (type-scheme quantifiers (qualified-type type pred))))
       type))
 
-(define (instantiate for-all)
+(define (instantiate type-scheme)
   (define subs
     (fold (lambda (var env)
             (extend-env var (fresh-variable-type) env))
           (empty-env)
-          (for-all-type-quantifiers for-all)))
-  (define type (for-all-type-ref for-all))
+          (type-scheme-quantifiers type-scheme)))
+  (define type (type-scheme-ref type-scheme))
   (values
    (apply-substitutions-to-type (if (qualified-type? type)
                                     (qualified-type-ref type)
@@ -1439,7 +1439,7 @@
 (define (maybe-instantiate types)
   (define types+preds
     (map (lambda (type)
-           (if (for-all-type? type)
+           (if (type-scheme? type)
                (call-with-values (lambda () (instantiate type)) list)
                (list type #t)))
          types))
@@ -1723,7 +1723,7 @@
   ;; Eval predicate.
   (define-values (pred combined-subs)
     (eval-predicate* exp-pred (compose-substitutions exp-subs unify-subs)))
-  (values (texp (list outputs-type)
+  (values (texp (list type:outputs)
                 `(outputs ,@(map list names exps*)))
           combined-subs
           pred))
@@ -1852,7 +1852,7 @@
   (let ((a (fresh-variable-type))
         (b (fresh-variable-type))
         (c (fresh-variable-type)))
-    (list (for-all-type
+    (list (type-scheme
            (list a b c)
            (qualified-type
             (function-type (list a b) (list c))
@@ -1865,7 +1865,7 @@
 (define (top-level-type-env stage)
   (define type:+/-
     (let ((a (fresh-variable-type)))
-      (list (for-all-type
+      (list (type-scheme
              (list a)
              (qualified-type
               (function-type (list a a) (list a))
@@ -1912,7 +1912,7 @@
     (list (function-type (list type:float) (list type:int))))
   (define type:comparison
     (let ((a (fresh-variable-type)))
-      (list (for-all-type
+      (list (type-scheme
              (list a)
              (qualified-type
               (function-type (list a a) (list type:bool))
@@ -1932,7 +1932,7 @@
                          (list type:vec4))))
   (define type:abs
     (let ((a (fresh-variable-type)))
-      (list (for-all-type
+      (list (type-scheme
              (list a)
              (qualified-type
               (function-type (list a) (list a))
@@ -1941,7 +1941,7 @@
                (predicate:= a type:float)))))))
   (define type:sqrt
     (let ((a (fresh-variable-type)))
-      (list (for-all-type
+      (list (type-scheme
              (list a)
              (qualified-type
               (function-type (list a) (list a))
@@ -1950,7 +1950,7 @@
                (predicate:= a type:float)))))))
   (define type:min/max
     (let ((a (fresh-variable-type)))
-      (list (for-all-type
+      (list (type-scheme
              (list a)
              (qualified-type
               (function-type (list a a) (list a))
@@ -1961,7 +1961,7 @@
     (list (function-type (list type:float) (list type:float))))
   (define type:clamp/mix
     (let ((a (fresh-variable-type)))
-      (list (for-all-type
+      (list (type-scheme
              (list a)
              (qualified-type
               (function-type (list a a) (list a))
@@ -2015,7 +2015,7 @@
 ;;; Overloaded functions
 ;;;
 
-;; Replace quantified functions ('for-all' expressions) with a series
+;; Replace quantified functions ('type-scheme' expressions) with a series
 ;; of non-quantified function type specifications, one for each unique
 ;; type of call in the program.
 
@@ -2084,8 +2084,8 @@
        (let loop ((bindings bindings))
          (match bindings
            (() '())
-           ((('function name ('t ((? for-all-type? type)) func)) . rest)
-            (define qtype (for-all-type-ref type))
+           ((('function name ('t ((? type-scheme? type)) func)) . rest)
+            (define qtype (type-scheme-ref type))
             (define func-type (qualified-type-ref qtype))
             (append (map (lambda (subs)
                            (define type*