summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2023-02-06 09:22:41 -0500
committerDavid Thompson <dthompson2@worcester.edu>2023-06-08 08:14:41 -0400
commit440f12f151eaf740b51f503bd571ec92d3bc0f07 (patch)
tree14be52433c50009dd43b08e1fa00a611ca359cbc
parent7c19a157b9daaf31204dbfa0b7d5574ef3d19645 (diff)
Fix top level type env creation.
-rw-r--r--chickadee/graphics/seagull.scm232
1 files changed, 108 insertions, 124 deletions
diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm
index 6b2d099..5cacdcf 100644
--- a/chickadee/graphics/seagull.scm
+++ b/chickadee/graphics/seagull.scm
@@ -1853,21 +1853,6 @@
((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 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-variable-type))
(b (fresh-variable-type))
@@ -1882,116 +1867,115 @@
(predicate:substitute c tc))
...))))))
-(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 type:bool))
- (predicate:or
- (predicate:= a type:int)
- (predicate:= a type:float)))))))
-
-(define type:not
- (list (function-type (list type:bool) (list type:bool))))
-
-(define type:make-vec2
- (list (function-type (list type:float type:float)
- (list type:vec2))))
-
-(define type:make-vec3
- (list (function-type (list type:float type:float type:float)
- (list type:vec3))))
-
-(define type:make-vec4
- (list (function-type (list type:float type:float type:float type:float)
- (list type:vec4))))
-
-(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 type:int)
- (predicate:= a type:float)))))))
-
-(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 type:int)
- (predicate:= a type:float)))))))
-
-(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 type:int)
- (predicate:= a type:float)))))))
-
-(define type:trig
- (list (function-type (list type:float) (list type:float))))
-
-(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 type:int)
- (predicate:= a type:float)))))))
-
-(define type:texture-2d
- (list (function-type (list type:sampler-2d type:vec2)
- (list type:vec4))))
-
(define (top-level-type-env stage)
+ (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 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 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 type:bool))
+ (predicate:or
+ (predicate:= a type:int)
+ (predicate:= a type:float)))))))
+ (define type:not
+ (list (function-type (list type:bool) (list type:bool))))
+ (define type:make-vec2
+ (list (function-type (list type:float type:float)
+ (list type:vec2))))
+ (define type:make-vec3
+ (list (function-type (list type:float type:float type:float)
+ (list type:vec3))))
+ (define type:make-vec4
+ (list (function-type (list type:float type:float type:float type:float)
+ (list type:vec4))))
+ (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 type:int)
+ (predicate:= a type:float)))))))
+ (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 type:int)
+ (predicate:= a type:float)))))))
+ (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 type:int)
+ (predicate:= a type:float)))))))
+ (define type:trig
+ (list (function-type (list type:float) (list type:float))))
+ (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 type:int)
+ (predicate:= a type:float)))))))
+ (define type:texture-2d
+ (list (function-type (list type:sampler-2d type:vec2)
+ (list type:vec4))))
`((+ . ,type:+/-)
(- . ,type:+/-)
(* . ,type:*)