diff options
| author | David Thompson <dthompson2@worcester.edu> | 2023-01-22 22:03:12 -0500 |
|---|---|---|
| committer | David Thompson <dthompson2@worcester.edu> | 2023-06-08 08:14:41 -0400 |
| commit | b87d547edd69eb37a825eb608fd9747a59b54f12 (patch) | |
| tree | 704fa88310038a9ffdf18f457bb260d403950864 | |
| parent | c2715c445a44aa1f2936cef3445c70016fc1b08f (diff) | |
Fix more inference bugs.
| -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) |