git.iko.soy/elk
on master help sign in
Fix bugs when unifying rigid constraints
5fe9bb9Evan Czaplicki
src/Type/Unify.hs+24−21
compare with master
unifiedsplit
@@ -193,9 +193,10 @@ subUnify context var1 var2 =
193actuallyUnify :: Context -> Unify ()
193actuallyUnify :: Context -> Unify ()
194actuallyUnify context@(Context _ _ firstDesc _ secondDesc) =
194actuallyUnify context@(Context _ _ firstDesc _ secondDesc) =
195 let
195 let
196+ firstContent = _content firstDesc
196 secondContent = _content secondDesc
197 secondContent = _content secondDesc
197 in
198 in
198− case _content firstDesc of
199+ case firstContent of
199 Error ->
200 Error ->
200 -- If there was an error, just pretend it is okay. This lets us avoid
201 -- If there was an error, just pretend it is okay. This lets us avoid
201 -- "cascading" errors where one problem manifests as multiple message.
202 -- "cascading" errors where one problem manifests as multiple message.
@@ -208,7 +209,7 @@ actuallyUnify context@(Context _ _ firstDesc _ secondDesc) =
208 unifySuper context super secondContent
209 unifySuper context super secondContent
209
210
210 Var Rigid maybeSuper maybeName ->
211 Var Rigid maybeSuper maybeName ->
211− unifyRigid context maybeSuper maybeName secondContent
212+ unifyRigid context maybeSuper maybeName firstContent secondContent
212
213
213 Atom name ->
214 Atom name ->
214 unifyAtom context name secondContent
215 unifyAtom context name secondContent
@@ -250,8 +251,8 @@ unifyFlex context otherContent =
250-- UNIFY RIGID VARIABLES
251-- UNIFY RIGID VARIABLES
251
252
252
253
253−unifyRigid :: Context -> Maybe Super -> Maybe Text -> Content -> Unify ()
254+unifyRigid :: Context -> Maybe Super -> Maybe Text -> Content -> Content -> Unify ()
254−unifyRigid context maybeSuper maybeName otherContent =
255+unifyRigid context maybeSuper maybeName content otherContent =
255 case otherContent of
256 case otherContent of
256 Error ->
257 Error ->
257 return ()
258 return ()
@@ -259,18 +260,16 @@ unifyRigid context maybeSuper maybeName otherContent =
259 Var Flex otherMaybeSuper _ ->
260 Var Flex otherMaybeSuper _ ->
260 case (maybeSuper, otherMaybeSuper) of
261 case (maybeSuper, otherMaybeSuper) of
261 (_, Nothing) ->
262 (_, Nothing) ->
262− merge context (Var Rigid maybeSuper maybeName)
263+ merge context content
263
264
264 (Nothing, Just _) ->
265 (Nothing, Just _) ->
265 mismatch context (Just (badRigid maybeName))
266 mismatch context (Just (badRigid maybeName))
266
267
267 (Just super, Just otherSuper) ->
268 (Just super, Just otherSuper) ->
268− case combineSupers super otherSuper of
269+ if combineRigidSupers super otherSuper then
269− Right newSuper | newSuper == otherSuper ->
270− merge context otherContent
270+ merge context content
271−
271+ else
272− _ ->
273− mismatch context (Just (badRigid maybeName))
272+ mismatch context (Just (badRigid maybeName))
274
273
275 Var Rigid _ otherMaybeName ->
274 Var Rigid _ otherMaybeName ->
276 mismatch context $ Just $
275 mismatch context $ Just $
@@ -306,19 +305,16 @@ unifySuper context super otherContent =
306 mismatch context (Just (doubleBad (errorSuper super) (Error.Rigid maybeName)))
305 mismatch context (Just (doubleBad (errorSuper super) (Error.Rigid maybeName)))
307
306
308 Var Rigid (Just otherSuper) maybeName ->
307 Var Rigid (Just otherSuper) maybeName ->
309− case combineSupers super otherSuper of
308+ if combineRigidSupers otherSuper super then
310− Right newSuper | newSuper == super ->
311− merge context otherContent
309+ merge context otherContent
312−
310+ else
313− _ ->
314− mismatch context $ Just $
311+ mismatch context $ Just $ badRigid maybeName
315− doubleBad (errorSuper super) (Error.Rigid maybeName)
316
312
317 Var Flex Nothing _ ->
313 Var Flex Nothing _ ->
318 merge context (Var Flex (Just super) Nothing)
314 merge context (Var Flex (Just super) Nothing)
319
315
320 Var Flex (Just otherSuper) _ ->
316 Var Flex (Just otherSuper) _ ->
321− case combineSupers super otherSuper of
317+ case combineFlexSupers super otherSuper of
322 Left reason ->
318 Left reason ->
323 mismatch context (Just reason)
319 mismatch context (Just reason)
324
320
@@ -332,8 +328,8 @@ unifySuper context super otherContent =
332 return ()
328 return ()
333
329
334
330
335−combineSupers :: Super -> Super -> Either Error.Reason Super
331+combineFlexSupers :: Super -> Super -> Either Error.Reason Super
336−combineSupers firstSuper secondSuper =
332+combineFlexSupers firstSuper secondSuper =
337 case (firstSuper, secondSuper) of
333 case (firstSuper, secondSuper) of
338 (Number , Number ) -> Right Number
334 (Number , Number ) -> Right Number
339 (Comparable, Number ) -> Right Number
335 (Comparable, Number ) -> Right Number
@@ -355,6 +351,13 @@ combineSupers firstSuper secondSuper =
355 Left $ doubleBad (errorSuper firstSuper) (errorSuper secondSuper)
351 Left $ doubleBad (errorSuper firstSuper) (errorSuper secondSuper)
356
352
357
353
354+combineRigidSupers :: Super -> Super -> Bool
355+combineRigidSupers rigid flex =
356+ rigid == flex
357+ || (rigid == Number && flex == Comparable)
358+ || (rigid == CompAppend && (flex == Comparable || flex == Appendable))
359+
360+
358isPrimitiveFrom :: [Text] -> Var.Canonical -> Bool
361isPrimitiveFrom :: [Text] -> Var.Canonical -> Bool
359isPrimitiveFrom prims var =
362isPrimitiveFrom prims var =
360 any (\p -> Var.isPrim p var) prims
363 any (\p -> Var.isPrim p var) prims