git.iko.soy/elk
on master help sign in
Begin improving error messages
829e07fEvan Czaplicki
src/Reporting/Error/Type.hs+327−118
compare with master
unifiedsplit
@@ -2,17 +2,23 @@
2module Reporting.Error.Type where
2module Reporting.Error.Type where
3
3
4import qualified Data.Char as Char
4import qualified Data.Char as Char
5+import qualified Data.List as List
5import Text.PrettyPrint ((<+>))
6import Text.PrettyPrint ((<+>))
6import qualified Text.PrettyPrint as P
7import qualified Text.PrettyPrint as P
7
8
8−import qualified AST.Helpers as Help
9+import qualified AST.Helpers as AstHelp
9import qualified AST.Type as Type
10import qualified AST.Type as Type
10import qualified AST.Variable as Var
11import qualified AST.Variable as Var
12+import qualified Reporting.Error.Helpers as Help
11import qualified Reporting.PrettyPrint as P
13import qualified Reporting.PrettyPrint as P
12import qualified Reporting.Region as Region
14import qualified Reporting.Region as Region
13import qualified Reporting.Report as Report
15import qualified Reporting.Report as Report
14
16
15
17
18+
19+-- ERRORS
20+
21+
16data Error
22data Error
17 = Mismatch Mismatch
23 = Mismatch Mismatch
18 | BadMain Type.Canonical
24 | BadMain Type.Canonical
@@ -25,7 +31,6 @@ data Error
25
31
26data Mismatch = MismatchInfo
32data Mismatch = MismatchInfo
27 { _hint :: Hint
33 { _hint :: Hint
28− , _rootType :: Type.Canonical
29 , _leftType :: Type.Canonical
34 , _leftType :: Type.Canonical
30 , _rightType :: Type.Canonical
35 , _rightType :: Type.Canonical
31 , _reason :: Maybe Reason
36 , _reason :: Maybe Reason
@@ -34,8 +39,6 @@ data Mismatch = MismatchInfo
34
39
35data Reason
40data Reason
36 = MessyFields [String] [String]
41 = MessyFields [String] [String]
37− | ExpectedFields [String]
38− | ActualFields [String]
39 | NotRecord
42 | NotRecord
40 | TooLongComparableTuple Int
43 | TooLongComparableTuple Int
41 | Rigid (Maybe String)
44 | Rigid (Maybe String)
@@ -81,21 +84,8 @@ data Pattern
81toReport :: P.Dealiaser -> Error -> Report.Report
84toReport :: P.Dealiaser -> Error -> Report.Report
82toReport dealiaser err =
85toReport dealiaser err =
83 case err of
86 case err of
84− Mismatch (MismatchInfo hint rootType leftType rightType maybeReason) ->
87+ Mismatch info ->
85− let
88+ mismatchToReport dealiaser info
86− (subRegion, preHint, maybePostHint) = hintToString hint
87−
88− postHint =
89− "TODO explain what went wrong!\n\n" ++ show maybeReason ++ "\n\n"
90− ++ maybe "" (++"\n\n") maybePostHint
91− ++ P.render (P.nest 4 (P.pretty dealiaser False rootType)) ++ "\n\n"
92− ++ "As I infer the types of values flowing through your program, I see a conflict\n"
93− ++ "between these two types:\n\n"
94− ++ P.render (P.nest 4 (P.pretty dealiaser False leftType))
95− ++ "\n\n"
96− ++ P.render (P.nest 4 (P.pretty dealiaser False rightType))
97− in
98− Report.Report "TYPE MISMATCH" subRegion preHint postHint
99
89
100 InfiniteType name var tipe ->
90 InfiniteType name var tipe ->
101 let
91 let
@@ -125,119 +115,250 @@ toReport dealiaser err =
125 ++ P.render (P.nest 4 (P.pretty dealiaser False tipe))
115 ++ P.render (P.nest 4 (P.pretty dealiaser False tipe))
126
116
127
117
128−hintToString :: Hint -> (Maybe Region.Region, String, Maybe String)
118+mismatchToReport :: P.Dealiaser -> Mismatch -> Report.Report
129−hintToString hint =
119+mismatchToReport dealiaser (MismatchInfo hint leftType rightType maybeReason) =
120+ let
121+ report =
122+ Report.Report "TYPE MISMATCH"
123+
124+ pretty tipe =
125+ "\n\n"
126+ ++ P.render (P.nest 4 (P.pretty dealiaser False tipe))
127+ ++ "\n\n"
128+ in
130 case hint of
129 case hint of
131 CaseBranch branchNumber region ->
130 CaseBranch branchNumber region ->
131+ report
132− ( Just region
132+ (Just region)
133− , "The " ++ ordinalize branchNumber ++ " branch of this `case` results in an unexpected type of value."
133+ ( "The " ++ ordinalize (branchNumber -1) ++ " and " ++ ordinalize branchNumber
134+ ++ " branches of this `case` result in different types of values."
135+ )
136+ ( "The " ++ ordinalize (branchNumber -1) ++ " branch results in this type of value:\n"
137+
138+ ++ pretty leftType
139+
140+ ++ "And the " ++ ordinalize branchNumber ++ " branch results in this type:\n"
141+
142+ ++ pretty rightType
143+
134− , Just "All branches should match so that no matter which one we take, we always get\nback the same type of value."
144+ ++ "These branches should match so that no matter which one we take, we always get\n"
145+ ++ "back the same type of value."
135− )
146+ )
136
147
137 Case ->
148 Case ->
149+ report
138− ( Nothing
150+ Nothing
139− , "All the branches of this case-expression are consistent, but the overall\n"
151+ ( "All the branches of this case-expression are consistent, but the overall\n"
140− ++ "type does not match how it is used elsewhere."
152+ ++ "type does not match how it is used elsewhere."
141− , Nothing
153+ )
154+ ( error "TODO generic error"
142− )
155+ )
143
156
144 IfCondition ->
157 IfCondition ->
158+ report
145− ( Nothing
159+ Nothing
146− , "This condition does not evaluate to a boolean value, True or False."
160+ ( "This condition does not evaluate to a boolean value, True or False."
161+ )
162+ ( "Instead of Bool, it is resulting in:\n"
163+
164+ ++ pretty rightType
165+
147− , Just "Elm does not have \"truthiness\" such that ints and strings and lists are\nautomatically converted to booleans. Do that conversion explicitly."
166+ ++ "Note: Elm does not have \"truthiness\" such that ints and strings and lists\n"
167+ ++ "are automatically converted to booleans. Do that conversion explicitly."
148− )
168+ )
149
169
150 IfBranches ->
170 IfBranches ->
171+ report
151− ( Nothing
172+ Nothing
152− , "The branches of this `if` result in different types of values."
173+ ( "The branches of this `if` result in different types of values."
174+ )
175+ ( "The `then` branch results in:\n"
176+
177+ ++ pretty leftType
178+
179+ ++ "And the `else` branch results in:\n"
180+
181+ ++ pretty rightType
182+
153− , Just "All branches should match so that no matter which one we take, we always get\nback the same type of value."
183+ ++ "These need to match so that no matter which one we take, we always get\n"
184+ ++ "back the same type of value."
154− )
185+ )
155
186
156 MultiIfBranch branchNumber region ->
187 MultiIfBranch branchNumber region ->
188+ report
157− ( Just region
189+ (Just region)
158− , "The " ++ ordinalize branchNumber ++ " branch of this `if` results in an unexpected type of value."
190+ ( "The " ++ ordinalize branchNumber ++ " branch of this `if` results in an unexpected type of value."
191+ )
192+ ( "The " ++ ordinalize (branchNumber - 1) ++ " branch results in:\n"
193+
194+ ++ pretty leftType
195+
196+ ++ "And the "++ ordinalize branchNumber ++ " branch results in:\n"
197+
198+ ++ pretty rightType
199+
159− , Just "All branches should match so that no matter which one we take, we always get\nback the same type of value."
200+ ++ "All branches should match so that no matter which one we take, we always get\n"
201+ ++ "back the same type of value."
160− )
202+ )
161
203
162 If ->
204 If ->
205+ report
163− ( Nothing
206+ Nothing
164− , "All the branches of this if-expression are consistent, but the overall\n"
207+ ( "All the branches of this if-expression are consistent, but the overall\n"
165− ++ "type does not match how it is used elsewhere."
208+ ++ "type does not match how it is used elsewhere."
166− , Nothing
209+ )
210+ ( "The `if` evaluates to something of type:\n"
211+
212+ ++ pretty leftType
213+
214+ ++ "Which is fine, but the surrounding context wants it to be:\n"
215+
216+ ++ pretty rightType
217+
167− )
218+ )
168
219
169 ListElement elementNumber region ->
220 ListElement elementNumber region ->
221+ report
170− ( Just region
222+ (Just region)
171− , "The " ++ ordinalize elementNumber ++ " element of this list is an unexpected type of value."
223+ ( "The " ++ ordinalize elementNumber ++ " element of this list is an unexpected type of value."
224+ )
172− , Just "All elements should be the same type of value so that we can iterate over the\nlist without running into unexpected values."
225+ ( "All elements should be the same type of value so that we can iterate over the\nlist without running into unexpected values."
173− )
226+ )
174
227
175 List ->
228 List ->
229+ report
176− ( Nothing
230+ Nothing
177− , "All the elements in this list are the same type, but the overall\n"
231+ ( "All the elements in this list are the same type, but the overall\n"
178− ++ "type does not match how it is used elsewhere."
232+ ++ "type does not match how it is used elsewhere."
179− , Nothing
233+ )
234+ ( "The list has type:\n"
235+
236+ ++ pretty leftType
237+
238+ ++ "Which is fine, but the surrounding context wants it to be:\n"
239+
240+ ++ pretty rightType
180− )
241+ )
181
242
182 BinopLeft op region ->
243 BinopLeft op region ->
244+ report
183− ( Just region
245+ (Just region)
184− , "The left argument of " ++ prettyOperator op ++ " is causing a type mismatch."
246+ ("The left argument of " ++ prettyOperator op ++ " is causing a type mismatch.")
185− , Nothing
247+ ( prettyOperator op ++ " is expecting:"
248+
249+ ++ pretty leftType
250+
251+ ++ "But the value on the left has this type:"
252+
253+ ++ pretty rightType
186− )
254+ )
187
255
188 BinopRight op region ->
256 BinopRight op region ->
257+ report
189− ( Just region
258+ (Just region)
190− , "The right argument of " ++ prettyOperator op ++ " is causing a type mismatch."
259+ ( "The right argument of " ++ prettyOperator op ++ " is causing a type mismatch."
191− , Nothing
260+ )
261+ ( prettyOperator op ++ " is expecting:"
262+
263+ ++ pretty leftType
264+
265+ ++ "But the value on the right has this type:"
266+
267+ ++ pretty rightType
192− )
268+ )
193
269
194 Binop op ->
270 Binop op ->
271+ report
195− ( Nothing
272+ Nothing
196− , "The two arguments to " ++ prettyOperator op ++ " are fine, but the overall type of this expression\n"
273+ ( "The two arguments to " ++ prettyOperator op ++ " are fine, but the overall type of this expression\n"
197− ++ "does not match how it is used elsewhere."
274+ ++ "does not match how it is used elsewhere."
198− , Nothing
275+ )
276+ ( "The result of this binary operation is:\n"
277+
278+ ++ pretty leftType
279+
280+ ++ "Which is fine, but the surrounding context wants it to be:\n"
281+
282+ ++ pretty rightType
283+
199− )
284+ )
200
285
201 Function maybeName ->
286 Function maybeName ->
287+ report
202− ( Nothing
288+ Nothing
203− , "The return type of " ++ funcName maybeName ++ " is being used in unexpected ways."
289+ ( "The return type of " ++ funcName maybeName ++ " is being used in unexpected ways."
204− , Nothing
290+ )
291+ ( "The function results in a value with type:\n"
292+
293+ ++ pretty leftType
294+
295+ ++ "Which is fine, but the surrounding context wants it to be:\n"
296+
297+ ++ pretty rightType
205− )
298+ )
206
299
207 UnexpectedArg maybeName index region ->
300 UnexpectedArg maybeName index region ->
301+ report
208− ( Just region
302+ (Just region)
209− , "The " ++ ordinalize index ++ " argument to " ++ funcName maybeName
303+ ( "The " ++ ordinalize index ++ " argument to " ++ funcName maybeName
210− ++ " has an unexpected type."
304+ ++ " is causing a mismatch."
211− , Nothing
305+ )
306+ ( "The " ++ ordinalize index ++ " to " ++ funcName maybeName ++ " should be:"
307+
308+ ++ pretty leftType
309+
310+ ++ "But it is:"
311+
312+ ++ pretty rightType
313+
314+ ++ maybe "" reasonToString maybeReason
212− )
315+ )
213
316
214 FunctionArity maybeName expected actual region ->
317 FunctionArity maybeName expected actual region ->
215 let
318 let
216 s = if expected <= 1 then "" else "s"
319 s = if expected <= 1 then "" else "s"
217 in
320 in
321+ report
218− ( Just region
322+ (Just region)
219− , capitalize (funcName maybeName) ++ " is expecting " ++ show expected
323+ ( capitalize (funcName maybeName) ++ " is expecting " ++ show expected
220− ++ " argument" ++ s ++ ", but was given " ++ show actual ++ "."
324+ ++ " argument" ++ s ++ ", but was given " ++ show actual ++ "."
221− , Nothing
325+ )
326+ ( error "TODO are the types interesting here?"
222− )
327+ )
223
328
224 BadTypeAnnotation name ->
329 BadTypeAnnotation name ->
330+ report
225− ( Nothing
331+ Nothing
226− , "The type annotation for `" ++ name ++ "` does not match its definition."
332+ ( "The type annotation for `" ++ name ++ "` does not match its definition."
227− , Nothing
333+ )
334+ ( "Based on the actual definition, the type should be:\n"
335+
336+ ++ pretty rightType
228− )
337+ )
229
338
230 Instance name ->
339 Instance name ->
340+ report
231− ( Nothing
341+ Nothing
232− , "Given how `" ++ name ++ "` is defined, this use will not work out."
342+ ( "This usage of `" ++ name ++ "` is causing a type mismatch."
233− , Nothing
343+ )
344+ ( "Based on its definition, `" ++ name ++ "` has this type:"
345+
346+ ++ pretty leftType
347+
348+ ++ "But you are trying to use it as:"
349+
350+ ++ pretty rightType
234− )
351+ )
235
352
236 Literal name ->
353 Literal name ->
354+ report
237− ( Nothing
355+ Nothing
238− , "This " ++ name ++ " value is being used as if it is some other type of value."
356+ ( "This " ++ name ++ " value is being used as if it is some other type of value."
239− , Nothing
357+ )
358+ ( "You are trying to use this " ++ name ++ " as this type:"
359+
360+ ++ pretty rightType
240− )
361+ )
241
362
242 Pattern patErr ->
363 Pattern patErr ->
243 let
364 let
@@ -248,41 +369,129 @@ hintToString hint =
248 PData name -> "`" ++ name ++ "`"
369 PData name -> "`" ++ name ++ "`"
249 PRecord -> "a record"
370 PRecord -> "a record"
250 in
371 in
372+ report
251− ( Nothing
373+ Nothing
252− , "Problem with " ++ thing ++ " in this pattern match."
374+ ( "Problem with " ++ thing ++ " in this pattern match."
253− , Nothing
375+ )
376+ ( "This pattern matches things of type:"
377+
378+ ++ pretty leftType
379+
380+ ++ "But the values it will actually be trying to match are:"
381+
382+ ++ pretty rightType
254− )
383+ )
255
384
256 Shader ->
385 Shader ->
386+ report
257− ( Nothing
387+ Nothing
258− , "There is some problem with this GLSL shader."
388+ ( "There is some problem with this GLSL shader."
259− , Nothing
389+ )
390+ ( error "TODO generic error"
260− )
391+ )
261
392
262 Range ->
393 Range ->
394+ report
263− ( Nothing
395+ Nothing
264− , "The low and high members of this list range are not the same type of value."
396+ ( "The low and high members of this list range are not the same type of value."
265− , Nothing
397+ )
398+ ( "The low end of the range has type:"
399+
400+ ++ pretty leftType
401+
402+ ++ "But the high end is:"
403+
404+ ++ pretty rightType
266− )
405+ )
267
406
268 Lambda ->
407 Lambda ->
408+ report
269− ( Nothing
409+ Nothing
270− , "This anonymous function is being used in an unexpected way."
410+ ( "This anonymous function is being used in an unexpected way."
271− , Nothing
411+ )
412+ ( "The anonymous function has type:"
413+
414+ ++ pretty leftType
415+
416+ ++ "But you are trying to use it as:"
417+
418+ ++ pretty rightType
272− )
419+ )
273
420
274 Record ->
421 Record ->
422+ report
275− ( Nothing
423+ Nothing
276− , "This record is being used in an unexpected way."
424+ ( "This record is being used in an unexpected way."
277− , Nothing
425+ )
278− )
426+ ( "The record has type:"
427+
428+ ++ pretty leftType
429+
430+ ++ "But you are trying to use it as:"
431+
432+ ++ pretty rightType
433+ )
434+
435+
436+reasonToString :: Reason -> String
437+reasonToString reason =
438+ case reason of
439+ MessyFields expecteds [] ->
440+ genericMissingFieldsMessage "former" expecteds
441+
442+ MessyFields [] actuals ->
443+ genericMissingFieldsMessage "latter" actuals
444+
445+ MessyFields expecteds actuals ->
446+ case concatMap (similarNames actuals) expecteds of
447+ [] ->
448+ "These records look pretty different."
449+
450+ [(exp,act)] ->
451+ "Looks like a misspelling between field " ++ exp ++ " and " ++ act ++ "."
452+
453+ potentialTypos ->
454+ "There are some potential typos in the record field names.\n"
455+ ++ concatMap (\(exp,act) -> "\n " ++ exp ++ " <=> " ++ act) potentialTypos
456+
457+ NotRecord ->
458+ "A record cannot be merged with other types of values."
459+
460+ TooLongComparableTuple len ->
461+ error "TODO"
462+
463+ Rigid maybeName ->
464+ error "TODO"
465+
466+
467+similarNames :: [String] -> String -> [(String,String)]
468+similarNames otherKeys key =
469+ map ((,) key) (filter (\key' -> Help.distance key key' == 1) otherKeys)
470+
471+
472+
473+genericMissingFieldsMessage :: String -> [String] -> String
474+genericMissingFieldsMessage latterOrFormer fields =
475+ "A record in the " ++ latterOrFormer ++ " type is missing "
476+ ++
477+ case fields of
478+ [key] ->
479+ "field `" ++ key ++ "`"
480+
481+ [key1,key2] ->
482+ "fields " ++ key1 ++ " and " ++ key2
483+
484+ keys ->
485+ "fields " ++ List.intercalate ", " (init keys) ++ ", and " ++ last keys
279
486
280
487
281prettyOperator :: Var.Canonical -> String
488prettyOperator :: Var.Canonical -> String
282prettyOperator (Var.Canonical _ opName) =
489prettyOperator (Var.Canonical _ opName) =
283− if Help.isOp opName
490+ if AstHelp.isOp opName then
284− then "(" ++ opName ++ ")"
491+ "(" ++ opName ++ ")"
492+
493+ else
285− else "`" ++ opName ++ "`"
494+ "`" ++ opName ++ "`"
286
495
287
496
288funcName :: Maybe Var.Canonical -> String
497funcName :: Maybe Var.Canonical -> String
src/Type/Unify.hs+44−76
@@ -6,7 +6,6 @@ import Control.Monad.Except (ExceptT, lift, liftIO, throwError, runExceptT)
6import qualified Data.Map as Map
6import qualified Data.Map as Map
7import qualified Data.UnionFind.IO as UF
7import qualified Data.UnionFind.IO as UF
8
8
9−import qualified AST.Type as AstType
10import qualified AST.Variable as Var
9import qualified AST.Variable as Var
11import qualified Reporting.Region as R
10import qualified Reporting.Region as R
12import qualified Reporting.Error.Type as Error
11import qualified Reporting.Error.Type as Error
@@ -25,10 +24,16 @@ unify hint region expected actual =
25 Right state ->
24 Right state ->
26 return state
25 return state
27
26
28− Left (Mismatch leftType rightType maybeReason) ->
27+ Left (Mismatch subExpected subActual maybeReason) ->
28+ let
29+ mkError =
29− do rootType <- liftIO (Type.toSrcType expected)
30+ do expectedSrcType <- Type.toSrcType expected
31+ actualSrcType <- Type.toSrcType actual
32+ mergeHelp subExpected subActual Error
33+ let info = Error.MismatchInfo hint expectedSrcType actualSrcType maybeReason
34+ return (Error.Mismatch info)
35+ in
30− TS.addError region $ Error.Mismatch $
36+ TS.addError region =<< liftIO mkError
31− Error.MismatchInfo hint rootType leftType rightType maybeReason
32
37
33
38
34
39
@@ -67,7 +72,7 @@ reorient (Context orientation var1 desc1 var2 desc2) =
67
72
68
73
69data Mismatch
74data Mismatch
70− = Mismatch AstType.Canonical AstType.Canonical (Maybe Error.Reason)
75+ = Mismatch Variable Variable (Maybe Error.Reason)
71
76
72
77
73mismatch :: Context -> Maybe Error.Reason -> Unify a
78mismatch :: Context -> Maybe Error.Reason -> Unify a
@@ -81,12 +86,7 @@ mismatch (Context orientation first _ second _) maybeReason =
81 ActualExpected ->
86 ActualExpected ->
82 (second, first)
87 (second, first)
83 in
88 in
84− do errorMsg <- liftIO $
89+ throwError (Mismatch expected actual maybeReason)
85− do expectedSrcType <- Type.toSrcType expected
86− actualSrcType <- Type.toSrcType actual
87− return (Mismatch expectedSrcType actualSrcType maybeReason)
88− mergeHelp expected actual Error
89− throwError errorMsg
90
90
91
91
92rigidityError :: Context -> Maybe String -> Unify ()
92rigidityError :: Context -> Maybe String -> Unify ()
@@ -100,12 +100,12 @@ rigidityError context maybeName =
100
100
101merge :: Context -> Content -> Unify ()
101merge :: Context -> Content -> Unify ()
102merge (Context _ first _ second _) content =
102merge (Context _ first _ second _) content =
103− mergeHelp first second content
103+ liftIO $ mergeHelp first second content
104
104
105
105
106−mergeHelp :: Variable -> Variable -> Content -> Unify ()
106+mergeHelp :: Variable -> Variable -> Content -> IO ()
107mergeHelp first second content =
107mergeHelp first second content =
108− liftIO $ UF.union' first second $ \desc1 desc2 ->
108+ UF.union' first second $ \desc1 desc2 ->
109 return $
109 return $
110 Descriptor
110 Descriptor
111 { _content = content
111 { _content = content
@@ -552,67 +552,35 @@ unifyRecord context firstStructure secondStructure =
552 let uniqueExpFields = Map.difference expFields actFields
552 let uniqueExpFields = Map.difference expFields actFields
553 let uniqueActFields = Map.difference actFields expFields
553 let uniqueActFields = Map.difference actFields expFields
554
554
555− case (expStruct, actStruct) of
555+ case (expStruct, Map.null uniqueExpFields, actStruct, Map.null uniqueActFields) of
556− (Empty, Empty) ->
556+ (_, True, _, True) ->
557− if Map.null uniqueExpFields && Map.null uniqueActFields then
557+ do subUnify context expVar actVar
558− do mergeHelp expVar actVar (Structure EmptyRecord1)
559− unifySharedFields Map.empty expVar
558+ unifySharedFields Map.empty expVar
560−
559+
561− else
562− mismatch context (Just (Error.MessyFields (Map.keys uniqueExpFields) (Map.keys uniqueActFields)))
563−
564− (Empty, Extension) ->
565− case (Map.null uniqueExpFields, Map.null uniqueActFields) of
566− (_, False) ->
560+ (Empty, _, _, False) ->
567− mismatch context (Just (Error.ActualFields (Map.keys uniqueActFields)))
561+ mismatch context (Just (Error.MessyFields (Map.keys uniqueExpFields) (Map.keys uniqueActFields)))
568−
562+
569− (True, True) ->
563+ (_, False, Empty, _) ->
570− do subUnify context expVar actVar
571− unifySharedFields Map.empty expVar
572−
573− (False, True) ->
574− do subRecord <- fresh context (Structure (Record1 uniqueExpFields expVar))
575− subUnify context subRecord actVar
576− unifySharedFields Map.empty subRecord
577−
578− (Extension, Empty) ->
579− case (Map.null uniqueExpFields, Map.null uniqueActFields) of
580− (False, _) ->
581− mismatch context (Just (Error.ExpectedFields (Map.keys uniqueExpFields)))
564+ mismatch context (Just (Error.MessyFields (Map.keys uniqueExpFields) (Map.keys uniqueActFields)))
582−
565+
583− (True, True) ->
584− do subUnify context expVar actVar
585− unifySharedFields Map.empty expVar
586−
587− (True, False) ->
566+ (_, False, _, True) ->
588− do subRecord <- fresh context (Structure (Record1 uniqueActFields actVar))
567+ do subRecord <- fresh context (Structure (Record1 uniqueExpFields expVar))
589− subUnify context expVar subRecord
568+ subUnify context subRecord actVar
590− unifySharedFields Map.empty subRecord
569+ unifySharedFields Map.empty subRecord
591−
570+
592− (Extension, Extension) ->
593− case (Map.null uniqueExpFields, Map.null uniqueActFields) of
594− (True, True) ->
595− do subUnify context expVar actVar
596− unifySharedFields Map.empty expVar
597−
598− (True, False) ->
571+ (_, True, _, False) ->
599− do subRecord <- fresh context (Structure (Record1 uniqueActFields actVar))
572+ do subRecord <- fresh context (Structure (Record1 uniqueActFields actVar))
600− subUnify context expVar subRecord
573+ subUnify context expVar subRecord
601− unifySharedFields Map.empty subRecord
574+ unifySharedFields Map.empty subRecord
602−
575+
603− (False, True) ->
576+ (Extension, False, Extension, False) ->
604− do subRecord <- fresh context (Structure (Record1 uniqueExpFields expVar))
605− subUnify context subRecord actVar
606− unifySharedFields Map.empty subRecord
607−
608− (False, False) ->
609− do let subFields = Map.union uniqueExpFields uniqueActFields
577+ do let subFields = Map.union uniqueExpFields uniqueActFields
610− subExt <- fresh context (Var Flex Nothing Nothing)
578+ subExt <- fresh context (Var Flex Nothing Nothing)
611− expRecord <- fresh context (Structure (Record1 uniqueActFields subExt))
579+ expRecord <- fresh context (Structure (Record1 uniqueActFields subExt))
612− actRecord <- fresh context (Structure (Record1 uniqueExpFields subExt))
580+ actRecord <- fresh context (Structure (Record1 uniqueExpFields subExt))
613− subUnify context expVar expRecord
581+ subUnify context expVar expRecord
614− subUnify context actRecord actVar
582+ subUnify context actRecord actVar
615− unifySharedFields subFields subExt
583+ unifySharedFields subFields subExt
616
584
617
585
618
586