summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/graphics/seagull.scm22
1 files changed, 17 insertions, 5 deletions
diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm
index 2d002ed..9beb310 100644
--- a/chickadee/graphics/seagull.scm
+++ b/chickadee/graphics/seagull.scm
@@ -957,9 +957,11 @@
(map (lambda (exp) (annotate-exp exp env)) exps))
(define (annotate:if predicate consequent alternate env)
- (texp (list (fresh-type-variable))
+ (define consequent* (annotate-exp consequent env))
+ (texp (fresh-type-variables-for-list
+ (texp-types consequent*))
`(if ,(annotate-exp predicate env)
- ,(annotate-exp consequent env)
+ ,consequent*
,(annotate-exp alternate env))))
(define (annotate:let names exps body env)
@@ -1155,7 +1157,7 @@
(define (infer:list exps subs success)
(pk 'infer:list exps)
(match exps
- (() (success '()))
+ (() (success subs))
((exp . rest)
(infer exp
subs
@@ -1188,9 +1190,19 @@
(texp-types alternate)
sub4)
(lambda (sub5)
- (success
+ (define sub6
(compose-substitutions
- sub4 sub5)))))))))))))
+ sub4 sub5))
+ (unify (apply-substitutions-to-types
+ types
+ sub6)
+ (apply-substitutions-to-types
+ (texp-types consequent)
+ sub6)
+ (lambda (sub7)
+ (success
+ (compose-substitutions
+ sub6 sub7)))))))))))))))
(define (infer:lambda type body subs success)
(pk 'infer:lambda type body)