Some renaming.

1 files changed, 179 insertions, 182 deletions

diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm
index ca11ec3..6b2d099 100644
--- a/chickadee/graphics/seagull.scm
+++ b/chickadee/graphics/seagull.scm
@@ -850,27 +850,27 @@
   (define var-name (struct-type 'name (list (cons 'names types) ...))))
 
 ;; Type variables:
-(define unique-type-variable-counter (make-parameter 0))
+(define unique-variable-type-counter (make-parameter 0))
 
-(define (unique-type-variable-number)
-  (let ((n (unique-type-variable-counter)))
-    (unique-type-variable-counter (+ n 1))
+(define (unique-variable-type-number)
+  (let ((n (unique-variable-type-counter)))
+    (unique-variable-type-counter (+ n 1))
     n))
 
-(define (unique-type-variable-name)
+(define (unique-variable-type-name)
   (string->symbol
-   (format #f "T~a" (unique-type-variable-number))))
+   (format #f "T~a" (unique-variable-type-number))))
 
-(define (type-variable name)
+(define (variable-type name)
   `(tvar ,name))
 
-(define (fresh-type-variable)
-  (type-variable (unique-type-variable-name)))
+(define (fresh-variable-type)
+  (variable-type (unique-variable-type-name)))
 
-(define (fresh-type-variables-for-list lst)
-  (map (lambda (_x) (fresh-type-variable)) lst))
+(define (fresh-variable-types-for-list lst)
+  (map (lambda (_x) (fresh-variable-type)) lst))
 
-(define (type-variable? obj)
+(define (variable-type? obj)
   (match obj
     (('tvar _) #t)
     (_ #f)))
@@ -928,7 +928,7 @@
 
 (define (type? obj)
   (or (primitive-type? obj)
-      (type-variable? obj)
+      (variable-type? obj)
       (function-type? obj)
       (struct-type? obj)
       (outputs-type? obj)))
@@ -939,7 +939,7 @@
         (struct-type? type)
         (outputs-type? type))
     type)
-   ((type-variable? type)
+   ((variable-type? type)
     (if (equal? type from) to type))
    ((function-type? type)
     (function-type
@@ -951,11 +951,6 @@
           (function-type-returns type))))
    ((for-all-type? type)
     type)
-   ;; ((qualified-type? type)
-   ;;  (qualified-type (apply-substitution-to-type
-   ;;                   (qualified-type-ref type) from to)
-   ;;                  (apply-substitution-to-predicate
-   ;;                   (qualified-type-predicate type) from to)))
    (else (error "invalid type" type))))
 
 (define (apply-substitutions-to-type type subs)
@@ -1038,9 +1033,9 @@
 
 (define (occurs? a b)
   (cond
-   ((and (type-variable? a) (type-variable? b))
+   ((and (variable-type? a) (variable-type? b))
     (eq? a b))
-   ((and (type-variable? a) (function-type? b))
+   ((and (variable-type? a) (function-type? b))
     (or (occurs? a (function-type-parameters b))
         (occurs? a (function-type-returns b))))
    ((and (type? a) (list? b))
@@ -1184,8 +1179,8 @@
     ;; '=' asserts that 'a' must equal 'b'.  If either is a type
     ;; variable, then we don't have enough information to determine
     ;; success or failure.
-    ((or ('= (? type-variable?) _)
-         ('= _ (? type-variable?)))
+    ((or ('= (? variable-type?) _)
+         ('= _ (? variable-type?)))
      (values pred '()))
     ;; Neither argument is a type variable, so we can get an answer.
     (('= a b)
@@ -1324,9 +1319,11 @@
     ;; carried forward in the inference process.
     (('substitute a b)
      (values #t (list (cons a b))))
-    (('struct-has? struct member var)
+    ;; Substitute the member var when struct has been resolved to a
+    ;; struct type.
+    (('struct-has? struct member member-var)
      (if (struct-type? struct)
-         (values #t (list (cons var (struct-type-ref struct member))))
+         (values #t (list (cons member-var (struct-type-ref struct member))))
          (values pred '())))))
 
 (define (eval-predicate* pred subs)
@@ -1348,7 +1345,7 @@
    ((or (primitive-type? type)
         (struct-type? type))
     '())
-   ((type-variable? type) (list type))
+   ((variable-type? type) (list type))
    ((function-type? type)
     (let ((params (function-type-parameters type)))
       (filter (lambda (t) (member t params))
@@ -1377,7 +1374,7 @@
   (delete-duplicates
    (env-fold (lambda (_name type vars)
                (cond
-                ((type-variable? type)
+                ((variable-type? type)
                  (cons (free-variables-in-type type)
                        vars))
                 ((for-all-type? type)
@@ -1430,7 +1427,7 @@
 (define (instantiate for-all)
   (define subs
     (fold (lambda (var env)
-            (extend-env var (fresh-type-variable) env))
+            (extend-env var (fresh-variable-type) env))
           (empty-env)
           (for-all-type-quantifiers for-all)))
   (define type (for-all-type-ref for-all))
@@ -1497,8 +1494,8 @@
      (unify:primitives a b))
     (((? struct-type? a) (? struct-type? b))
      (unify:structs a b))
-    ((or ((? type-variable? a) b)
-         (b (? type-variable? a)))
+    ((or ((? variable-type? a) b)
+         (b (? variable-type? a)))
      (unify:variable a b))
     (((? function-type? a) (? function-type? b))
      (unify:functions a b))
@@ -1516,11 +1513,11 @@
 (define (infer:immediate x)
   (values (texp (list (cond
                        ((exact-integer? x)
-                        int-type)
+                        type:int)
                        ((float? x)
-                        float-type)
+                        type:float)
                        ((boolean? x)
-                        bool-type)))
+                        type:bool)))
                 x)
           '()
           #t))
@@ -1556,7 +1553,7 @@
   (define-values (predicate-texp predicate-subs predicate-pred)
     (infer-exp predicate env))
   (define predicate-unify-subs
-    (unify (texp-types predicate-texp) (list bool-type)))
+    (unify (texp-types predicate-texp) (list type:bool)))
   ;; Combine the substitutions and apply them to the environment.
   (define combined-subs-0
     (compose-substitutions predicate-subs predicate-unify-subs))
@@ -1592,7 +1589,7 @@
 
 (define (infer:lambda params body env)
   ;; Each function parameter gets a fresh type variable.
-  (define param-types (fresh-type-variables-for-list params))
+  (define param-types (fresh-variable-types-for-list params))
   ;; The type environment is extended with the function parameters.
   (define env*
     (fold (lambda (param type env*)
@@ -1625,7 +1622,7 @@
   ;; Generate fresh type variables to unify against the return types
   ;; of the operator.
   (define return-vars
-    (fresh-type-variables-for-list (function-type-returns operator-type)))
+    (fresh-variable-types-for-list (function-type-returns operator-type)))
   (define call-subs
     (unify operator-type
            (function-type (map single-type args*)
@@ -1660,7 +1657,7 @@
   ;; of the operator.
   (define operator-type (single-type operator*))
   (define return-vars
-    (fresh-type-variables-for-list
+    (fresh-variable-types-for-list
      (function-type-returns operator-type)))
   (define call-subs
     (unify (apply-substitutions-to-type operator-type combined-subs-0)
@@ -1685,7 +1682,7 @@
   (define-values (exp* exp-subs exp-pred)
     (infer-exp exp env))
   (define exp-type (single-type exp*))
-  (define tvar (fresh-type-variable))
+  (define tvar (fresh-variable-type))
   (values (texp (list tvar)
                 `(struct-ref ,exp* ,member))
           exp-subs
@@ -1823,58 +1820,58 @@
     (_ (error "unknown form" exp))))
 
 ;; Built-in types:
-(define int-type (primitive-type 'int))
-(define float-type (primitive-type 'float))
-(define bool-type (primitive-type 'bool))
-(define-struct-type (vec2-type vec2)
-  (float-type x)
-  (float-type y))
-(define-struct-type (vec3-type vec3)
-  (float-type x)
-  (float-type y)
-  (float-type z))
-(define-struct-type (vec4-type vec4)
-  (float-type x)
-  (float-type y)
-  (float-type z)
-  (float-type w))
+(define type:int (primitive-type 'int))
+(define type:float (primitive-type 'float))
+(define type:bool (primitive-type 'bool))
+(define-struct-type (type:vec2 vec2)
+  (type:float x)
+  (type:float y))
+(define-struct-type (type:vec3 vec3)
+  (type:float x)
+  (type:float y)
+  (type:float z))
+(define-struct-type (type:vec4 vec4)
+  (type:float x)
+  (type:float y)
+  (type:float z)
+  (type:float w))
 ;; TODO: Matrices are technically array types in GLSL, but we are
 ;; choosing to represent them opaquely for now to keep things simple.
-(define mat3-type (primitive-type 'mat3))
-(define mat4-type (primitive-type 'mat4))
-(define sampler-2d-type (primitive-type 'sampler-2d))
+(define type:mat3 (primitive-type 'mat3))
+(define type:mat4 (primitive-type 'mat4))
+(define type:sampler-2d (primitive-type 'sampler-2d))
 
 (define (type-name->type name)
   (case name
-    ((bool) bool-type)
-    ((int) int-type)
-    ((float) float-type)
-    ((vec2) vec2-type)
-    ((vec3) vec3-type)
-    ((vec4) vec4-type)
-    ((mat3) mat3-type)
-    ((mat4) mat4-type)
-    ((sampler-2d) sampler-2d-type)))
-
-(define add/sub-type
-  (let ((a (fresh-type-variable)))
+    ((bool) type:bool)
+    ((int) type:int)
+    ((float) type:float)
+    ((vec2) type:vec2)
+    ((vec3) type:vec3)
+    ((vec4) type:vec4)
+    ((mat3) type:mat3)
+    ((mat4) type:mat4)
+    ((sampler-2d) type:sampler-2d)))
+
+(define type:+/-
+  (let ((a (fresh-variable-type)))
     (list (for-all-type
            (list a)
            (qualified-type
             (function-type (list a a) (list a))
             (predicate:or
-             (predicate:= a int-type)
-             (predicate:= a float-type)
-             (predicate:= a vec2-type)
-             (predicate:= a vec3-type)
-             (predicate:= a vec4-type)
-             (predicate:= a mat3-type)
-             (predicate:= a mat4-type)))))))
+             (predicate:= a type:int)
+             (predicate:= a type:float)
+             (predicate:= a type:vec2)
+             (predicate:= a type:vec3)
+             (predicate:= a type:vec4)
+             (predicate:= a type:mat3)
+             (predicate:= a type:mat4)))))))
 
 (define-syntax-rule (a+b->c (ta tb tc) ...)
-  (let ((a (fresh-type-variable))
-        (b (fresh-type-variable))
-        (c (fresh-type-variable)))
+  (let ((a (fresh-variable-type))
+        (b (fresh-variable-type))
+        (c (fresh-variable-type)))
     (list (for-all-type
            (list a b c)
            (qualified-type
@@ -1885,148 +1882,148 @@
                             (predicate:substitute c tc))
              ...))))))
 
-(define mul-type
-  (a+b->c (int-type int-type int-type)
-          (float-type float-type float-type)
-          (vec2-type vec2-type vec2-type)
-          (vec2-type float-type vec2-type)
-          (float-type vec2-type vec2-type)
-          (vec3-type vec3-type vec3-type)
-          (vec3-type float-type vec3-type)
-          (float-type vec3-type vec3-type)
-          (vec4-type vec4-type vec4-type)
-          (vec4-type float-type vec4-type)
-          (float-type vec4-type vec4-type)
-          (mat3-type mat3-type mat3-type)
-          (mat3-type vec3-type mat3-type)
-          (vec3-type mat3-type mat3-type)
-          (mat4-type mat4-type mat4-type)
-          (mat4-type vec4-type vec4-type)
-          (vec4-type mat4-type vec4-type)))
-
-(define div-type
-  (a+b->c (int-type int-type int-type)
-          (float-type float-type float-type)
-          (vec2-type vec2-type vec2-type)
-          (vec2-type float-type vec2-type)
-          (vec3-type vec3-type vec3-type)
-          (vec3-type float-type vec3-type)
-          (vec4-type vec4-type vec4-type)
-          (vec4-type float-type vec4-type)
-          (mat3-type float-type mat3-type)
-          (mat4-type float-type mat4-type)))
-
-(define int->float-type
-  (list (function-type (list int-type) (list float-type))))
-
-(define float->int-type
-  (list (function-type (list float-type) (list int-type))))
-
-(define comparison-type
-  (let ((a (fresh-type-variable)))
+(define type:*
+  (a+b->c (type:int type:int type:int)
+          (type:float type:float type:float)
+          (type:vec2 type:vec2 type:vec2)
+          (type:vec2 type:float type:vec2)
+          (type:float type:vec2 type:vec2)
+          (type:vec3 type:vec3 type:vec3)
+          (type:vec3 type:float type:vec3)
+          (type:float type:vec3 type:vec3)
+          (type:vec4 type:vec4 type:vec4)
+          (type:vec4 type:float type:vec4)
+          (type:float type:vec4 type:vec4)
+          (type:mat3 type:mat3 type:mat3)
+          (type:mat3 type:vec3 type:mat3)
+          (type:vec3 type:mat3 type:mat3)
+          (type:mat4 type:mat4 type:mat4)
+          (type:mat4 type:vec4 type:vec4)
+          (type:vec4 type:mat4 type:vec4)))
+
+(define type:/
+  (a+b->c (type:int type:int type:int)
+          (type:float type:float type:float)
+          (type:vec2 type:vec2 type:vec2)
+          (type:vec2 type:float type:vec2)
+          (type:vec3 type:vec3 type:vec3)
+          (type:vec3 type:float type:vec3)
+          (type:vec4 type:vec4 type:vec4)
+          (type:vec4 type:float type:vec4)
+          (type:mat3 type:float type:mat3)
+          (type:mat4 type:float type:mat4)))
+
+(define type:int->float
+  (list (function-type (list type:int) (list type:float))))
+
+(define type:float->int
+  (list (function-type (list type:float) (list type:int))))
+
+(define type:comparison
+  (let ((a (fresh-variable-type)))
     (list (for-all-type
            (list a)
            (qualified-type
-            (function-type (list a a) (list bool-type))
+            (function-type (list a a) (list type:bool))
             (predicate:or
-             (predicate:= a int-type)
-             (predicate:= a float-type)))))))
+             (predicate:= a type:int)
+             (predicate:= a type:float)))))))
 
-(define not-type
-  (list (function-type (list bool-type) (list bool-type))))
+(define type:not
+  (list (function-type (list type:bool) (list type:bool))))
 
-(define make-vec2-type
-  (list (function-type (list float-type float-type)
-                       (list vec2-type))))
+(define type:make-vec2
+  (list (function-type (list type:float type:float)
+                       (list type:vec2))))
 
-(define make-vec3-type
-  (list (function-type (list float-type float-type float-type)
-                       (list vec3-type))))
+(define type:make-vec3
+  (list (function-type (list type:float type:float type:float)
+                       (list type:vec3))))
 
-(define make-vec4-type
-  (list (function-type (list float-type float-type float-type float-type)
-                       (list vec4-type))))
+(define type:make-vec4
+  (list (function-type (list type:float type:float type:float type:float)
+                       (list type:vec4))))
 
-(define abs-type
-  (let ((a (fresh-type-variable)))
+(define type:abs
+  (let ((a (fresh-variable-type)))
     (list (for-all-type
            (list a)
            (qualified-type
             (function-type (list a) (list a))
             (predicate:or
-             (predicate:= a int-type)
-             (predicate:= a float-type)))))))
+             (predicate:= a type:int)
+             (predicate:= a type:float)))))))
 
-(define sqrt-type
-  (let ((a (fresh-type-variable)))
+(define type:sqrt
+  (let ((a (fresh-variable-type)))
     (list (for-all-type
            (list a)
            (qualified-type
             (function-type (list a) (list a))
             (predicate:or
-             (predicate:= a int-type)
-             (predicate:= a float-type)))))))
+             (predicate:= a type:int)
+             (predicate:= a type:float)))))))
 
-(define min/max-type
-  (let ((a (fresh-type-variable)))
+(define type:min/max
+  (let ((a (fresh-variable-type)))
     (list (for-all-type
            (list a)
            (qualified-type
             (function-type (list a a) (list a))
             (predicate:or
-             (predicate:= a int-type)
-             (predicate:= a float-type)))))))
+             (predicate:= a type:int)
+             (predicate:= a type:float)))))))
 
-(define trigonometry-type
-  (list (function-type (list float-type) (list float-type))))
+(define type:trig
+  (list (function-type (list type:float) (list type:float))))
 
-(define clamp/mix-type
-  (let ((a (fresh-type-variable)))
+(define type:clamp/mix
+  (let ((a (fresh-variable-type)))
     (list (for-all-type
            (list a)
            (qualified-type
             (function-type (list a a) (list a))
             (predicate:or
-             (predicate:= a int-type)
-             (predicate:= a float-type)))))))
+             (predicate:= a type:int)
+             (predicate:= a type:float)))))))
 
-(define texture-2d-ref-type
-  (list (function-type (list sampler-2d-type vec2-type)
-                       (list vec4-type))))
+(define type:texture-2d
+  (list (function-type (list type:sampler-2d type:vec2)
+                       (list type:vec4))))
 
 (define (top-level-type-env stage)
-  `((+ . ,add/sub-type)
-    (- . ,add/sub-type)
-    (* . ,mul-type)
-    (/ . ,div-type)
-    (int->float . ,int->float-type)
-    (float->int . ,float->int-type)
-    (= . ,comparison-type)
-    (< . ,comparison-type)
-    (<= . ,comparison-type)
-    (> . ,comparison-type)
-    (>= . ,comparison-type)
-    (not . ,not-type)
-    (vec2 . ,make-vec2-type)
-    (vec3 . ,make-vec3-type)
-    (vec4 . ,make-vec4-type)
-    (abs . ,abs-type)
-    (sqrt . ,sqrt-type)
-    (min . ,min/max-type)
-    (max . ,min/max-type)
-    (sin . ,trigonometry-type)
-    (cos . ,trigonometry-type)
-    (tan . ,trigonometry-type)
-    (clamp . ,clamp/mix-type)
-    (mix . ,clamp/mix-type)
+  `((+ . ,type:+/-)
+    (- . ,type:+/-)
+    (* . ,type:*)
+    (/ . ,type:/)
+    (int->float . ,type:int->float)
+    (float->int . ,type:float->int)
+    (= . ,type:comparison)
+    (< . ,type:comparison)
+    (<= . ,type:comparison)
+    (> . ,type:comparison)
+    (>= . ,type:comparison)
+    (not . ,type:not)
+    (vec2 . ,type:make-vec2)
+    (vec3 . ,type:make-vec3)
+    (vec4 . ,type:make-vec4)
+    (abs . ,type:abs)
+    (sqrt . ,type:sqrt)
+    (min . ,type:min/max)
+    (max . ,type:min/max)
+    (sin . ,type:trig)
+    (cos . ,type:trig)
+    (tan . ,type:trig)
+    (clamp . ,type:clamp/mix)
+    (mix . ,type:clamp/mix)
     ,@(case stage
         ((vertex)
-         `((vertex:position ,vec4-type)
-           (vertex:point-size ,float-type)
-           (vertex:clip-distance ,float-type)))
+         `((vertex:position ,type:vec4)
+           (vertex:point-size ,type:float)
+           (vertex:clip-distance ,type:float)))
         ((fragment)
-         `((fragment:depth ,float-type)
-           (texture-2d . ,texture-2d-ref-type))))))
+         `((fragment:depth ,type:float)
+           (texture-2d . ,type:texture-2d))))))
 
 ;; TODO: Add some kind of context object that is threaded through the
 ;; inference process so that when a type error occurs we can show the
@@ -2403,7 +2400,7 @@
                           (version '330)
                           (port (current-output-port)))
   (parameterize ((unique-identifier-counter 0)
-                 (unique-type-variable-counter 0))
+                 (unique-variable-type-counter 0))
     (let* ((expanded (expand exp stage (top-level-env)))
            (propagated (propagate-constants expanded (empty-env)))
            (hoisted (hoist-functions* propagated))