on master help sign in
Improve the error messages for bad rigid type variables
fbff9ceEvan Czaplicki
src/Reporting/Error/Type.hs+87−59
@@ -3,7 +3,7 @@
3module Reporting.Error.Type
3module Reporting.Error.Type
4 ( Error(..)
4 ( Error(..)
5 , Mismatch(..), Hint(..)
5 , Mismatch(..), Hint(..)
6− , Reason(..), VarType(..)
6+ , Reason(..), SpecificThing(..)
7 , Pattern(..)
7 , Pattern(..)
8 , toReport
8 , toReport
9 , flipReason
9 , flipReason
@@ -54,15 +54,17 @@ data Reason
54 | IntFloat
54 | IntFloat
55 | TooLongComparableTuple Int
55 | TooLongComparableTuple Int
56 | MissingArgs Int
56 | MissingArgs Int
57− | BadVar (Maybe VarType) (Maybe VarType)
57+ | RigidClash Text Text
58+ | NotPartOfSuper Type.Super
59+ | RigidVarTooGeneric Text SpecificThing
60+ | RigidSuperTooGeneric Type.Super Text SpecificThing
58
61
59
62
60−data VarType
63+data SpecificThing
61− = Number
64+ = SpecificSuper Type.Super
62− | Comparable
65+ | SpecificType Var.Canonical
63− | Appendable
66+ | SpecificFunction
64− | CompAppend
67+ | SpecificRecord
65− | Rigid (Maybe Text)
66
68
67
69
68data Hint
70data Hint
@@ -694,8 +696,17 @@ flipReason reason =
694 MissingArgs num ->
696 MissingArgs num ->
695 MissingArgs num
697 MissingArgs num
696
698
697− BadVar left right ->
699+ RigidClash a b ->
698− BadVar right left
700+ RigidClash b a
701+
702+ NotPartOfSuper super ->
703+ NotPartOfSuper super
704+
705+ RigidVarTooGeneric name specific ->
706+ RigidVarTooGeneric name specific
707+
708+ RigidSuperTooGeneric super name specific ->
709+ RigidSuperTooGeneric super name specific
699
710
700
711
701reasonToString :: Reason -> Maybe Doc
712reasonToString :: Reason -> Maybe Doc
@@ -776,73 +787,90 @@ reasonToStringHelp reason =
776 go $
787 go $
777 "It looks like a function needs " <> Help.moreArgs num <> "."
788 "It looks like a function needs " <> Help.moreArgs num <> "."
778
789
790+ RigidClash name1 name2 ->
791+ go $
792+ "Your type annotation uses `" <> name1 <> "` and `" <> name2 <>
793+ "` as DIFFERENT type variables. By using separate names, you are\
794+ \ claiming the values can be different, but the code suggests that\
795+ \ they must be the SAME based on how they are used. Maybe these two\
796+ \ type variables in your type annotation should just be one? Maybe\
797+ \ your code uses them in a weird way? More help at: "
798+ <> Help.hintLink "type-annotations"
799+
800+ NotPartOfSuper Type.Number ->
801+ go "Only ints and floats are numbers."
802+
779− BadVar (Just Comparable) _ ->
803+ NotPartOfSuper Type.Comparable ->
780 go "Only ints, floats, chars, strings, lists, and tuples are comparable."
804 go "Only ints, floats, chars, strings, lists, and tuples are comparable."
781
805
782− BadVar (Just Appendable) _ ->
806+ NotPartOfSuper Type.Appendable ->
783− go "Only strings, text, and lists are appendable."
807+ go "Only strings and lists are appendable."
784
808
785− BadVar (Just CompAppend) _ ->
809+ NotPartOfSuper Type.CompAppend ->
786 go "Only strings and lists are both comparable and appendable."
810 go "Only strings and lists are both comparable and appendable."
787
811
788− BadVar (Just (Rigid maybeLeftName)) (Just (Rigid maybeRightName)) ->
812+ RigidVarTooGeneric name specific ->
789− go $ doubleRigidError maybeLeftName maybeRightName
813+ go $ rigidTooGenericHelp "ANY type of value" name specific
790
814
791− BadVar (Just (Rigid maybeName)) _ ->
815+ RigidSuperTooGeneric Type.Number name specific ->
792− go $ singleRigidError maybeName
816+ go $ rigidTooGenericHelp "BOTH Ints and Floats" name specific
793
817
794− BadVar _ (Just (Rigid maybeName)) ->
818+ RigidSuperTooGeneric Type.Comparable name specific ->
795− go $ singleRigidError maybeName
819+ go $ rigidTooGenericHelp "ANY comparable value" name specific
796
820
797− BadVar _ _ ->
821+ RigidSuperTooGeneric Type.Appendable name specific ->
798− Nothing
822+ go $ rigidTooGenericHelp "BOTH Strings and Lists" name specific
799
823
824+ RigidSuperTooGeneric Type.CompAppend name specific ->
825+ go $ rigidTooGenericHelp "Strings and ANY comparable List" name specific
800
826
801−badFieldElaboration :: Text
802−badFieldElaboration =
803− "I always figure out field types in alphabetical order. If a field\
804− \ seems fine, I assume it is \"correct\" in subsequent checks.\
805− \ So the problem may actually be a weird interaction with previous fields."
806
827
828+rigidTooGenericHelp :: Text -> Text -> SpecificThing -> Text
829+rigidTooGenericHelp manyTypesOfValues name specific =
830+ "The type variable `" <> name <> "` in your type annotation suggests that"
831+ <> manyTypesOfValues <> " can flow through, but the code suggests that it must be "
832+ <> specificThingToText specific <> " based on how it is used. Maybe make your\
833+ \ type annotation more specific? Maybe the code has a problem? More help at: "
834+ <> Help.hintLink "type-annotations"
807
835
808−weirdRigidError :: Text
809−weirdRigidError =
810− "You are having a problem with \"rigid\" type variables. That usually\
811− \ means you have a type annotation that says it accepts anything, but\
812− \ in fact, it accepts a much more specific type. More info at: "
813− <> Help.hintLink "type-annotations" <>
814− ". This case is weird though, so please turn it into an <http://sscce.org>\
815− \ and report it to <https://github.com/elm-lang/error-message-catalog>."
816
836
837+specificThingToText :: SpecificThing -> Text
838+specificThingToText specific =
839+ case specific of
840+ SpecificSuper Type.Number ->
841+ "a number"
817
842
818−singleRigidError :: Maybe Text -> Text
843+ SpecificSuper Type.Comparable ->
819−singleRigidError maybeName =
844+ "comparable"
820− case maybeName of
821− Just name ->
822− "Your type annotation uses type variable `" <> name <>
823− "` which means any type of value can flow through. Your code is saying\
824− \ it CANNOT be anything though! Maybe change your type annotation to\
825− \ be more specific? Maybe the code has a problem? More at: "
826− <> Help.hintLink "type-annotations"
827
845
828− Nothing ->
846+ SpecificSuper Type.Appendable ->
829− weirdRigidError
847+ "appendable"
830
848
849+ SpecificSuper Type.CompAppend ->
850+ "comparable AND appendable"
831
851
832−doubleRigidError :: Maybe Text -> Maybe Text -> Text
852+ SpecificType var@(Var.Canonical _ name) ->
833−doubleRigidError maybeLeftName maybeRightName =
853+ if Var.isTuple var then
834− case (maybeLeftName, maybeRightName) of
854+ "a tuple"
835− (Just leftName, Just rightName) ->
836− "Your type annotation uses `" <> leftName <> "` and `" <> rightName <>
837− "` as separate type variables. Each one can be any type of value,\
838− \ but because they have separate names, there is no guarantee that they\
839− \ are equal to each other. Your code seems to be saying they ARE the\
840− \ same though! Maybe they should be the same in your type annotation?\
841− \ Maybe your code uses them in a weird way? More at: "
842− <> Help.hintLink "type-annotations"
843
855
844− _ ->
856+ else if Text.isInfixOf (Text.take 1 name) "AEIOU" then
845− weirdRigidError
857+ "an " <> name
858+
859+ else
860+ "a " <> name
861+
862+ SpecificRecord ->
863+ "a record"
864+
865+ SpecificFunction ->
866+ "a function"
867+
868+
869+badFieldElaboration :: Text
870+badFieldElaboration =
871+ "I always figure out field types in alphabetical order. If a field\
872+ \ seems fine, I assume it is \"correct\" in subsequent checks.\
873+ \ So the problem may actually be a weird interaction with previous fields."
846
874
847
875
848messyFieldsHelp :: [Text] -> [Text] -> [Text] -> Maybe (Text, [Doc])
876messyFieldsHelp :: [Text] -> [Text] -> [Text] -> Maybe (Text, [Doc])
src/Type/Constrain/Expression.hs+3−3
@@ -536,7 +536,7 @@ constrainAnnotatedDef
536 -> Info
536 -> Info
537 -> IO Info
537 -> IO Info
538constrainAnnotatedDef env defRegion region name expr tipe info =
538constrainAnnotatedDef env defRegion region name expr tipe info =
539− do (flexType, flexVars) <- Env.instantiateType Flex env tipe
539+ do (flexType, flexVars) <- Env.instantiateFlex env tipe
540
540
541 let scheme =
541 let scheme =
542 Scheme
542 Scheme
@@ -568,7 +568,7 @@ constrainAnnDefHelp :: C.Expr -> ST.Canonical -> ArgInfo -> IO Constraint
568constrainAnnDefHelp expr tipe (ArgInfo name defRegion env args vars) =
568constrainAnnDefHelp expr tipe (ArgInfo name defRegion env args vars) =
569 case (expr, tipe) of
569 case (expr, tipe) of
570 (A.A _ (C.Lambda arg result), ST.Lambda argType resultType) ->
570 (A.A _ (C.Lambda arg result), ST.Lambda argType resultType) ->
571− do (rigidArgType, newVars) <- Env.instantiateType Rigid env argType
571+ do (rigidArgType, newVars) <- Env.instantiateRigid env argType
572
572
573 constrainAnnDefHelp result resultType $
573 constrainAnnDefHelp result resultType $
574 ArgInfo
574 ArgInfo
@@ -580,7 +580,7 @@ constrainAnnDefHelp expr tipe (ArgInfo name defRegion env args vars) =
580 }
580 }
581
581
582 (A.A region _, _) ->
582 (A.A region _, _) ->
583− do (rigidType, newVars) <- Env.instantiateType Rigid env tipe
583+ do (rigidType, newVars) <- Env.instantiateRigid env tipe
584
584
585 let finalEnv = Env.addValues newVars env
585 let finalEnv = Env.addValues newVars env
586 let finalArgs = reverse args
586 let finalArgs = reverse args
src/Type/Environment.hs+23−16
@@ -6,7 +6,8 @@ module Type.Environment
6 , initialize
6 , initialize
7 , get, freshDataScheme, ctorNames
7 , get, freshDataScheme, ctorNames
8 , addValues
8 , addValues
9− , instantiateType
9+ , instantiateFlex
10+ , instantiateRigid
10 )
11 )
11 where
12 where
12
13
@@ -102,8 +103,8 @@ makeCtorsHelp constructorDict ( var, (rawTypeVars, ctors) ) =
102
103
103 go :: [T.Canonical] -> State.StateT VarDict IO ([Type], Type)
104 go :: [T.Canonical] -> State.StateT VarDict IO ([Type], Type)
104 go args =
105 go args =
105− do types <- mapM (instantiator Flex Map.empty) args
106+ do types <- mapM (instantiator nameToFlex Map.empty) args
106− returnType <- instantiator Flex Map.empty (T.Type var tvars)
107+ returnType <- instantiator nameToFlex Map.empty (T.Type var tvars)
107 return (types, returnType)
108 return (types, returnType)
108 in
109 in
109 List.foldl' inst constructorDict ctors
110 List.foldl' inst constructorDict ctors
@@ -142,25 +143,31 @@ addValues newValues env =
142-- INSTANTIATE TYPES
143-- INSTANTIATE TYPES
143
144
144
145
145−instantiateType :: Flex -> Env -> T.Canonical -> IO (Type, VarDict)
146+instantiateFlex :: Env -> T.Canonical -> IO (Type, VarDict)
146−instantiateType flex env sourceType =
147+instantiateFlex env sourceType =
147− State.runStateT (instantiator flex (_value env) sourceType) Map.empty
148+ State.runStateT (instantiator nameToFlex (_value env) sourceType) Map.empty
148
149
149
150
150−instantiator :: Flex -> Dict Type -> T.Canonical -> State.StateT VarDict IO Type
151+instantiateRigid :: Env -> T.Canonical -> IO (Type, VarDict)
151−instantiator flex values sourceType =
152+instantiateRigid env sourceType =
152− instantiatorHelp flex values Set.empty sourceType
153+ State.runStateT (instantiator nameToRigid (_value env) sourceType) Map.empty
153
154
154
155
156+instantiator :: (Text -> IO Variable) -> Dict Type -> T.Canonical -> State.StateT VarDict IO Type
157+instantiator nameToVar values sourceType =
158+ instantiatorHelp nameToVar values Set.empty sourceType
159+
160+
155−instantiatorHelp :: Flex -> Dict Type -> Set.Set Text -> T.Canonical -> State.StateT VarDict IO Type
161+instantiatorHelp :: (Text -> IO Variable) -> Dict Type -> Set.Set Text -> T.Canonical -> State.StateT VarDict IO Type
156−instantiatorHelp flex values aliasVars sourceType =
162+instantiatorHelp nameToVar values aliasVars sourceType =
163+ {-# SCC elm_compiler_type_instantiate #-}
157 let
164 let
158 go =
165 go =
159− instantiatorHelp flex values aliasVars
166+ instantiatorHelp nameToVar values aliasVars
160 in
167 in
161 case sourceType of
168 case sourceType of
162 T.Lambda t1 t2 ->
169 T.Lambda t1 t2 ->
163− (==>) <$> go t1 <*> go t2
170+ FunN <$> go t1 <*> go t2
164
171
165 T.Var name ->
172 T.Var name ->
166 if Set.member name aliasVars then
173 if Set.member name aliasVars then
@@ -178,7 +185,7 @@ instantiatorHelp flex values aliasVars sourceType =
178 return (VarN variable)
185 return (VarN variable)
179
186
180 Nothing ->
187 Nothing ->
181− do variable <- State.liftIO (mkNamedVar flex name)
188+ do variable <- State.liftIO (nameToVar name)
182 State.put (Map.insert name variable dict)
189 State.put (Map.insert name variable dict)
183 return (VarN variable)
190 return (VarN variable)
184
191
@@ -187,10 +194,10 @@ instantiatorHelp flex values aliasVars sourceType =
187 realType <-
194 realType <-
188 case aliasType of
195 case aliasType of
189 T.Filled tipe ->
196 T.Filled tipe ->
190− instantiatorHelp flex values Set.empty tipe
197+ instantiatorHelp nameToVar values Set.empty tipe
191
198
192 T.Holey tipe ->
199 T.Holey tipe ->
193− instantiatorHelp flex values (Set.fromList (map fst args)) tipe
200+ instantiatorHelp nameToVar values (Set.fromList (map fst args)) tipe
194
201
195 return (AliasN name targs realType)
202 return (AliasN name targs realType)
196
203
src/Type/Inference.hs+1−1
@@ -79,7 +79,7 @@ canonicalizeValues
79 -> IO [(Text, ([T.Variable], T.Type))]
79 -> IO [(Text, ([T.Variable], T.Type))]
80canonicalizeValues env (moduleName, iface) =
80canonicalizeValues env (moduleName, iface) =
81 forM (Map.toList (Module.iTypes iface)) $ \(name, tipe) ->
81 forM (Map.toList (Module.iTypes iface)) $ \(name, tipe) ->
82− do (flexType, flexVars) <- Env.instantiateType T.Flex env tipe
82+ do (flexType, flexVars) <- Env.instantiateFlex env tipe
83 return
83 return
84 ( ModuleName.canonicalToText moduleName <> "." <> name
84 ( ModuleName.canonicalToText moduleName <> "." <> name
85 , ( Map.elems flexVars
85 , ( Map.elems flexVars
src/Type/Occurs.hs+14−5
@@ -25,15 +25,17 @@ occursHelp seen var =
25 else
25 else
26 do (Descriptor content _ _ _) <- UF.descriptor var
26 do (Descriptor content _ _ _) <- UF.descriptor var
27 case content of
27 case content of
28− Var _ _ _ ->
28+ FlexVar _ ->
29 return False
29 return False
30
30
31− Error _ ->
31+ FlexSuper _ _ ->
32 return False
32 return False
33
33
34− Alias _ args _ ->
34+ RigidVar _ ->
35− -- TODO is it okay to only check args?
35+ return False
36− or <$> traverse (occursHelp (var:seen) . snd) args
36+
37+ RigidSuper _ _ ->
38+ return False
37
39
38 Structure term ->
40 Structure term ->
39 let
41 let
@@ -51,3 +53,10 @@ occursHelp seen var =
51
53
52 Record1 fields ext ->
54 Record1 fields ext ->
53 or <$> traverse go (ext : Map.elems fields)
55 or <$> traverse go (ext : Map.elems fields)
56+
57+ Alias _ args _ ->
58+ -- TODO is it okay to only check args?
59+ or <$> traverse (occursHelp (var:seen) . snd) args
60+
61+ Error _ ->
62+ return False
src/Type/Solve.hs+15−5
@@ -276,15 +276,17 @@ adjustRankContent youngMark visitMark groupRank content =
276 go = adjustRank youngMark visitMark groupRank
276 go = adjustRank youngMark visitMark groupRank
277 in
277 in
278 case content of
278 case content of
279− Error _ ->
279+ FlexVar _ ->
280 return groupRank
280 return groupRank
281
281
282− Var _ _ _ ->
282+ FlexSuper _ _ ->
283 return groupRank
283 return groupRank
284
284
285− Alias _ args _ ->
285+ RigidVar _ ->
286− -- THEORY: anything in the realVar would be outermostRank
286+ return groupRank
287− foldM (\rank (_, argVar) -> max rank <$> go argVar) outermostRank args
287+
288+ RigidSuper _ _ ->
289+ return groupRank
288
290
289 Structure flatType ->
291 Structure flatType ->
290 case flatType of
292 case flatType of
@@ -301,3 +303,11 @@ adjustRankContent youngMark visitMark groupRank content =
301 Record1 fields extension ->
303 Record1 fields extension ->
302 do extRank <- go extension
304 do extRank <- go extension
303 foldM (\rank field -> max rank <$> go field) extRank fields
305 foldM (\rank field -> max rank <$> go field) extRank fields
306+
307+ Alias _ args _ ->
308+ -- THEORY: anything in the realVar would be outermostRank
309+ foldM (\rank (_, argVar) -> max rank <$> go argVar) outermostRank args
310+
311+ Error _ ->
312+ return groupRank
313+
src/Type/State.hs+21−6
@@ -221,12 +221,18 @@ copyHelp maxRank pools variable =
221 do newTerm <- traverseFlatType (copyHelp maxRank pools) term
221 do newTerm <- traverseFlatType (copyHelp maxRank pools) term
222 UF.setDescriptor newVar $ mkCopyDesc (Structure newTerm)
222 UF.setDescriptor newVar $ mkCopyDesc (Structure newTerm)
223
223
224− Var Rigid maybeSuper maybeName ->
224+ FlexVar _ ->
225− UF.setDescriptor newVar $ mkCopyDesc $ Var Flex maybeSuper maybeName
225+ return ()
226
226
227− Var Flex _ _ ->
227+ FlexSuper _ _ ->
228 return ()
228 return ()
229
229
230+ RigidVar name ->
231+ UF.setDescriptor newVar $ mkCopyDesc $ FlexVar (Just name)
232+
233+ RigidSuper super name ->
234+ UF.setDescriptor newVar $ mkCopyDesc $ FlexSuper super (Just name)
235+
230 Alias name args realType ->
236 Alias name args realType ->
231 do newArgs <- mapM (traverse (copyHelp maxRank pools)) args
237 do newArgs <- mapM (traverse (copyHelp maxRank pools)) args
232 newRealType <- copyHelp maxRank pools realType
238 newRealType <- copyHelp maxRank pools realType
@@ -259,12 +265,21 @@ restore variable =
259restoreContent :: Content -> IO Content
265restoreContent :: Content -> IO Content
260restoreContent content =
266restoreContent content =
261 case content of
267 case content of
262− Structure term ->
268+ FlexVar _ ->
263− Structure <$> traverseFlatType restore term
269+ return content
264
270
265− Var _ _ _ ->
271+ FlexSuper _ _ ->
266 return content
272 return content
267
273
274+ RigidVar _ ->
275+ return content
276+
277+ RigidSuper _ _ ->
278+ return content
279+
280+ Structure term ->
281+ Structure <$> traverseFlatType restore term
282+
268 Alias name args var ->
283 Alias name args var ->
269 Alias name
284 Alias name
270 <$> mapM (traverse restore) args
285 <$> mapM (traverse restore) args
src/Type/Type.hs+135−92
@@ -6,7 +6,6 @@ module Type.Type
6 , Type(..)
6 , Type(..)
7 , Descriptor(Descriptor)
7 , Descriptor(Descriptor)
8 , Content(..)
8 , Content(..)
9− , Flex(..)
10 , noRank
9 , noRank
11 , outermostRank
10 , outermostRank
12 , Mark
11 , Mark
@@ -15,12 +14,14 @@ module Type.Type
15 , (==>), float, char, string, bool
14 , (==>), float, char, string, bool
16 , mkFlexVar
15 , mkFlexVar
17 , mkFlexNumber
16 , mkFlexNumber
18− , mkNamedVar
17+ , unnamedFlexVar
18+ , unnamedFlexSuper
19+ , nameToFlex
20+ , nameToRigid
19 , toSrcType
21 , toSrcType
20 )
22 )
21 where
23 where
22
24
23−import Control.Monad (when)
24import Control.Monad.State.Strict (StateT, liftIO)
25import Control.Monad.State.Strict (StateT, liftIO)
25import qualified Control.Monad.State.Strict as State
26import qualified Control.Monad.State.Strict as State
26import qualified Data.Char as Char
27import qualified Data.Char as Char
@@ -74,8 +75,11 @@ data Descriptor =
74
75
75
76
76data Content
77data Content
78+ = FlexVar (Maybe Text)
79+ | FlexSuper T.Super (Maybe Text)
80+ | RigidVar Text
81+ | RigidSuper T.Super Text
77− = Structure FlatType
82+ | Structure FlatType
78− | Var Flex (Maybe T.Super) (Maybe Text)
79 | Alias Var.Canonical [(Text,Variable)] Variable
83 | Alias Var.Canonical [(Text,Variable)] Variable
80 | Error Text
84 | Error Text
81
85
@@ -85,21 +89,18 @@ makeDescriptor content =
85 Descriptor content noRank noMark Nothing
89 Descriptor content noRank noMark Nothing
86
90
87
91
88−data Flex
89− = Rigid
90− | Flex
91−
92−
93
92
94-- RANKS
93-- RANKS
95
94
96
95
97noRank :: Int
96noRank :: Int
98−noRank = 0
97+noRank =
98+ 0
99
99
100
100
101outermostRank :: Int
101outermostRank :: Int
102−outermostRank = 1
102+outermostRank =
103+ 1
103
104
104
105
105
106
@@ -183,11 +184,10 @@ flexVarDescriptor =
183 makeDescriptor unnamedFlexVar
184 makeDescriptor unnamedFlexVar
184
185
185
186
186−
187{-# NOINLINE unnamedFlexVar #-}
187{-# NOINLINE unnamedFlexVar #-}
188unnamedFlexVar :: Content
188unnamedFlexVar :: Content
189unnamedFlexVar =
189unnamedFlexVar =
190− Var Flex Nothing Nothing
190+ FlexVar Nothing
191
191
192
192
193
193
@@ -207,16 +207,23 @@ flexNumberDescriptor =
207
207
208unnamedFlexSuper :: T.Super -> Content
208unnamedFlexSuper :: T.Super -> Content
209unnamedFlexSuper super =
209unnamedFlexSuper super =
210− Var Flex (Just super) Nothing
210+ FlexSuper super Nothing
211+
211
212
212
213
214+-- MAKE NAMED VARIABLES
213
215
214−-- MAKE NAMED FLEX VARIABLES
215
216
217+nameToFlex :: Text -> IO Variable
218+nameToFlex name =
219+ UF.fresh $ makeDescriptor $
220+ maybe FlexVar FlexSuper (toSuper name) (Just name)
216
221
222+
217−mkNamedVar :: Flex -> Text -> IO Variable
223+nameToRigid :: Text -> IO Variable
218−mkNamedVar flex name =
224+nameToRigid name =
219− UF.fresh $ makeDescriptor $ Var flex (toSuper name) (Just name)
225+ UF.fresh $ makeDescriptor $
226+ maybe RigidVar RigidSuper (toSuper name) name
220
227
221
228
222toSuper :: Text -> Maybe T.Super
229toSuper :: Text -> Maybe T.Super
@@ -270,14 +277,31 @@ contentToSrcType variable content =
270 Structure term ->
277 Structure term ->
271 termToSrcType term
278 termToSrcType term
272
279
273− Var _ _ (Just name) ->
280+ FlexVar maybeName ->
281+ case maybeName of
282+ Just name ->
283+ return (T.Var name)
284+
285+ Nothing ->
286+ do name <- getFreshVarName
287+ liftIO $ UF.modifyDescriptor variable (\desc -> desc { _content = FlexVar (Just name) })
288+ return (T.Var name)
289+
290+ FlexSuper super maybeName ->
291+ case maybeName of
292+ Just name ->
293+ return (T.Var name)
294+
295+ Nothing ->
296+ do name <- getFreshSuperName super
297+ liftIO $ UF.modifyDescriptor variable (\desc -> desc { _content = FlexSuper super (Just name) })
298+ return (T.Var name)
299+
300+ RigidVar name ->
274 return (T.Var name)
301 return (T.Var name)
275
302
276− Var flex maybeSuper Nothing ->
303+ RigidSuper _ name ->
277− do freshName <- getFreshName maybeSuper
278− liftIO $ UF.modifyDescriptor variable $ \desc ->
279− desc { _content = Var flex maybeSuper (Just freshName) }
280− return (T.Var freshName)
304+ return (T.Var name)
281
305
282 Alias name args realVariable ->
306 Alias name args realVariable ->
283 do srcArgs <- traverse (traverse variableToSrcType) args
307 do srcArgs <- traverse (traverse variableToSrcType) args
@@ -340,27 +364,29 @@ makeNameState taken =
340 NameState taken 0 0 0 0 0
364 NameState taken 0 0 0 0 0
341
365
342
366
343−getFreshName :: (Monad m) => Maybe T.Super -> StateT NameState m Text
367+getFreshVarName :: (Monad m) => StateT NameState m Text
344−getFreshName maybeSuper =
368+getFreshVarName =
345− case maybeSuper of
346− Nothing ->
347− do index <- State.gets _normals
369+ do index <- State.gets _normals
348− taken <- State.gets _taken
370+ taken <- State.gets _taken
349− let (uniqueName, newIndex) = getFreshNormal index taken
371+ let (uniqueName, newIndex) = getFreshNormal index taken
350− State.modify (\state -> state { _normals = newIndex })
372+ State.modify (\state -> state { _normals = newIndex })
351− return uniqueName
373+ return uniqueName
374+
352
375
376+getFreshSuperName :: (Monad m) => T.Super -> StateT NameState m Text
377+getFreshSuperName super =
378+ case super of
353− Just T.Number ->
379+ T.Number ->
354− getFreshSuper "number" _numbers (\index state -> state { _numbers = index })
380+ getFreshSuper "number" _numbers (\index state -> state { _numbers = index })
355
381
356− Just T.Comparable ->
382+ T.Comparable ->
357− getFreshSuper "comparable" _comparables (\index state -> state { _comparables = index })
383+ getFreshSuper "comparable" _comparables (\index state -> state { _comparables = index })
358
384
359− Just T.Appendable ->
385+ T.Appendable ->
360− getFreshSuper "appendable" _appendables (\index state -> state { _appendables = index })
386+ getFreshSuper "appendable" _appendables (\index state -> state { _appendables = index })
361
387
362− Just T.CompAppend ->
388+ T.CompAppend ->
363− getFreshSuper "compappend" _compAppends (\index state -> state { _compAppends = index })
389+ getFreshSuper "compappend" _compAppends (\index state -> state { _compAppends = index })
364
390
365
391
366getFreshNormal :: Int -> TakenNames -> (Text, Int)
392getFreshNormal :: Int -> TakenNames -> (Text, Int)
@@ -415,70 +441,87 @@ getFreshSuperHelp name index taken =
415
441
416getVarNames :: Variable -> StateT TakenNames IO ()
442getVarNames :: Variable -> StateT TakenNames IO ()
417getVarNames var =
443getVarNames var =
418− do desc <- liftIO $ UF.descriptor var
444+ do (Descriptor content rank mark copy) <- liftIO $ UF.descriptor var
419− case _mark desc == getVarNamesMark of
445+ if mark == getVarNamesMark then return () else
420− True ->
446+ do liftIO $ UF.setDescriptor var (Descriptor content rank getVarNamesMark copy)
447+ case content of
448+ Error _ ->
449+ return ()
450+
451+ FlexVar maybeName ->
452+ case maybeName of
453+ Nothing ->
421− return ()
454+ return ()
422
455
423− False ->
456+ Just name ->
424− do liftIO $ UF.setDescriptor var (desc { _mark = getVarNamesMark })
457+ registerName name var (FlexVar . Just)
425− case _content desc of
426− Error _ ->
427− return ()
428
458
429− Var _ _ Nothing ->
459+ FlexSuper super maybeName ->
460+ case maybeName of
461+ Nothing ->
430− return ()
462+ return ()
431
463
432− Var flex maybeSuper (Just name) ->
464+ Just name ->
433− do oldTaken <- State.get
465+ registerName name var (FlexSuper super . Just)
434− newTaken <- liftIO $ addVarName 0 name var flex maybeSuper oldTaken
435− State.put newTaken
436
466
437− Alias _ args realVar ->
467+ RigidVar name ->
438− do mapM_ (getVarNames . snd) args
468+ registerName name var RigidVar
439− getVarNames realVar
440
469
441− Structure (App1 _ args) ->
470+ RigidSuper super name ->
442− mapM_ getVarNames args
471+ registerName name var (RigidSuper super)
443
472
444− Structure (Fun1 arg body) ->
473+ Alias _ args realVar ->
445− do getVarNames arg
474+ do mapM_ (getVarNames . snd) args
446− getVarNames body
475+ getVarNames realVar
447
476
448− Structure EmptyRecord1 ->
477+ Structure (App1 _ args) ->
449− return ()
478+ mapM_ getVarNames args
450
479
451− Structure (Record1 fields extension) ->
480+ Structure (Fun1 arg body) ->
452− do mapM_ getVarNames fields
481+ do getVarNames arg
453− getVarNames extension
482+ getVarNames body
454
483
484+ Structure EmptyRecord1 ->
485+ return ()
455
486
487+ Structure (Record1 fields extension) ->
488+ do mapM_ getVarNames fields
489+ getVarNames extension
490+
491+
492+
493+-- REGISTER NAME / RENAME DUPLICATES
494+
495+
496+registerName :: Text -> Variable -> (Text -> Content) -> StateT TakenNames IO ()
497+registerName givenName var makeContent =
498+ if Text.null givenName then
499+ return ()
500+ else
501+ do takenNames <- State.get
502+ State.put =<< liftIO (checkName 0 givenName var makeContent takenNames)
503+
504+
456−addVarName :: Int -> Text -> Variable -> Flex -> Maybe T.Super -> TakenNames -> IO TakenNames
505+checkName :: Int -> Text -> Variable -> (Text -> Content) -> TakenNames -> IO TakenNames
457−addVarName index givenName var flex maybeSuper taken =
506+checkName index givenName var makeContent takenNames =
458 let
507 let
459− name =
508+ indexedName =
509+ if index <= 0 then
510+ givenName
511+ else if Char.isDigit (Text.last givenName) then
460− makeIndexedName givenName index
512+ givenName <> Text.pack ('_' : show index)
513+ else
514+ givenName <> Text.pack (show index)
461 in
515 in
462− case Map.lookup name taken of
516+ case Map.lookup indexedName takenNames of
463 Nothing ->
517 Nothing ->
518+ do if indexedName == givenName then return () else
464− do when (name /= givenName) $ UF.modifyDescriptor var $ \desc ->
519+ UF.modifyDescriptor var $ \(Descriptor _ rank mark copy) ->
465− desc { _content = Var flex maybeSuper (Just name) }
520+ Descriptor (makeContent indexedName) rank mark copy
466− return $ Map.insert name var taken
521+ return $ Map.insert indexedName var takenNames
467
522
468 Just otherVar ->
523 Just otherVar ->
469 do same <- UF.equivalent var otherVar
524 do same <- UF.equivalent var otherVar
470 if same
525 if same
471− then return taken
526+ then return takenNames
472− else addVarName (index + 1) givenName var flex maybeSuper taken
527+ else checkName (index + 1) givenName var makeContent takenNames
473−
474−
475−makeIndexedName :: Text -> Int -> Text
476−makeIndexedName name index =
477− if index <= 0 then
478− name
479−
480− else if Char.isDigit (Text.last name) then
481− name <> Text.pack ('_' : show index)
482−
483− else
484− name <> Text.pack (show index)
src/Type/Unify.hs+153−140
@@ -125,42 +125,6 @@ reasonToProblem orientation maybeReason =
125 Special (Error.flipReason reason)
125 Special (Error.flipReason reason)
126
126
127
127
128−badRigid :: Maybe Text -> Error.Reason
129−badRigid maybeName =
130− Error.BadVar (Just (Error.Rigid maybeName)) Nothing
131−
132−
133−badSuper :: Super -> Error.Reason
134−badSuper super =
135− Error.BadVar (Just (errorSuper super)) Nothing
136−
137−
138−badSupers :: Super -> Super -> Error.Reason
139−badSupers super1 super2 =
140− Error.BadVar (Just (errorSuper super1)) (Just (errorSuper super2))
141−
142−
143−doubleBad :: Error.VarType -> Error.VarType -> Error.Reason
144−doubleBad vt1 vt2 =
145− Error.BadVar (Just vt1) (Just vt2)
146−
147−
148−errorSuper :: Super -> Error.VarType
149−errorSuper super =
150− case super of
151− Number ->
152− Error.Number
153−
154− Comparable ->
155− Error.Comparable
156−
157− Appendable ->
158− Error.Appendable
159−
160− CompAppend ->
161− Error.CompAppend
162−
163−
164
128
165-- MERGE
129-- MERGE
166
130
@@ -210,25 +174,28 @@ subUnify context var1 var2 =
210actuallyUnify :: Context -> Unify ()
174actuallyUnify :: Context -> Unify ()
211actuallyUnify context@(Context _ _ (Descriptor firstContent _ _ _) _ (Descriptor secondContent _ _ _)) =
175actuallyUnify context@(Context _ _ (Descriptor firstContent _ _ _) _ (Descriptor secondContent _ _ _)) =
212 case firstContent of
176 case firstContent of
213− Error _ ->
177+ FlexVar _ ->
214− -- If there was an error, just pretend it is okay. This lets us avoid
215− -- "cascading" errors where one problem manifests as multiple message.
216− return ()
217−
218− Var Flex Nothing _ ->
219 unifyFlex context secondContent
178 unifyFlex context secondContent
220
179
221− Var Flex (Just super) _ ->
180+ FlexSuper super _ ->
222 unifyFlexSuper context super firstContent secondContent
181 unifyFlexSuper context super firstContent secondContent
223
182
224− Var Rigid maybeSuper maybeName ->
183+ RigidVar name ->
184+ unifyRigid context Nothing name firstContent secondContent
185+
186+ RigidSuper super name ->
225− unifyRigid context maybeSuper maybeName firstContent secondContent
187+ unifyRigid context (Just super) name firstContent secondContent
226
188
227 Alias name args realVar ->
189 Alias name args realVar ->
228 unifyAlias context name args realVar secondContent
190 unifyAlias context name args realVar secondContent
229
191
230− Structure term ->
192+ Structure flatType ->
231− unifyStructure context term firstContent secondContent
193+ unifyStructure context flatType firstContent secondContent
194+
195+ Error _ ->
196+ -- If there was an error, just pretend it is okay. This lets us avoid
197+ -- "cascading" errors where one problem manifests as multiple message.
198+ return ()
232
199
233
200
234
201
@@ -241,10 +208,18 @@ unifyFlex context otherContent =
241 Error _ ->
208 Error _ ->
242 return ()
209 return ()
243
210
244− Var Flex _ _ ->
211+ -- TODO see if wildcarding makes a noticable perf difference
212+
213+ FlexVar _ ->
214+ merge context otherContent
215+
216+ FlexSuper _ _ ->
217+ merge context otherContent
218+
219+ RigidVar _ ->
245 merge context otherContent
220 merge context otherContent
246
221
247− Var Rigid _ _ ->
222+ RigidSuper _ _ ->
248 merge context otherContent
223 merge context otherContent
249
224
250 Alias _ _ _ ->
225 Alias _ _ _ ->
@@ -258,35 +233,61 @@ unifyFlex context otherContent =
258-- UNIFY RIGID VARIABLES
233-- UNIFY RIGID VARIABLES
259
234
260
235
261−unifyRigid :: Context -> Maybe Super -> Maybe Text -> Content -> Content -> Unify ()
236+unifyRigid :: Context -> Maybe Super -> Text -> Content -> Content -> Unify ()
262−unifyRigid context maybeSuper maybeName content otherContent =
237+unifyRigid context maybeSuper name content otherContent =
263 case otherContent of
238 case otherContent of
264− Error _ ->
239+ FlexVar _ ->
265− return ()
240+ merge context content
266
241
267− Var Flex otherMaybeSuper _ ->
242+ FlexSuper otherSuper _ ->
268− case (maybeSuper, otherMaybeSuper) of
243+ case maybeSuper of
269− (_, Nothing) ->
244+ Just super ->
245+ if combineRigidSupers super otherSuper then
270 merge context content
246 merge context content
247+ else
248+ mismatch context $ Just $
249+ Error.RigidSuperTooGeneric super name $ Error.SpecificSuper otherSuper
271
250
272− (Nothing, Just _) ->
251+ Nothing ->
273− mismatch context (Just (badRigid maybeName))
252+ mismatch context $ Just $
253+ Error.RigidVarTooGeneric name $ Error.SpecificSuper otherSuper
274
254
275− (Just super, Just otherSuper) ->
255+ RigidVar otherName ->
276− if combineRigidSupers super otherSuper then
277− merge context content
278− else
279− mismatch context (Just (badRigid maybeName))
256+ mismatch context $ Just $
257+ Error.RigidClash name otherName
280
258
281− Var Rigid _ otherMaybeName ->
259+ RigidSuper _ otherName ->
282 mismatch context $ Just $
260 mismatch context $ Just $
283− doubleBad (Error.Rigid maybeName) (Error.Rigid otherMaybeName)
261+ Error.RigidClash name otherName
284
262
285− Alias _ _ _ ->
263+ Alias otherName _ _ ->
286− mismatch context (Just (badRigid maybeName))
264+ mismatch context $ Just $
265+ maybe Error.RigidVarTooGeneric Error.RigidSuperTooGeneric maybeSuper name $
266+ Error.SpecificType otherName
287
267
288− Structure _ ->
268+ Structure flatType ->
289− mismatch context (Just (badRigid maybeName))
269+ mismatch context $ Just $
270+ maybe Error.RigidVarTooGeneric Error.RigidSuperTooGeneric maybeSuper name $
271+ flatTypeToSpecificThing flatType
272+
273+ Error _ ->
274+ return ()
275+
276+
277+flatTypeToSpecificThing :: FlatType -> Error.SpecificThing
278+flatTypeToSpecificThing flatType =
279+ case flatType of
280+ App1 name _ ->
281+ Error.SpecificType name
282+
283+ Fun1 _ _ ->
284+ Error.SpecificFunction
285+
286+ EmptyRecord1 ->
287+ Error.SpecificRecord
288+
289+ Record1 _ _ ->
290+ Error.SpecificRecord
290
291
291
292
292
293
@@ -296,49 +297,51 @@ unifyRigid context maybeSuper maybeName content otherContent =
296unifyFlexSuper :: Context -> Super -> Content -> Content -> Unify ()
297unifyFlexSuper :: Context -> Super -> Content -> Content -> Unify ()
297unifyFlexSuper context super content otherContent =
298unifyFlexSuper context super content otherContent =
298 case otherContent of
299 case otherContent of
299− Structure term ->
300+ Structure flatType ->
300− unifyFlexSuperStructure context super term
301+ unifyFlexSuperStructure context super flatType
301
302
302− Var Rigid Nothing maybeName ->
303+ RigidVar name ->
303− mismatch context (Just (doubleBad (errorSuper super) (Error.Rigid maybeName)))
304+ mismatch context $ Just $
305+ Error.RigidVarTooGeneric name (Error.SpecificSuper super)
304
306
305− Var Rigid (Just otherSuper) maybeName ->
307+ RigidSuper otherSuper name ->
306 if combineRigidSupers otherSuper super then
308 if combineRigidSupers otherSuper super then
307 merge context otherContent
309 merge context otherContent
308 else
310 else
309− mismatch context $ Just $ badRigid maybeName
311+ mismatch context $ Just $
312+ Error.RigidSuperTooGeneric otherSuper name (Error.SpecificSuper super)
310
313
311− Var Flex Nothing _ ->
314+ FlexVar _ ->
312 merge context content
315 merge context content
313
316
314− Var Flex (Just otherSuper) _ ->
317+ FlexSuper otherSuper _ ->
315 case super of
318 case super of
316 Number ->
319 Number ->
317 case otherSuper of
320 case otherSuper of
318 Number -> merge context content
321 Number -> merge context content
319 Comparable -> merge context content
322 Comparable -> merge context content
320− _ -> mismatch context $ Just $ badSupers super otherSuper
323+ _ -> mismatch context Nothing -- Error.NumberAppendableClash
321
324
322 Comparable ->
325 Comparable ->
323 case otherSuper of
326 case otherSuper of
324 Comparable -> merge context otherContent
327 Comparable -> merge context otherContent
325 Number -> merge context otherContent
328 Number -> merge context otherContent
326− Appendable -> merge context (Var Flex (Just CompAppend) Nothing)
329+ Appendable -> merge context (Type.unnamedFlexSuper CompAppend)
327 CompAppend -> merge context otherContent
330 CompAppend -> merge context otherContent
328
331
329 Appendable ->
332 Appendable ->
330 case otherSuper of
333 case otherSuper of
331 Appendable -> merge context otherContent
334 Appendable -> merge context otherContent
332− Comparable -> merge context (Var Flex (Just CompAppend) Nothing)
335+ Comparable -> merge context (Type.unnamedFlexSuper CompAppend)
333 CompAppend -> merge context otherContent
336 CompAppend -> merge context otherContent
334− Number -> mismatch context $ Just $ badSupers super otherSuper
337+ Number -> mismatch context Nothing -- Error.NumberAppendableClash
335
338
336 CompAppend ->
339 CompAppend ->
337 case otherSuper of
340 case otherSuper of
338 Comparable -> merge context content
341 Comparable -> merge context content
339 Appendable -> merge context content
342 Appendable -> merge context content
340 CompAppend -> merge context content
343 CompAppend -> merge context content
341− Number -> mismatch context $ Just $ badSupers super otherSuper
344+ Number -> mismatch context Nothing -- Error.NumberAppendableClash
342
345
343 Alias _ _ realVar ->
346 Alias _ _ realVar ->
344 subUnify context (_first context) realVar
347 subUnify context (_first context) realVar
@@ -371,54 +374,54 @@ atomMatchesSuper super name =
371
374
372
375
373unifyFlexSuperStructure :: Context -> Super -> FlatType -> Unify ()
376unifyFlexSuperStructure :: Context -> Super -> FlatType -> Unify ()
374−unifyFlexSuperStructure context super term =
377+unifyFlexSuperStructure context super flatType =
375− do case term of
378+ case flatType of
376− App1 name [] ->
379+ App1 name [] ->
377− if atomMatchesSuper super name then
380+ if atomMatchesSuper super name then
378− merge context (Structure term)
381+ merge context (Structure flatType)
379− else
382+ else
380− mismatch context (Just (badSuper super))
383+ mismatch context $ Just $ Error.NotPartOfSuper super
381−
384+
382− App1 name [variable] | name == Var.list ->
385+ App1 name [variable] | name == Var.list ->
383− case super of
386+ case super of
384− Number ->
387+ Number ->
385− mismatch context (Just (badSuper super))
388+ mismatch context $ Just $ Error.NotPartOfSuper super
386−
387− Appendable ->
388− merge context (Structure term)
389−
390− Comparable ->
391− do comparableOccursCheck context
392− merge context (Structure term)
393− unifyComparableRecursive (_orientation context) variable
394
389
395− CompAppend ->
390+ Appendable ->
396− do comparableOccursCheck context
397− merge context (Structure term)
391+ merge context (Structure flatType)
398− unifyComparableRecursive (_orientation context) variable
399
392
400− App1 name args | Var.isTuple name ->
393+ Comparable ->
401− case super of
394+ do comparableOccursCheck context
402− Number ->
395+ merge context (Structure flatType)
403− mismatch context (Just (badSuper super))
396+ unifyComparableRecursive (_orientation context) variable
404
397
405− Appendable ->
398+ CompAppend ->
406− mismatch context (Just (badSuper super))
399+ do comparableOccursCheck context
400+ merge context (Structure flatType)
401+ unifyComparableRecursive (_orientation context) variable
407
402
408− Comparable ->
403+ App1 name args | Var.isTuple name ->
409− if length args > 6 then
404+ case super of
405+ Number ->
410− mismatch context (Just (Error.TooLongComparableTuple (length args)))
406+ mismatch context $ Just $ Error.NotPartOfSuper super
411
407
412− else
408+ Appendable ->
413− do comparableOccursCheck context
409+ mismatch context $ Just $ Error.NotPartOfSuper super
414− merge context (Structure term)
415− mapM_ (unifyComparableRecursive (_orientation context)) args
416
410
417− CompAppend ->
411+ Comparable ->
412+ if length args > 6 then
418− mismatch context (Just (badSuper super))
413+ mismatch context (Just (Error.TooLongComparableTuple (length args)))
419
414
415+ else
416+ do comparableOccursCheck context
417+ merge context (Structure flatType)
418+ mapM_ (unifyComparableRecursive (_orientation context)) args
419+
420+ CompAppend ->
421+ mismatch context $ Just $ Error.NotPartOfSuper super
422+
420− _ ->
423+ _ ->
421− mismatch context (Just (badSuper super))
424+ mismatch context $ Just $ Error.NotPartOfSuper super
422
425
423
426
424-- TODO: is there some way to avoid doing this?
427-- TODO: is there some way to avoid doing this?
@@ -435,7 +438,7 @@ unifyComparableRecursive :: Orientation -> Variable -> Unify ()
435unifyComparableRecursive orientation var =
438unifyComparableRecursive orientation var =
436 do compVar <- liftIO $
439 do compVar <- liftIO $
437 do (Descriptor _ rank _ _) <- UF.descriptor var
440 do (Descriptor _ rank _ _) <- UF.descriptor var
438− UF.fresh $ Descriptor (Var Flex (Just Comparable) Nothing) rank noMark Nothing
441+ UF.fresh $ Descriptor (Type.unnamedFlexSuper Comparable) rank noMark Nothing
439
442
440 lift $ TS.register compVar
443 lift $ TS.register compVar
441
444
@@ -465,13 +468,16 @@ collectArgsHelp revArgs variable =
465unifyAlias :: Context -> Var.Canonical -> [(Text, Variable)] -> Variable -> Content -> Unify ()
468unifyAlias :: Context -> Var.Canonical -> [(Text, Variable)] -> Variable -> Content -> Unify ()
466unifyAlias context name args realVar otherContent =
469unifyAlias context name args realVar otherContent =
467 case otherContent of
470 case otherContent of
468− Error _ ->
471+ FlexVar _ ->
469− return ()
470−
471− Var Flex Nothing _ ->
472 merge context (Alias name args realVar)
472 merge context (Alias name args realVar)
473
473
474− Var _ _ _ ->
474+ FlexSuper _ _ ->
475+ subUnify context realVar (_second context)
476+
477+ RigidVar _ ->
478+ subUnify context realVar (_second context)
479+
480+ RigidSuper _ _ ->
475 subUnify context realVar (_second context)
481 subUnify context realVar (_second context)
476
482
477 Alias otherName otherArgs otherRealVar ->
483 Alias otherName otherArgs otherRealVar ->
@@ -485,31 +491,34 @@ unifyAlias context name args realVar otherContent =
485 Structure _ ->
491 Structure _ ->
486 subUnify context realVar (_second context)
492 subUnify context realVar (_second context)
487
493
494+ Error _ ->
495+ return ()
496+
488
497
489
498
490-- UNIFY STRUCTURES
499-- UNIFY STRUCTURES
491
500
492
501
493unifyStructure :: Context -> FlatType -> Content -> Content -> Unify ()
502unifyStructure :: Context -> FlatType -> Content -> Content -> Unify ()
494−unifyStructure context term content otherContent =
503+unifyStructure context flatType content otherContent =
495 case otherContent of
504 case otherContent of
496− Error _ ->
505+ FlexVar _ ->
497− return ()
498−
499− Var Flex Nothing _ ->
500 merge context content
506 merge context content
501
507
502− Var Flex (Just super) _ ->
508+ FlexSuper super _ ->
503− unifyFlexSuperStructure (reorient context) super term
509+ unifyFlexSuperStructure (reorient context) super flatType
504
510
505− Var Rigid _ maybeName ->
511+ RigidVar name ->
506− mismatch context (Just (Error.flipReason (badRigid maybeName)))
512+ mismatch context $ Just $ Error.RigidVarTooGeneric name (flatTypeToSpecificThing flatType)
513+
514+ RigidSuper super name ->
515+ mismatch context $ Just $ Error.RigidSuperTooGeneric super name (flatTypeToSpecificThing flatType)
507
516
508 Alias _ _ realVar ->
517 Alias _ _ realVar ->
509 subUnify context (_first context) realVar
518 subUnify context (_first context) realVar
510
519
511 Structure otherTerm ->
520 Structure otherTerm ->
512− case (term, otherTerm) of
521+ case (flatType, otherTerm) of
513 (App1 name args, App1 otherName otherArgs) ->
522 (App1 name args, App1 otherName otherArgs) ->
514 if name == otherName then
523 if name == otherName then
515 do zipWithM_ (subUnify context) args otherArgs
524 do zipWithM_ (subUnify context) args otherArgs
@@ -543,6 +552,10 @@ unifyStructure context term content otherContent =
543 _ ->
552 _ ->
544 mismatch context Nothing
553 mismatch context Nothing
545
554
555+ Error _ ->
556+ return ()
557+
558+
546
559
547isIntFloat :: Var.Canonical -> Var.Canonical -> Bool
560isIntFloat :: Var.Canonical -> Var.Canonical -> Bool
548isIntFloat name otherName =
561isIntFloat name otherName =
@@ -595,7 +608,7 @@ unifyRecord context firstStructure secondStructure =
595
608
596 (Extension, False, Extension, False) ->
609 (Extension, False, Extension, False) ->
597 do let subFields = Map.union uniqueExpFields uniqueActFields
610 do let subFields = Map.union uniqueExpFields uniqueActFields
598− subExt <- fresh context (Var Flex Nothing Nothing)
611+ subExt <- fresh context Type.unnamedFlexVar
599 expRecord <- fresh context (Structure (Record1 uniqueActFields subExt))
612 expRecord <- fresh context (Structure (Record1 uniqueActFields subExt))
600 actRecord <- fresh context (Structure (Record1 uniqueExpFields subExt))
613 actRecord <- fresh context (Structure (Record1 uniqueExpFields subExt))
601 subUnify context expVar expRecord
614 subUnify context expVar expRecord