diff options
| -rw-r--r-- | chickadee/graphics/seagull.scm | 22 |
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) |