From b87d547edd69eb37a825eb608fd9747a59b54f12 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sun, 22 Jan 2023 22:03:12 -0500
Subject: Fix more inference bugs.

---
 chickadee/graphics/seagull.scm | 22 +++++++++++++++++-----
 1 file 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)
-- 
cgit v1.2.3