git.iko.soy/elk
on master help sign in
Avoid allocation when unifying two flex supers
60f4e71Evan Czaplicki
src/Type/Unify.hs+41−47
compare with master
unifiedsplit
@@ -115,6 +115,11 @@ badSuper super =
115 Error.BadVar (Just (errorSuper super)) Nothing
115 Error.BadVar (Just (errorSuper super)) Nothing
116
116
117
117
118+badSupers :: Super -> Super -> Error.Reason
119+badSupers super1 super2 =
120+ Error.BadVar (Just (errorSuper super1)) (Just (errorSuper super2))
121+
122+
118doubleBad :: Error.VarType -> Error.VarType -> Error.Reason
123doubleBad :: Error.VarType -> Error.VarType -> Error.Reason
119doubleBad vt1 vt2 =
124doubleBad vt1 vt2 =
120 Error.BadVar (Just vt1) (Just vt2)
125 Error.BadVar (Just vt1) (Just vt2)
@@ -206,7 +211,7 @@ actuallyUnify context@(Context _ _ firstDesc _ secondDesc) =
206 unifyFlex context secondContent
211 unifyFlex context secondContent
207
212
208 Var Flex (Just super) _ ->
213 Var Flex (Just super) _ ->
209− unifyFlexSuper context super secondContent
214+ unifyFlexSuper context super firstContent secondContent
210
215
211 Var Rigid maybeSuper maybeName ->
216 Var Rigid maybeSuper maybeName ->
212 unifyRigid context maybeSuper maybeName firstContent secondContent
217 unifyRigid context maybeSuper maybeName firstContent secondContent
@@ -218,7 +223,7 @@ actuallyUnify context@(Context _ _ firstDesc _ secondDesc) =
218 unifyAlias context name args realVar secondContent
223 unifyAlias context name args realVar secondContent
219
224
220 Structure term ->
225 Structure term ->
221− unifyStructure context term secondContent
226+ unifyStructure context term firstContent secondContent
222
227
223
228
224
229
@@ -289,8 +294,8 @@ unifyRigid context maybeSuper maybeName content otherContent =
289-- UNIFY SUPER VARIABLES
294-- UNIFY SUPER VARIABLES
290
295
291
296
292−unifyFlexSuper :: Context -> Super -> Content -> Unify ()
297+unifyFlexSuper :: Context -> Super -> Content -> Content -> Unify ()
293−unifyFlexSuper context super otherContent =
298+unifyFlexSuper context super content otherContent =
294 case otherContent of
299 case otherContent of
295 Structure term ->
300 Structure term ->
296 unifyFlexSuperStructure context super term
301 unifyFlexSuperStructure context super term
@@ -311,16 +316,36 @@ unifyFlexSuper context super otherContent =
311 mismatch context $ Just $ badRigid maybeName
316 mismatch context $ Just $ badRigid maybeName
312
317
313 Var Flex Nothing _ ->
318 Var Flex Nothing _ ->
314− merge context (Var Flex (Just super) Nothing)
319+ merge context content
315
320
316 Var Flex (Just otherSuper) _ ->
321 Var Flex (Just otherSuper) _ ->
317− case combineFlexSupers super otherSuper of
322+ case super of
318− Just newSuper ->
323+ Number ->
324+ case otherSuper of
325+ Number -> merge context content
326+ Comparable -> merge context content
327+ _ -> mismatch context $ Just $ badSupers super otherSuper
328+
329+ Comparable ->
330+ case otherSuper of
331+ Comparable -> merge context otherContent
332+ Number -> merge context otherContent
319− merge context (Var Flex (Just newSuper) Nothing)
333+ Appendable -> merge context (Var Flex (Just CompAppend) Nothing)
320−
334+ CompAppend -> merge context otherContent
321− Nothing ->
335+
336+ Appendable ->
337+ case otherSuper of
338+ Appendable -> merge context otherContent
339+ Comparable -> merge context (Var Flex (Just CompAppend) Nothing)
340+ CompAppend -> merge context otherContent
322− mismatch context $ Just $
341+ Number -> mismatch context $ Just $ badSupers super otherSuper
323− doubleBad (errorSuper super) (errorSuper otherSuper)
342+
343+ CompAppend ->
344+ case otherSuper of
345+ Comparable -> merge context content
346+ Appendable -> merge context content
347+ CompAppend -> merge context content
348+ Number -> mismatch context $ Just $ badSupers super otherSuper
324
349
325 Alias _ _ realVar ->
350 Alias _ _ realVar ->
326 subUnify context (_first context) realVar
351 subUnify context (_first context) realVar
@@ -329,37 +354,6 @@ unifyFlexSuper context super otherContent =
329 return ()
354 return ()
330
355
331
356
332−combineFlexSupers :: Super -> Super -> Maybe Super
333−combineFlexSupers firstSuper secondSuper =
334− case firstSuper of
335− Number ->
336− case secondSuper of
337− Number -> Just firstSuper
338− Comparable -> Just firstSuper
339− _ -> Nothing
340−
341− Comparable ->
342− case secondSuper of
343− Comparable -> Just secondSuper
344− Number -> Just secondSuper
345− Appendable -> Just CompAppend
346− CompAppend -> Just secondSuper
347−
348− Appendable ->
349− case secondSuper of
350− Comparable -> Just CompAppend
351− Appendable -> Just secondSuper
352− CompAppend -> Just secondSuper
353− Number -> Nothing
354−
355− CompAppend ->
356− case secondSuper of
357− Comparable -> Just firstSuper
358− Appendable -> Just firstSuper
359− CompAppend -> Just firstSuper
360− Number -> Nothing
361−
362−
363combineRigidSupers :: Super -> Super -> Bool
357combineRigidSupers :: Super -> Super -> Bool
364combineRigidSupers rigid flex =
358combineRigidSupers rigid flex =
365 rigid == flex
359 rigid == flex
@@ -576,17 +570,17 @@ unifyAlias context name args realVar otherContent =
576-- UNIFY STRUCTURES
570-- UNIFY STRUCTURES
577
571
578
572
579−unifyStructure :: Context -> Term1 Variable -> Content -> Unify ()
573+unifyStructure :: Context -> Term1 Variable -> Content -> Content -> Unify ()
580−unifyStructure context term otherContent =
574+unifyStructure context term content otherContent =
581 case otherContent of
575 case otherContent of
582 Error ->
576 Error ->
583 return ()
577 return ()
584
578
585 Var Flex Nothing _ ->
579 Var Flex Nothing _ ->
586− merge context (Structure term)
580+ merge context content
587
581
588 Var Flex (Just super) _ ->
582 Var Flex (Just super) _ ->
589− unifyFlexSuper (reorient context) super (Structure term)
583+ unifyFlexSuper (reorient context) super otherContent content
590
584
591 Var Rigid _ maybeName ->
585 Var Rigid _ maybeName ->
592 mismatch context (Just (Error.flipReason (badRigid maybeName)))
586 mismatch context (Just (Error.flipReason (badRigid maybeName)))