Skip to content

Commit

Permalink
apply bindings before returning unification mismatch error
Browse files Browse the repository at this point in the history
  • Loading branch information
byorgey committed Jun 22, 2024
1 parent 1cbc22e commit d54ddb4
Show file tree
Hide file tree
Showing 2 changed files with 24 additions and 3 deletions.
17 changes: 16 additions & 1 deletion src/swarm-lang/Swarm/Language/Typecheck.hs
Original file line number Diff line number Diff line change
Expand Up @@ -127,6 +127,19 @@ type Sourced a = (Source, a)

-- | A "join" where an expected thing meets an actual thing.
newtype Join a = Join (Source -> a)
deriving (Functor)

instance Foldable Join where
foldMap :: Monoid m => (a -> m) -> Join a -> m
foldMap f j = f a1 <> f a2
where
(a1, a2) = getJoin j

instance Traversable Join where
traverse :: Applicative f => (a -> f b) -> Join a -> f (Join b)
traverse f j = joined <$> f a1 <*> f a2
where
(a1, a2) = getJoin j

instance (Show a) => Show (Join a) where
show (getJoin -> (e, a)) = "(expected: " <> show e <> ", actual: " <> show a <> ")"
Expand Down Expand Up @@ -313,7 +326,9 @@ unify ::
unify ms j = do
res <- expected =:= actual
case res of
Left _ -> throwTypeErr NoLoc $ Mismatch ms j
Left _ -> do
j' <- traverse U.applyBindings j
throwTypeErr NoLoc $ Mismatch ms j'
Right ty -> return ty
where
(expected, actual) = getJoin j
Expand Down
10 changes: 8 additions & 2 deletions test/unit/TestLanguagePipeline.hs
Original file line number Diff line number Diff line change
Expand Up @@ -482,7 +482,7 @@ testLanguagePipeline =
"applying a pair"
( process
"(1,2) \"hi\""
"1:1: Type mismatch:\n From context, expected `(1, 2)` to be a function,\n but it is actually a pair"
"1:1: Type mismatch:\n From context, expected `(1, 2)` to be a function,\n but it actually has type `Int * Int`"
)
, testCase
"providing a pair as an argument"
Expand Down Expand Up @@ -520,6 +520,12 @@ testLanguagePipeline =
"1 + (\\x. \\y. 3)"
"1:5: Type mismatch:\n From context, expected `\\x. \\y. 3` to have type `Int`,\n but it is actually a function\n"
)
, testCase
"apply HOF to int - #1888"
( process
"(\\f. f 3) 2"
"1:11: Type mismatch:\n From context, expected `2` to have a type like `Int -> _`"
)
]
, testGroup
"generalize top-level binds #351 #1501"
Expand Down Expand Up @@ -644,7 +650,7 @@ testLanguagePipeline =
"def at non-cmd type"
( process
"def x = 3 end; x + 2"
"1:16: Type mismatch:\n From context, expected `x + 2` to have a type like"
"1:16: Type mismatch:\n From context, expected `x + 2` to be a command"
)
, testCase
"def at cmd type"
Expand Down

0 comments on commit d54ddb4

Please sign in to comment.