6fbbd1b · elk · git.iko.soy

git.iko.soy/elk

Always provide a specialized hint when unification fails

commit6fbbd1b22ec8857bdc5c0f082e6cf24393d13e7b authorEvan Czaplicki <info@elm-lang.org> dateMon 22 Jun 2015, 10:31 (11 years ago) parent3c6edc8

6 files changed+144−59

compare with master

unifiedsplit

src/Reporting/Error/Type.hs+68−23 src/Type/Constrain/Expression.hs+15−8 src/Type/Constrain/Literal.hs+9−1 src/Type/Constrain/Pattern.hs+28−11 src/Type/Solve.hs+1−1 src/Type/Unify.hs+23−15

src/Reporting/Error/Type.hs+68−23

@@ -22,7 +22,7 @@ data Mismatch = MismatchInfo

2222 { _hint :: Hint

2323 , _leftType :: Type.Canonical

2424 , _rightType :: Type.Canonical

25− , _note :: Note

25+ , _note :: Maybe String

2626 }

2727

2828

@@ -34,8 +34,7 @@ data InfiniteType = InfiniteTypeInfo

3434

3535

3636data Hint

37− = None

38− | CaseBranch Int Region.Region

37+ = CaseBranch Int Region.Region

3938 | Case

4039 | IfBranches

4140 | MultiIfBranch Int Region.Region

@@ -48,12 +47,21 @@ data Hint

4847 | BadArgument Region.Region

4948 | ExtraArgument Region.Region

5049 | BadTypeAnnotation String

50+ | Instance String

51+ | Literal String

52+ | Pattern Pattern

53+ | Shader

54+ | Range

55+ | Lambda

56+ | App

57+ | Record

5158

5259

53−data Note

54− = PreNote String

55− | NoNote

56− | PostNote String

60+data Pattern

61+ = PVar String

62+ | PAlias String

63+ | PData String

64+ | PRecord

5765

5866

5967-- TO REPORT

@@ -66,20 +74,14 @@ toReport dealiaser err =

6674 (subRegion, preHint) = hintToString hint

6775

6876 postHint =

69− "To be more specific, type inference is leading to a conflict between this type:\n\n"

77+ maybe "" (++"\n\n") note

78+ ++ "As I infer the type of values flowing through your program, I see a conflict\n"

79+ ++ "between these two types:\n\n"

7080 ++ P.render (P.nest 4 (P.pretty dealiaser False leftType))

71− ++ "\n\nand this type:\n\n"

81+ ++ "\n\n"

7282 ++ P.render (P.nest 4 (P.pretty dealiaser False rightType))

7383 in

74− case note of

75− PreNote msg ->

76− Report.Report "TYPE MISMATCH" subRegion (preHint ++ "\n\n" ++ msg) postHint

77−

78− NoNote ->

79− Report.Report "TYPE MISMATCH" subRegion preHint postHint

80−

81− PostNote msg ->

82− Report.Report "TYPE MISMATCH" subRegion preHint (postHint ++ "\n\n" ++ msg)

84+ Report.Report "TYPE MISMATCH" subRegion preHint postHint

8385

8486 InfiniteType (InfiniteTypeInfo name var tipe) ->

8587 let

@@ -111,11 +113,6 @@ toReport dealiaser err =

111113hintToString :: Hint -> (Maybe Region.Region, String)

112114hintToString hint =

113115 case hint of

114− None ->

115− ( Nothing

116− , "This expression is triggering a type mismatch."

117− )

118−

119116 CaseBranch branchNumber region ->

120117 ( Just region

121118 , "The branches of this case-expression return different types of values.\n\n"

@@ -193,6 +190,54 @@ hintToString hint =

193190 , "The type annotation for `" ++ name ++ "` does not match its definition."

194191 )

195192

193+ Instance name ->

194+ ( Nothing

195+ , "Given how `" ++ name ++ "` is defined, this use will not work out."

196+ )

197+

198+ Literal name ->

199+ ( Nothing

200+ , "This " ++ name ++ " value is being used as if it is some other type of value."

201+ )

202+

203+ Pattern patErr ->

204+ let

205+ thing =

206+ case patErr of

207+ PVar name -> "variable `" ++ name ++ "`"

208+ PAlias name -> "alias `" ++ name ++ "`"

209+ PData name -> "`" ++ name ++ "`"

210+ PRecord -> "a record"

211+ in

212+ ( Nothing

213+ , "Problem with " ++ thing ++ " in this pattern match."

214+ )

215+

216+ Shader ->

217+ ( Nothing

218+ , "There is some problem with this GLSL shader."

219+ )

220+

221+ Range ->

222+ ( Nothing

223+ , "The low and high members of this list range do not match."

224+ )

225+

226+ Lambda ->

227+ ( Nothing

228+ , "This anonymous function is being used in an unexpected way."

229+ )

230+

231+ App ->

232+ ( Nothing

233+ , "The result of this function application is being used in an unexpected way."

234+ )

235+

236+ Record ->

237+ ( Nothing

238+ , "This record is being used in an unexpected way."

239+ )

240+

196241

197242prettyOperator :: Var.Canonical -> String

198243prettyOperator (Var.Canonical _ opName) =

src/Type/Constrain/Expression.hs+15−8

@@ -29,7 +29,6 @@ constrain

2929 -> IO TypeConstraint

3030constrain env (A.A region expression) tipe =

3131 let list t = Env.get env Env.types "List" <| t

32− (===) = CEqual Error.None region

3332 (<?) = CInstance region

3433 in

3534 case expression of

@@ -57,7 +56,7 @@ constrain env (A.A region expression) tipe =

5756 uniform = makeRec Lit.uniform unif

5857 varying = makeRec Lit.varying (termN EmptyRecord1)

5958 in

60− return (tipe === shaderTipe attribute uniform varying)

59+ return (CEqual Error.Shader region tipe (shaderTipe attribute uniform varying))

6160

6261 E.Var var ->

6362 let name = V.toString var

@@ -68,7 +67,11 @@ constrain env (A.A region expression) tipe =

6867 existsNumber $ \n ->

6968 do lowCon <- constrain env lowExpr n

7069 highCon <- constrain env highExpr n

71− return $ CAnd [lowCon, highCon, list n === tipe]

70+ return $ CAnd

71+ [ lowCon

72+ , highCon

73+ , CEqual Error.Range region (list n) tipe

74+ ]

7275

7376 E.ExplicitList exprs ->

7477 constrainList env region exprs tipe

@@ -86,7 +89,7 @@ constrain env (A.A region expression) tipe =

8689 (CLet [monoscheme (Fragment.typeEnv fragment)]

8790 (Fragment.typeConstraint fragment /\ bodyCon)

8891 )

89− return $ con /\ tipe === (argType ==> resType)

92+ return $ con /\ CEqual Error.Lambda region tipe (argType ==> resType)

9093

9194 E.App func@(A.A funcRegion _) arg@(A.A argRegion _) ->

9295 do argVar <- variable Flexible

@@ -105,7 +108,7 @@ constrain env (A.A region expression) tipe =

105108 (varN funcVar)

106109 (varN argVar' ==> varN resultVar)

107110 , CEqual (Error.BadArgument argRegion) region (varN argVar') (varN argVar)

108− , tipe === varN resultVar

111+ , CEqual Error.App region tipe (varN resultVar)

109112 ]

110113

111114 E.MultiIf branches ->

@@ -139,7 +142,11 @@ constrain env (A.A region expression) tipe =

139142 recordCon <- constrain env expr recordType

140143 let newRecordType =

141144 record (Map.singleton label [valueType]) recordType

142− return (CAnd [valueCon, recordCon, tipe === newRecordType])

145+ return $ CAnd

146+ [ valueCon

147+ , recordCon

148+ , CEqual Error.Record region tipe newRecordType

149+ ]

143150

144151 E.Modify expr fields ->

145152 exists $ \t ->

@@ -149,7 +156,7 @@ constrain env (A.A region expression) tipe =

149156

150157 newVars <- Monad.forM fields $ \_ -> variable Flexible

151158 let newFields = ST.fieldMap (zip (map fst fields) (map varN newVars))

152− let cNew = tipe === record newFields t

159+ let cNew = CEqual Error.Record region tipe (record newFields t)

153160

154161 cs <- Monad.zipWithM (constrain env) (map snd fields) (map varN newVars)

155162

@@ -164,7 +171,7 @@ constrain env (A.A region expression) tipe =

164171 (map varN vars)

165172 let fields' = ST.fieldMap (zip (map fst fields) (map varN vars))

166173 let recordType = record fields' (termN EmptyRecord1)

167− return (ex vars (CAnd (fieldCons ++ [tipe === recordType])))

174+ return (ex vars (CAnd (fieldCons ++ [CEqual Error.Record region tipe recordType])))

168175

169176 E.Let defs body ->

170177 do bodyCon <- constrain env body tipe

src/Type/Constrain/Literal.hs+9−1

@@ -15,7 +15,7 @@ constrain

1515 -> IO T.TypeConstraint

1616constrain env region literal tipe =

1717 do tipe' <- litType

18− return (T.CEqual Error.None region tipe tipe')

18+ return (T.CEqual (Error.Literal name) region tipe tipe')

1919 where

2020 prim name =

2121 return (Env.get env Env.types name)

@@ -27,3 +27,11 @@ constrain env region literal tipe =

2727 L.Chr _ -> prim "Char"

2828 L.Str _ -> prim "String"

2929 L.Boolean _ -> prim "Bool"

30+

31+ name =

32+ case literal of

33+ L.IntNum _ -> "number"

34+ L.FloatNum _ -> "float"

35+ L.Chr _ -> "character"

36+ L.Str _ -> "string"

37+ L.Boolean _ -> "boolean"

src/Type/Constrain/Pattern.hs+28−11

@@ -23,7 +23,8 @@ constrain

2323 -> IO Fragment

2424constrain env (A.A region pattern) tipe =

2525 let

26− (===) = CEqual Error.None region

26+ equal patternError leftType rightType =

27+ CEqual (Error.Pattern patternError) region leftType rightType

2728

2829 rvar v =

2930 A.A region (varN v)

@@ -41,7 +42,8 @@ constrain env (A.A region pattern) tipe =

4142 return $ Fragment

4243 { typeEnv = Map.singleton name (rvar v)

4344 , vars = [v]

44− , typeConstraint = varN v === tipe

45+ , typeConstraint =

46+ equal (Error.PVar name) (varN v) tipe

4547 }

4648

4749 P.Alias name p ->

@@ -50,26 +52,41 @@ constrain env (A.A region pattern) tipe =

5052 return $ fragment

5153 { typeEnv = Map.insert name (rvar v) (typeEnv fragment)

5254 , vars = v : vars fragment

53− , typeConstraint = varN v === tipe /\ typeConstraint fragment

55+ , typeConstraint =

56+ equal (Error.PAlias name) (varN v) tipe

57+ /\ typeConstraint fragment

5458 }

5559

5660 P.Data name patterns ->

57− do (_kind, cvars, args, result) <-

58− Env.freshDataScheme env (V.toString name)

61+ do let stringName = V.toString name

62+

63+ (_kind, cvars, args, result) <-

64+ Env.freshDataScheme env stringName

5965

6066 fragList <- Monad.zipWithM (constrain env) patterns args

6167 let fragment = joinFragments fragList

6268 return $ fragment

63− { typeConstraint = typeConstraint fragment /\ tipe === result

64− , vars = cvars ++ vars fragment

69+ { vars = cvars ++ vars fragment

70+ , typeConstraint =

71+ typeConstraint fragment

72+ /\ equal (Error.PData stringName) tipe result

6573 }

6674

6775 P.Record fields ->

68− do pairs <- mapM (\name -> (,) name <$> variable Flexible) fields

69− let tenv = Map.fromList (map (second rvar) pairs)

70− c <- exists $ \t -> return (tipe === record (Map.map (\v -> [A.drop v]) tenv) t)

76+ do pairs <-

77+ mapM (\name -> (,) name <$> variable Flexible) fields

78+

79+ let tenv =

80+ Map.fromList (map (second rvar) pairs)

81+

82+ let unannotatedTenv =

83+ Map.map (\v -> [A.drop v]) tenv

84+

85+ con <- exists $ \t ->

86+ return (equal Error.PRecord tipe (record unannotatedTenv t))

87+

7188 return $ Fragment

7289 { typeEnv = tenv

7390 , vars = map snd pairs

74− , typeConstraint = c

91+ , typeConstraint = con

7592 }

src/Type/Solve.hs+1−1

@@ -170,7 +170,7 @@ actuallySolve constraint =

170170 else error ("Could not find `" ++ name ++ "` when solving type constraints.")

171171

172172 t <- TS.flatten term

173− unify Error.None region freshCopy t

173+ unify (Error.Instance name) region freshCopy t

174174

175175

176176solveScheme

src/Type/Unify.hs+23−15

@@ -42,13 +42,13 @@ type Unify =

4242

4343

4444newtype RawMismatch =

45− RawMismatch (AstType.Canonical, AstType.Canonical, Error.Note)

45+ RawMismatch (AstType.Canonical, AstType.Canonical, Maybe String)

4646

4747

4848typeError

4949 :: UF.Point Descriptor

5050 -> UF.Point Descriptor

51− -> Error.Note

51+ -> Maybe String

5252 -> Unify a

5353typeError leftType rightType note =

5454 do leftSrcType <- liftIO (toSrcType leftType)

@@ -121,15 +121,15 @@ actuallyUnify variable1 variable2 = do

121121 Var.BuiltIn | name `elem` ["Int","Float"] -> flexAndUnify svar

122122 Var.Local | List.isPrefixOf "number" name -> flexAndUnify svar

123123 _ ->

124− typeError variable1 variable2 Error.NoNote

124+ typeError variable1 variable2 Nothing

125125

126126 comparableError maybeHint =

127− typeError variable1 variable2 $ Error.PostNote $

127+ typeError variable1 variable2 $ Just $

128128 "Note: comparable types include Int, Float, Char, String, lists, and tuples."

129129 ++ maybe "" ("\n"++) maybeHint

130130

131131 appendableError =

132− typeError variable1 variable2 $ Error.PostNote $

132+ typeError variable1 variable2 $ Just $

133133 "Note: appendable types include only Strings, Lists, and Text."

134134

135135 unifyComparable v (Var.Canonical home name) =

@@ -164,12 +164,8 @@ actuallyUnify variable1 variable2 = do

164164 _ -> appendableError

165165

166166 rigidError var =

167− let v = render (pretty Never var)

168− in

169− typeError variable1 variable2 $ Error.PreNote $

170− "Could not unify rigid type variable `" ++ v ++ "`. The problem probably\n"

171− ++ "relates to the type variable being shared between two type annotations.\n"

172− ++ "Try commenting out some type annotations and see what happens."

167+ typeError variable1 variable2 $ Just $

168+ rigidErrorMessage (render (pretty Never var))

173169

174170 superUnify =

175171 case (flex desc1, flex desc2, name desc1, name desc2) of

@@ -195,7 +191,7 @@ actuallyUnify variable1 variable2 = do

195191

196192 (Rigid, _, _, _) -> rigidError variable1

197193 (_, Rigid, _, _) -> rigidError variable2

198− _ -> typeError variable1 variable2 Error.NoNote

194+ _ -> typeError variable1 variable2 Nothing

199195

200196 case (structure desc1, structure desc2) of

201197 (Nothing, Nothing) | flex desc1 == Flexible && flex desc1 == Flexible ->

@@ -239,7 +235,19 @@ actuallyUnify variable1 variable2 = do

239235 (Record1 _ _, Record1 _ _) ->

240236 recordUnify fresh variable1 variable2

241237

242− _ -> typeError variable1 variable2 Error.NoNote

238+ _ -> typeError variable1 variable2 Nothing

239+

240+

241+-- RIGID ERROR

242+

243+rigidErrorMessage :: String -> String

244+rigidErrorMessage var =

245+ "Could not unify user provided type variable `" ++ var ++ "`. The most likely cases are:\n\n"

246+ ++ " 1. The type you wrote down is too general. It says any type can go through\n"

247+ ++ " but in fact only a certain type can.\n"

248+ ++ " 2. A type variable is probably being shared between two type annotations.\n"

249+ ++ " They are treated as different things in the current implementation, so\n"

250+ ++ " Try commenting out some type annotations and see what happens."

243251

244252

245253-- RECORD UNIFICATION

@@ -262,14 +270,14 @@ recordUnify fresh variable1 variable2 =

262270 let uniqueFields2 = diffFields fields2 fields1

263271

264272 let addFieldMismatchError missingFields =

265− typeError variable1 variable2 $ Error.PreNote $

273+ typeError variable1 variable2 $ Just $

266274 fieldMismatchError missingFields

267275

268276 case (ext1, ext2) of

269277 (Empty _, Empty _) ->

270278 case Map.null uniqueFields1 && Map.null uniqueFields2 of

271279 True -> return ()

272− False -> typeError variable1 variable2 Error.NoNote

280+ False -> typeError variable1 variable2 Nothing

273281

274282 (Empty var1, Extension var2) ->

275283 case (Map.null uniqueFields1, Map.null uniqueFields2) of