on master help sign in
Create a newtype for Marks so ranks and marks never get mixed up
34a253dEvan Czaplicki
src/Type/Solve.hs+3−3
@@ -64,7 +64,7 @@ generalize pool@(TS.Pool youngRank _) =
64 liftIO $ UF.setDescriptor var $ Descriptor (rigidify content) noRank mark copy
64 liftIO $ UF.setDescriptor var $ Descriptor (rigidify content) noRank mark copy
65
65
66
66
67−poolToRankTable :: Int -> TS.Pool -> IO (Vector.Vector [Variable])
67+poolToRankTable :: Mark -> TS.Pool -> IO (Vector.Vector [Variable])
68poolToRankTable youngMark (TS.Pool youngRank youngInhabitants) =
68poolToRankTable youngMark (TS.Pool youngRank youngInhabitants) =
69 do mutableTable <- MVector.replicate (youngRank + 1) []
69 do mutableTable <- MVector.replicate (youngRank + 1) []
70
70
@@ -94,7 +94,7 @@ rigidify content =
94-- Adjust variable ranks such that ranks never increase as you move deeper.
94-- Adjust variable ranks such that ranks never increase as you move deeper.
95-- This way the outermost rank is representative of the entire structure.
95-- This way the outermost rank is representative of the entire structure.
96--
96--
97−adjustRank :: Int -> Int -> Int -> Variable -> IO Int
97+adjustRank :: Mark -> Mark -> Int -> Variable -> IO Int
98adjustRank youngMark visitedMark groupRank var =
98adjustRank youngMark visitedMark groupRank var =
99 {-# SCC elm_compiler_type_adjust #-}
99 {-# SCC elm_compiler_type_adjust #-}
100 do (Descriptor content rank mark copy) <- UF.descriptor var
100 do (Descriptor content rank mark copy) <- UF.descriptor var
@@ -115,7 +115,7 @@ adjustRank youngMark visitedMark groupRank var =
115 return minRank
115 return minRank
116
116
117
117
118−adjustRankContent :: Int -> Int -> Int -> Content -> IO Int
118+adjustRankContent :: Mark -> Mark -> Int -> Content -> IO Int
119adjustRankContent youngMark visitedMark groupRank content =
119adjustRankContent youngMark visitedMark groupRank content =
120 let
120 let
121 go = adjustRank youngMark visitedMark groupRank
121 go = adjustRank youngMark visitedMark groupRank
src/Type/State.hs+5−5
@@ -30,7 +30,7 @@ import Data.Text (Text)
30import qualified Reporting.Annotation as A
30import qualified Reporting.Annotation as A
31import qualified Reporting.Error.Type as Error
31import qualified Reporting.Error.Type as Error
32import qualified Reporting.Region as R
32import qualified Reporting.Region as R
33−import Type.Type
33+import Type.Type as Type
34import qualified Type.UnionFind as UF
34import qualified Type.UnionFind as UF
35
35
36
36
@@ -58,7 +58,7 @@ initialState =
58 { sEnv = Map.empty
58 { sEnv = Map.empty
59 , sSavedEnv = Map.empty
59 , sSavedEnv = Map.empty
60 , sPool = Pool outermostRank []
60 , sPool = Pool outermostRank []
61− , sMark = noMark + 1 -- The mark must never be equal to noMark!
61+ , sMark = Type.nextMark noMark -- The mark must never be equal to noMark!
62 , sError = []
62 , sError = []
63 }
63 }
64
64
@@ -72,7 +72,7 @@ data State =
72 { sEnv :: Env
72 { sEnv :: Env
73 , sSavedEnv :: Env
73 , sSavedEnv :: Env
74 , sPool :: Pool
74 , sPool :: Pool
75− , sMark :: Int
75+ , sMark :: Mark
76 , sError :: [A.Located Error.Error]
76 , sError :: [A.Located Error.Error]
77 }
77 }
78
78
@@ -151,10 +151,10 @@ saveLocalEnv =
151
151
152
152
153{-# INLINE uniqueMark #-}
153{-# INLINE uniqueMark #-}
154−uniqueMark :: Solver Int
154+uniqueMark :: Solver Mark
155uniqueMark =
155uniqueMark =
156 Solver $ \(SS env savedEnv pool mark errors) ->
156 Solver $ \(SS env savedEnv pool mark errors) ->
157− return ( mark, SS env savedEnv pool (mark + 1) errors )
157+ return ( mark, SS env savedEnv pool (Type.nextMark mark) errors )
158
158
159
159
160{-# INLINE nextRankPool #-}
160{-# INLINE nextRankPool #-}
src/Type/Type.hs+23−10
@@ -10,8 +10,9 @@ module Type.Type
10 , Super(..)
10 , Super(..)
11 , noRank
11 , noRank
12 , outermostRank
12 , outermostRank
13+ , Mark
13 , noMark
14 , noMark
14− , initialMark
15+ , nextMark
15 , (==>), float, char, string, bool
16 , (==>), float, char, string, bool
16 , mkFlexVar
17 , mkFlexVar
17 , mkFlexNumber
18 , mkFlexNumber
@@ -28,6 +29,7 @@ import qualified Data.Map as Map
28import Data.Monoid ((<>))
29import Data.Monoid ((<>))
29import qualified Data.Text as Text
30import qualified Data.Text as Text
30import Data.Text (Text)
31import Data.Text (Text)
32+import Data.Word (Word32)
31
33
32import qualified AST.Type as T
34import qualified AST.Type as T
33import qualified AST.Variable as Var
35import qualified AST.Variable as Var
@@ -67,7 +69,7 @@ data Descriptor =
67 Descriptor
69 Descriptor
68 { _content :: Content
70 { _content :: Content
69 , _rank :: Int
71 , _rank :: Int
70− , _mark :: Int
72+ , _mark :: Mark
71 , _copy :: Maybe Variable
73 , _copy :: Maybe Variable
72 }
74 }
73
75
@@ -105,22 +107,33 @@ outermostRank :: Int
105outermostRank = 1
107outermostRank = 1
106
108
107
109
108−noMark :: Int
109−noMark = 2
110
110
111+-- MARKS
111
112
112−initialMark :: Int
113−initialMark = 3
114
113
114+newtype Mark = Mark Word32
115+ deriving (Eq, Ord)
115
116
117+
118+noMark :: Mark
119+noMark =
120+ Mark 2
121+
122+
116−occursMark :: Int
123+occursMark :: Mark
117occursMark =
124occursMark =
118− 1
125+ Mark 1
119
126
120
127
121−getVarNamesMark :: Int
128+getVarNamesMark :: Mark
122getVarNamesMark =
129getVarNamesMark =
123− 0
130+ Mark 0
131+
132+
133+{-# INLINE nextMark #-}
134+nextMark :: Mark -> Mark
135+nextMark (Mark mark) =
136+ Mark (mark + 1)
124
137
125
138
126
139