diff --git a/src/swarm-lang/Swarm/Language/Typecheck.hs b/src/swarm-lang/Swarm/Language/Typecheck.hs index d3dfeb555..e732e518b 100644 --- a/src/swarm-lang/Swarm/Language/Typecheck.hs +++ b/src/swarm-lang/Swarm/Language/Typecheck.hs @@ -257,15 +257,14 @@ lookup loc x = do addLocToTypeErr :: ( Has (Throw ContextualTypeErr) sig m , Has (Catch ContextualTypeErr) sig m - , Has (Reader TCStack) sig m ) => SrcLoc -> m a -> m a addLocToTypeErr l m = m `catchError` \case - CTE NoLoc _ te -> throwTypeErr l te - te -> throwError te + CTE NoLoc stk te -> throwError $ CTE l stk te + cte -> throwError cte ------------------------------------------------------------ -- Dealing with variables: free variables, fresh variables, @@ -895,7 +894,7 @@ infer s@(CSyntax l t cs) = addLocToTypeErr l $ case t of -- each time. SApp f x -> do -- Infer the type of the left-hand side and make sure it has a function type. - (f',argTy,resTy) <- withFrame l (TCAppL x) $ do + (f', argTy, resTy) <- withFrame l (TCAppL x) $ do f' <- infer f (argTy, resTy) <- decomposeFunTy f (Actual, f' ^. sType) pure (f', argTy, resTy) diff --git a/test/unit/TestLanguagePipeline.hs b/test/unit/TestLanguagePipeline.hs index 3c2d15a33..03a6b6704 100644 --- a/test/unit/TestLanguagePipeline.hs +++ b/test/unit/TestLanguagePipeline.hs @@ -668,19 +668,28 @@ testLanguagePipeline = "1:1: Undefined type U" ) ] - , testCase - "Stop printing context after a definition. - #1336" - ( processCompare - (==) - "move; def x = move; say 3 end; move;" - "1:25: Type mismatch:\n From context, expected `3` to have type `Text`,\n but it actually has type `Int`\n\n - While checking the argument to a function: say _\n - While checking the definition of x" - ) - , testCase - "Error inside function application + argument #2220" - ( process - "id 3 3" - "1:1: Unbound variable id\n\n - While checking a function applied to an argument: _ 3\n - While checking a function applied to an argument: _ 3" - ) + , testGroup + "typechecking context stack" + [ testCase + "Stop printing context after a definition. - #1336" + ( processCompare + (==) + "move; def x = move; say 3 end; move;" + "1:25: Type mismatch:\n From context, expected `3` to have type `Text`,\n but it actually has type `Int`\n\n - While checking the argument to a function: say _\n - While checking the definition of x" + ) + , testCase + "Error inside function application + argument #2220" + ( process + "id 3 3" + "1:1: Unbound variable id\n\n - While checking a function applied to an argument: _ 3\n - While checking a function applied to an argument: _ 3" + ) + , testCase + "Error inside function application + argument #2220" + ( process + "(\\x. x) 7 8" + "1:1: Type mismatch:\n From context, expected `(\\x. x) 7` to be a function,\n but it actually has type `Int`\n\n - While checking a function applied to an argument: _ 8" + ) + ] , testGroup "let and def types" [ testCase