git.iko.soy/elk
on master help sign in
Update unification for new union-find algorithm
56b0e37Evan Czaplicki
src/Type/Unify.hs+15−16
compare with master
unifiedsplit
@@ -7,13 +7,13 @@ import Control.Monad.Except (ExceptT, lift, liftIO, throwError, runExceptT)
7import qualified Data.Map as Map
7import qualified Data.Map as Map
8import qualified Data.Maybe as Maybe
8import qualified Data.Maybe as Maybe
9import Data.Text (Text)
9import Data.Text (Text)
10−import qualified Data.UnionFind.IO as UF
11
10
12import qualified AST.Variable as Var
11import qualified AST.Variable as Var
13import qualified Reporting.Region as R
12import qualified Reporting.Region as R
14import qualified Reporting.Error.Type as Error
13import qualified Reporting.Error.Type as Error
15import qualified Type.State as TS
14import qualified Type.State as TS
16import Type.Type as Type
15import Type.Type as Type
16+import qualified Type.UnionFind as UF
17
17
18
18
19
19
@@ -33,7 +33,7 @@ unify hint region expected actual =
33 mkError =
33 mkError =
34 do expectedSrcType <- Type.toSrcType expected
34 do expectedSrcType <- Type.toSrcType expected
35 actualSrcType <- Type.toSrcType actual
35 actualSrcType <- Type.toSrcType actual
36− mergeHelp expected actual Error
36+ mergeHelp expected actual Error noRank
37 let info = Error.MismatchInfo hint expectedSrcType actualSrcType maybeReason
37 let info = Error.MismatchInfo hint expectedSrcType actualSrcType maybeReason
38 return (Error.Mismatch info)
38 return (Error.Mismatch info)
39 in
39 in
@@ -147,20 +147,19 @@ errorSuper super =
147
147
148
148
149merge :: Context -> Content -> Unify ()
149merge :: Context -> Content -> Unify ()
150−merge (Context _ first _ second _) content =
150+merge (Context _ var1 (Descriptor _ rank1 _ _) var2 (Descriptor _ rank2 _ _)) content =
151− liftIO $ mergeHelp first second content
151+ liftIO $ mergeHelp var1 var2 content (min rank1 rank2)
152
152
153
153
154−mergeHelp :: Variable -> Variable -> Content -> IO ()
154+mergeHelp :: Variable -> Variable -> Content -> Int -> IO ()
155−mergeHelp first second content =
155+mergeHelp var1 second newContent newRank =
156− UF.union' first second $ \desc1 desc2 ->
156+ UF.union var1 second $
157− return $
158− Descriptor
157+ Descriptor
159− { _content = content
158+ { _content = newContent
160− , _rank = min (_rank desc1) (_rank desc2)
159+ , _rank = newRank
161− , _mark = noMark
160+ , _mark = noMark
162− , _copy = Nothing
161+ , _copy = Nothing
163− }
162+ }
164
163
165
164
166fresh :: Context -> Content -> Unify Variable
165fresh :: Context -> Content -> Unify Variable
@@ -383,7 +382,7 @@ atomMatchesSuper super name =
383 Var.isPrim "String" name
382 Var.isPrim "String" name
384
383
385
384
386−unifyFlexSuperStructure :: Context -> Super -> Term1 Variable -> Unify ()
385+unifyFlexSuperStructure :: Context -> Super -> FlatType -> Unify ()
387unifyFlexSuperStructure context super term =
386unifyFlexSuperStructure context super term =
388 do appStructure <- liftIO (collectApps (Structure term))
387 do appStructure <- liftIO (collectApps (Structure term))
389 case appStructure of
388 case appStructure of
@@ -571,7 +570,7 @@ unifyAlias context name args realVar otherContent =
571-- UNIFY STRUCTURES
570-- UNIFY STRUCTURES
572
571
573
572
574−unifyStructure :: Context -> Term1 Variable -> Content -> Content -> Unify ()
573+unifyStructure :: Context -> FlatType -> Content -> Content -> Unify ()
575unifyStructure context term content otherContent =
574unifyStructure context term content otherContent =
576 case otherContent of
575 case otherContent of
577 Error ->
576 Error ->