git.iko.soy/elk
on master help sign in
Merge pull request #1108 from elm-lang/fix-comparable-appendable-unification

Fix #880, unify comparable and appendable types

commit5a1caab9edd49f600c48d59b4db96322a3eb9a79 authorEvan Czaplicki <info@elm-lang.org> dateTue 13 Oct 2015, 16:50 (11 years ago) parent822e1648aec074
2 files changed+41−15
compare with master
unifiedsplit
src/AST/Variable.hs+22−7 src/Type/Unify.hs+19−8
src/AST/Variable.hs+22−7
@@ -115,6 +115,11 @@ isSignal =
115115 is ["Signal"] "Signal"
116116
117117
118+isText :: Canonical -> Bool
119+isText =
120+ is ["Text"] "Text"
121+
122+
118123isList :: Canonical -> Bool
119124isList v =
120125 v == Canonical BuiltIn "List"
@@ -137,19 +142,29 @@ isPrimitive v =
137142
138143
139144isPrim :: String -> Canonical -> Bool
140−isPrim prim v =
141− case v of
142− Canonical BuiltIn name -> name == prim
143− _ -> False
145+isPrim prim (Canonical home name) =
146+ case home of
147+ BuiltIn ->
148+ name == prim
144149
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
145162
146−isText :: Canonical -> Bool
147−isText =
148− is ["Text"] "Text"
149163
150164
151165-- VARIABLE TO STRING
152166
167+
153168class ToString a where
154169 toString :: a -> String
155170
src/Type/Unify.hs+19−8
@@ -170,7 +170,20 @@ actuallyUnify variable1 variable2 = do
170170 cmpVars <- liftIO $ forM [1..length vs] $ \_ -> variable (Is Comparable)
171171 zipWithM_ unifyHelp vs cmpVars
172172
173− unifyAppendable varSuper varFlex =
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+
186+ unifyAppendableStructure varSuper varFlex =
174187 do struct <- liftIO $ collectApps varFlex
175188 case struct of
176189 List _ -> flexAndUnify varSuper
@@ -190,18 +203,16 @@ actuallyUnify variable1 variable2 = do
190203 (Is Number, _, _, Just name) -> unifyNumber variable1 name
191204 (_, Is Number, Just name, _) -> unifyNumber variable2 name
192205
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+
193211 (Is Comparable, _, _, Just name) -> unifyComparable variable1 name
194212 (_, Is Comparable, Just name, _) -> unifyComparable variable2 name
195213 (Is Comparable, _, _, _) -> unifyComparableStructure variable1 variable2
196214 (_, Is Comparable, _, _) -> unifyComparableStructure variable2 variable1
197215
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−
205216 (Rigid, _, _, _) -> rigidError variable1
206217 (_, Rigid, _, _) -> rigidError variable2
207218 _ -> typeError variable1 variable2 Nothing