Skip to content

WIP #9173: Better type mismatch error messages

Alex D requested to merge nineonine/ghc:wip/T9173 into master

The problem:

  • improve type/kind mismatch error messages
  • provide additional info about context in which type mismatch occurred.

Implementation details:

  • Add an SDoc field to the Check constructor of TcType.ExpType.
  • In every mkCheckExpType, supply appropriate message.
  • Update synKnownType too, since it uses mkCheckExpType under the hood. (?)
  • Add a new field uo_context to TypeEqOrigin (of type Maybe SDoc) that will get the doc from the Check. Update every place where we make a TypeEqOrigin.
  • Teach TcErrors.mkExpectedActualMsg to use this new info to produce better error messages.

Change breakdown by file:

  • TcErrors

    • update mk_wanted_extra (inside mkEqErr1)
      • change herald1/herald2, decide whether we need msg1)
    • update mkExpectedActualMsg
      • Rip out the special treatment of kinds (get rid of msg5) (?)
  • Inst

    • update newOverloadedLit
      • supply appropriate context message to mkCheckExpType
    • update newNonTrivialOverloadedLit
      • supply appropriate context message to synKnownType
  • TcArrows

    • update tcProc
      • supply appropriate context message to mkCheckExpType
    • udpate tc_cmd
      • supply appropriate context message to mkCheckExpType for:
        • HsCmdCase
        • HsCmdIf -- ordinary if
        • HsCmdIf -- rebindable syntax
        • HsCmdArrApp
        • HsCmdApp
        • HsCmdLam -- patterns and GRHSs
    • update tcArrDoStmt
      • supply appropriate context message to mkCheckExpType for:
        • BindStmt
        • RecStmt
  • TcBinds

    • update tcLocalBinds
      • supply appropriate context message to mkCheckExpType for HsIPBinds case
    • update mkCheckExpType
      • supply appropriate context message to mkCheckExpType
    • udpate tcRhs
      • supply appropriate context message to mkCheckExpType
  • TcExpr

    • update tcPolyExpr (tcPolyExprNC )
      • supply appropriate context message to mkCheckExpType (?)
      • failing text - ado/ado002
    • update tcExpr for:
      • NegApp
      • ExplicitList
      • HsIf
    • update tcExpr
      • supply appropriate context message to tcPolyExprNC
    • update tcArg
      • supply appropriate context message to tcPolyExprNC
    • update tcSynArgE (update local function go for SynFun)
      • supply appropriate context message to mkCheckExpType
    • udpate tcExprSig
      • case CompleteSig - supply appropriate context message to tcPolyExprNC case
        • failing test - ghci/scripts/ghci051
      • case PartialSig - supply appropriate context message to tcPolyExprNC case
    • update tcTagToEnum
      • supply appropriate context message to mkCheckExpType
    • update tcRecordField
      • supply appropriate context message to tcPolyExprNC
  • TcHsType

    • add uo_context field to origin of type TypeEqOrigin in checkExpectedKindX
  • TcMatches

    • update tcMatchesCase
      • supply appropriate context message to mkCheckExpType
    • update tcGRHSsPat
      • supply appropriate context message to mkCheckExpType
    • update tcDoStmts
      • supply appropriate context message to mkCheckExpType
      • failing test - ado/ado002, ado/T13242a
    • update tcGuardStmt
      • supply appropriate context message to mkCheckExpType (2)
    • update tcLcStmt
      • supply appropriate context message to mkCheckExpType (4)
    • update tcMcStmt
      • LastStmt case - supply appropriate context message to mkCheckExpType (2)
      • BindStmt case - supply appropriate context message to mkCheckExpType (3)
      • BodyStmt case - supply appropriate context message to mkCheckExpType (3)
      • TransStmt case - supply appropriate context message (mkCheckExpType, synKnownType) (5)
      • ParStmt case - supply appropriate context message (mkCheckExpType, synKnownType) (4)
    • udpate tcDoStmt
      • BindStmt case - supply appropriate context message to mkCheckExpType (3)
      • ApplicativeStmt - supply appropriate context message to mkCheckExpType (2)
      • BodyStmt case - supply appropriate context message to mkCheckExpType (2)
      • RecStmt case - supply appropriate context message (mkCheckExpType, synKnownType) (6)
    • update tcMonadFailOp
      • supply appropriate context message (mkCheckExpType, synKnownType) (2)
    • update tcApplicativeStmts
      • supply appropriate context message (mkCheckExpType, synKnownType) (6)
  • TcMType

    • update Check pattern in readExpType_maybe
    • update Check pattern in checkingExpType_maybe
    • update Check pattern in checkingExpType
    • update Check pattern in tauifyExpType
    • update Check pattern in expTypeToType
  • TcPat

    • update Check pattern match in tcPatBndr
    • update tc_pat
      • supply appropriate context message to mkCheckExpType for
        • AsPat
        • SigPat
        • ListPat (3)
        • TuplePat
        • SumPat
        • NPat (3)
        • NPlusKPat (6)
    • update tcConArg
      • supply appropriate context message to mkCheckExpType
  • TcPatSyn

    • update tcCheckPatSynDecl
      • supply appropriate context message to mkCheckExpType
  • TcRnDriver

    • update check_main
      • supply appropriate context message to mkCheckExpType
    • udpate tcGhciStmts
      • supply appropriate context message to mkCheckExpType
  • TcRnTypes

    • Add a Maybe SDoc field to the TypeEqOrigin constructor of CtOrigin We will record there the aspect of the context that leads us to expect the "expected" type.
  • TcRules

    • update generateRuleConstraints
      • supply appropriate context message to mkCheckExpType
  • TcSplice

    • update tcPendingSplice
      • supply appropriate context message to mkCheckExpType
    • update tcNestedSplice
      • supply appropriate context message to mkCheckExpType
    • update tcTopSplice
      • supply appropriate context message to mkCheckExpType
    • update runTopSplice
      • supply appropriate context message to mkCheckExpType
  • TcType

    • Add an SDoc field to the Check constructor of an ExpType
  • TcUnify

    • update matchExpectedFunTys (local go function)
      • get context from Check and give it to mkCheckExpType
      • FunTy case - supply appropriate context message to mkCheckExpType
      • TyVarTycase - supply appropriate context message to mkCheckExpType (2)
    • udpate tcSubTypeET
      • get context from Check and give it to mkCheckExpType
    • udpate addSubTypeCtxt
      • supply appropriate context message to mkCheckExpType
    • update tcSubType_NC
      • supply appropriate context message to uo_context of TypeEqOrigin
    • update tcSubTypeDS_NC_O
      • supply appropriate context message to uo_context of TypeEqOrigin
    • update promoteTcType
      • supply appropriate context message to uo_context of TypeEqOrigin (2)
    • update tcSkolemiseET
      • get context from Check and give it to mkCheckExpType
    • update unifyType
      • supply appropriate context message to uo_context of TypeEqOrigin
      • failing test - ado/ado002
    • update unifyKind
      • supply appropriate context message to uo_context of TypeEqOrigin
    • update matchExpectedFunKind
      • supply appropriate context message to uo_context of TypeEqOrigin
      • failing test - dependent/should_fail/RAE_T32a

Miscellaneous notes/comments

* Ideally, the message will not mention any types, because there will be no chance to zonk them later.

Unresolved Questions

* in `TcExpr`, `tcPolyExprNC` uses `mkCheckExpType` but since the `NC` version
  does not supple the context for the error, what do we want to supply to `mkCheckExpType`
  in that case?
* Address message formatting in case of `type representation mismatch`
  types of messages (e.g. tests in `deriving/` dir)
Edited by Alex D

Merge request reports