fix: Update inference fix

madlib-lang · Jun 2, 2023 · 13b77c5 · 13b77c5
1 parent 2cbf214
commit 13b77c5
Show file tree

Hide file tree

Showing 3 changed files with 30 additions and 4 deletions.
diff --git a/.snapshots/should_resolve_ambiguity_with_type_annotations/golden b/.snapshots/should_resolve_ambiguity_with_type_annotations/golden
@@ -47,7 +47,12 @@
                               (Area (Loc 153 11 1) (Loc 153 11 1))
                               "_")
                            [ Typed
-                               ([] :=> TCon (TC "Integer" Star) "prelude")
+                               ([ IsIn
+                                    "Read"
+                                    [ TCon (TC "Integer" Star) "prelude" ]
+                                    (Just (Area (Loc 131 10 4) (Loc 135 10 8)))
+                                ] :=>
+                                  TCon (TC "Integer" Star) "prelude")
                                (Area (Loc 131 10 4) (Loc 151 10 24))
                                (TypedExp
                                   (Typed

diff --git a/compiler/main/Infer/Exp.hs b/compiler/main/Infer/Exp.hs
@@ -903,7 +903,8 @@ inferImplicitlyTyped options isLet env exp@(Can.Canonical area _) = do
   let env'' = apply s env'''
 
   s' <- contextualUnify env'' exp (apply s tv) t
-  let s'' = s `compose` s1 `compose` s'
+  -- let s'' = s `compose` s1 `compose` s'
+  let s'' = s' `compose` s
       envWithVarsExcluded = env''
         { envVars = M.filterWithKey (\k _ -> fromMaybe "" (Can.getExpName exp) /= k) $ envVars env'' }
 
@@ -961,12 +962,12 @@ inferImplicitlyTyped options isLet env exp@(Can.Canonical area _) = do
 
   let sc =
         if isLet && not (Slv.isNamedAbs e) then
-          quantify [] (apply sFinal $ (rs'' ++ mutPS) :=> t')
+          apply sFinal $ quantify [] ((rs'' ++ mutPS) :=> t')
         else
           -- TODO: consider if the apply sFinal should not happen before quantifying
           -- because right now we might miss the defaulted types in the generated
           -- scheme
-          quantify gs (apply sFinal $ (rs'' ++ mutPS) :=> t')
+          apply sFinal $ quantify gs ((rs'' ++ mutPS) :=> t')
 
   when (not isLet && not (null mutPS) && not (null (ftv t')) && not (Slv.isNamedAbs e)) $ do
     throwError $ CompilationError MutationRestriction (Context (envCurrentPath env) area)

diff --git a/compiler/test/Infer/SolveSpec.hs b/compiler/test/Infer/SolveSpec.hs
@@ -692,6 +692,26 @@ spec = do
           actual = unsafePerformIO $ inferModule code
       snapshotTest "correctly infer various record transformations" actual
 
+    it "correctly infer recursive calls that aren't in tail position" $ do
+      let code = unlines
+            [" stuff = () => {"
+            , "  run = () => {"
+            , "    where(\"\") {"
+            , "      \"continue\" =>"
+            , "        {}"
+            , ""
+            , "      _ => do {"
+            , "        run()"
+            , "      }"
+            , "    }"
+            , "  }"
+            , ""
+            , "  run()"
+            , "}"
+            ]
+          actual = unsafePerformIO $ inferModuleWithoutMain code
+      snapshotTest "correctly infer recursive calls that aren't in tail position" actual
+
     it "should infer complex where expressions with records" $ do
       let code = unlines
             [ "export alias ComparisonResult = Integer"