on master help sign in
Start wiring in type diff implementation
d924db7Evan Czaplicki
src/Reporting/Error/Type.hs+21−4
@@ -309,8 +309,8 @@ toPatternReport source localizer patternRegion category tipe expected =
309patternTypeComparison :: T.Localizer -> T.Type -> T.Type -> ( String, String, [H.Doc] ) -> H.Doc
309patternTypeComparison :: T.Localizer -> T.Type -> T.Type -> ( String, String, [H.Doc] ) -> H.Doc
310patternTypeComparison localizer actual expected ( iAmSeeing, insteadOf, soHereAreSomeThoughts ) =
310patternTypeComparison localizer actual expected ( iAmSeeing, insteadOf, soHereAreSomeThoughts ) =
311 let
311 let
312− (actualDoc, expectedDoc) =
312+ (actualDoc, expectedDoc, problems) =
313− error "TODO diff" localizer actual expected
313+ T.toDiffDocs localizer actual expected
314 in
314 in
315 H.stack $
315 H.stack $
316 [ H.reflow iAmSeeing
316 [ H.reflow iAmSeeing
@@ -319,6 +319,7 @@ patternTypeComparison localizer actual expected ( iAmSeeing, insteadOf, soHereAr
319 , H.indent 4 expectedDoc
319 , H.indent 4 expectedDoc
320 ]
320 ]
321 ++ soHereAreSomeThoughts
321 ++ soHereAreSomeThoughts
322+ ++ map problemToHints problems
322
323
323
324
324toPatternDescription :: PCategory -> String -> String
325toPatternDescription :: PCategory -> String -> String
@@ -342,8 +343,8 @@ toPatternDescription category iAmTryingToMatch =
342typeComparison :: T.Localizer -> T.Type -> T.Type -> ( String, String, [H.Doc] ) -> H.Doc
343typeComparison :: T.Localizer -> T.Type -> T.Type -> ( String, String, [H.Doc] ) -> H.Doc
343typeComparison localizer actual expected ( iAmSeeing, insteadOf, soHereAreSomeThoughts ) =
344typeComparison localizer actual expected ( iAmSeeing, insteadOf, soHereAreSomeThoughts ) =
344 let
345 let
345− (actualDoc, expectedDoc) =
346+ (actualDoc, expectedDoc, problems) =
346− error "TODO diff" localizer actual expected
347+ T.toDiffDocs localizer actual expected
347 in
348 in
348 H.stack $
349 H.stack $
349 [ H.reflow iAmSeeing
350 [ H.reflow iAmSeeing
@@ -352,6 +353,7 @@ typeComparison localizer actual expected ( iAmSeeing, insteadOf, soHereAreSomeTh
352 , H.indent 4 expectedDoc
353 , H.indent 4 expectedDoc
353 ]
354 ]
354 ++ soHereAreSomeThoughts
355 ++ soHereAreSomeThoughts
356+ ++ map problemToHints problems
355
357
356
358
357indentType :: T.Localizer -> T.Type -> H.Doc
359indentType :: T.Localizer -> T.Type -> H.Doc
@@ -387,6 +389,21 @@ toDescription category thatThingIs =
387 OpName _ -> thatThingIs <> ":"
389 OpName _ -> thatThingIs <> ":"
388
390
389
391
392+-- TODO be sure to avoid duplicate Problems (e.g. two instances of BadRigidVar)
393+--
394+problemToHints :: T.Problem -> H.Doc
395+problemToHints problem =
396+ case problem of
397+ T.FieldMismatch leftOnly rightOnly -> error "TODO FieldMismatch" leftOnly rightOnly
398+ T.IntFloat -> error "TODO IntFloat"
399+ T.MissingArgs numMissing -> error "TODO MissingArgs" numMissing
400+ T.ReturnMismatch -> error "TODO ReturnMismatch"
401+ T.TupleMismatch -> error "TODO TupleMismatch"
402+ T.BadFlexSuper x tipe -> error "TODO BadFlexSuper" x tipe
403+ T.BadRigidVar x tipe -> error "TODO BadRigidVar" x tipe
404+ T.BadRigidSuper x tipe -> error "TODO BadRigidSuper" x tipe
405+
406+
390
407
391-- TO EXPR REPORT
408-- TO EXPR REPORT
392
409
src/Type/Error.hs+2−2
@@ -188,7 +188,7 @@ data Problem
188 = FieldMismatch [N.Name] [N.Name]
188 = FieldMismatch [N.Name] [N.Name]
189 | IntFloat
189 | IntFloat
190 | MissingArgs Int
190 | MissingArgs Int
191− | ReturnMismatch Int Int
191+ | ReturnMismatch
192 | TupleMismatch
192 | TupleMismatch
193 | BadFlexSuper N.Name Type
193 | BadFlexSuper N.Name Type
194 | BadRigidVar N.Name Type
194 | BadRigidVar N.Name Type
@@ -316,7 +316,7 @@ diffLambda dict ctx types1 types2 =
316 Different
316 Different
317 (RT.lambda ctx x1 y1 zs1)
317 (RT.lambda ctx x1 y1 zs1)
318 (RT.lambda ctx x2 y2 zs2)
318 (RT.lambda ctx x2 y2 zs2)
319− (Bag.append (Bag.one (ReturnMismatch numArgs1 numArgs2)) problems)
319+ (Bag.append (Bag.one ReturnMismatch) problems)
320
320
321
321
322--
322--