From 440f12f151eaf740b51f503bd571ec92d3bc0f07 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Mon, 6 Feb 2023 09:22:41 -0500 Subject: Fix top level type env creation. --- chickadee/graphics/seagull.scm | 232 +++++++++++++++++++---------------------- 1 file 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:*) -- cgit v1.2.3