summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2023-02-06 20:04:20 -0500
committerDavid Thompson <dthompson2@worcester.edu>2023-06-08 08:14:41 -0400
commitcfa9f678c7290703a6e3c57facc92864ca1f5a77 (patch)
treee6ff943df98b8b69c0281277d04c13b9670fb6fa
parentab36cad95b9b70a7cb9c5ff8cc654801023a3aaf (diff)
More renaming.
-rw-r--r--chickadee/graphics/seagull.scm88
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*