git.iko.soy/elk
on master help sign in
Merge pull request #1108 from elm-lang/fix-comparable-appendable-unification
5a1caabEvan Czaplicki
src/AST/Variable.hs+22−7
compare with master
unifiedsplit
@@ -115,6 +115,11 @@ isSignal =
115 is ["Signal"] "Signal"
115 is ["Signal"] "Signal"
116
116
117
117
118+isText :: Canonical -> Bool
119+isText =
120+ is ["Text"] "Text"
121+
122+
118isList :: Canonical -> Bool
123isList :: Canonical -> Bool
119isList v =
124isList v =
120 v == Canonical BuiltIn "List"
125 v == Canonical BuiltIn "List"
@@ -137,19 +142,29 @@ isPrimitive v =
137
142
138
143
139isPrim :: String -> Canonical -> Bool
144isPrim :: String -> Canonical -> Bool
140−isPrim prim v =
145+isPrim prim (Canonical home name) =
141− case v of
146+ case home of
147+ BuiltIn ->
142− Canonical BuiltIn name -> name == prim
148+ name == prim
143− _ -> False
144
149
150+ _ ->
151+ False
152+
153+
154+isLocal :: (String -> Bool) -> Canonical -> Bool
155+isLocal check (Canonical home name) =
156+ case home of
157+ Local ->
158+ check name
159+
160+ _ ->
161+ False
145
162
146−isText :: Canonical -> Bool
147−isText =
148− is ["Text"] "Text"
149
163
150
164
151-- VARIABLE TO STRING
165-- VARIABLE TO STRING
152
166
167+
153class ToString a where
168class ToString a where
154 toString :: a -> String
169 toString :: a -> String
155
170
src/Type/Unify.hs+19−8
@@ -170,7 +170,20 @@ actuallyUnify variable1 variable2 = do
170 cmpVars <- liftIO $ forM [1..length vs] $ \_ -> variable (Is Comparable)
170 cmpVars <- liftIO $ forM [1..length vs] $ \_ -> variable (Is Comparable)
171 zipWithM_ unifyHelp vs cmpVars
171 zipWithM_ unifyHelp vs cmpVars
172
172
173+ unifyAppendable v cvar@(Var.Canonical home name) =
174+ let
175+ canUnify =
176+ Var.isPrim "String" cvar
177+ || Var.isText cvar
178+ || Var.isLocal (List.isPrefixOf "comparable") cvar
179+ || Var.isLocal (List.isPrefixOf "appendable") cvar
180+ in
181+ if canUnify then
182+ flexAndUnify v
183+ else
184+ appendableError
185+
173− unifyAppendable varSuper varFlex =
186+ unifyAppendableStructure varSuper varFlex =
174 do struct <- liftIO $ collectApps varFlex
187 do struct <- liftIO $ collectApps varFlex
175 case struct of
188 case struct of
176 List _ -> flexAndUnify varSuper
189 List _ -> flexAndUnify varSuper
@@ -190,18 +203,16 @@ actuallyUnify variable1 variable2 = do
190 (Is Number, _, _, Just name) -> unifyNumber variable1 name
203 (Is Number, _, _, Just name) -> unifyNumber variable1 name
191 (_, Is Number, Just name, _) -> unifyNumber variable2 name
204 (_, Is Number, Just name, _) -> unifyNumber variable2 name
192
205
206+ (Is Appendable, _, _, Just name) -> unifyAppendable variable1 name
207+ (_, Is Appendable, Just name, _) -> unifyAppendable variable2 name
208+ (Is Appendable, _, _, _) -> unifyAppendableStructure variable1 variable2
209+ (_, Is Appendable, _, _) -> unifyAppendableStructure variable2 variable1
210+
193 (Is Comparable, _, _, Just name) -> unifyComparable variable1 name
211 (Is Comparable, _, _, Just name) -> unifyComparable variable1 name
194 (_, Is Comparable, Just name, _) -> unifyComparable variable2 name
212 (_, Is Comparable, Just name, _) -> unifyComparable variable2 name
195 (Is Comparable, _, _, _) -> unifyComparableStructure variable1 variable2
213 (Is Comparable, _, _, _) -> unifyComparableStructure variable1 variable2
196 (_, Is Comparable, _, _) -> unifyComparableStructure variable2 variable1
214 (_, Is Comparable, _, _) -> unifyComparableStructure variable2 variable1
197
215
198− (Is Appendable, _, _, Just name)
199− | Var.isText name || Var.isPrim "String" name -> flexAndUnify variable1
200− (_, Is Appendable, Just name, _)
201− | Var.isText name || Var.isPrim "String" name -> flexAndUnify variable2
202− (Is Appendable, _, _, _) -> unifyAppendable variable1 variable2
203− (_, Is Appendable, _, _) -> unifyAppendable variable2 variable1
204−
205 (Rigid, _, _, _) -> rigidError variable1
216 (Rigid, _, _, _) -> rigidError variable1
206 (_, Rigid, _, _) -> rigidError variable2
217 (_, Rigid, _, _) -> rigidError variable2
207 _ -> typeError variable1 variable2 Nothing
218 _ -> typeError variable1 variable2 Nothing