6fbbd1b · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Always provide a specialized hint when unification fails

6fbbd1bEvan Czaplicki11 years ago

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

compare with master

unifiedsplit

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

22 { _hint :: Hint

23 , _leftType :: Type.Canonical

24 , _rightType :: Type.Canonical

25− , _note :: Note

25+ , _note :: Maybe String

26 }

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

36data Hint

37− = None

38− | CaseBranch Int Region.Region

37+ = CaseBranch Int Region.Region

39 | Case

38 | Case

40 | IfBranches

39 | IfBranches

41 | MultiIfBranch Int Region.Region

40 | MultiIfBranch Int Region.Region

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

48 | BadArgument Region.Region

47 | BadArgument Region.Region

49 | ExtraArgument Region.Region

48 | ExtraArgument Region.Region

50 | BadTypeAnnotation String

49 | BadTypeAnnotation String

50+ | Instance String

51+ | Literal String

52+ | Pattern Pattern

53+ | Shader

54+ | Range

55+ | Lambda

56+ | App

57+ | Record

53−data Note

60+data Pattern

54− = PreNote String

61+ = PVar String

55− | NoNote

62+ | PAlias String

56− | PostNote String

63+ | PData String

64+ | PRecord

59-- TO REPORT

67-- TO REPORT

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

66 (subRegion, preHint) = hintToString hint

74 (subRegion, preHint) = hintToString hint

68 postHint =

76 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"

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

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

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

81+ ++ "\n\n"

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

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

73 in

83 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

84 InfiniteType (InfiniteTypeInfo name var tipe) ->

86 InfiniteType (InfiniteTypeInfo name var tipe) ->

85 let

87 let

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

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

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

112hintToString hint =

114hintToString hint =

113 case hint of

115 case hint of

114− None ->

115− ( Nothing

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

117− )

118−

119 CaseBranch branchNumber region ->

116 CaseBranch branchNumber region ->

120 ( Just region

117 ( Just region

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

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

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

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

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

194 )

191 )

195

192

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+

196

241

197prettyOperator :: Var.Canonical -> String

242prettyOperator :: Var.Canonical -> String

198prettyOperator (Var.Canonical _ opName) =

243prettyOperator (Var.Canonical _ opName) =

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

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

29 -> IO TypeConstraint

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

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

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

33 (<?) = CInstance region

32 (<?) = CInstance region

34 in

33 in

35 case expression of

34 case expression of

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

57 uniform = makeRec Lit.uniform unif

56 uniform = makeRec Lit.uniform unif

58 varying = makeRec Lit.varying (termN EmptyRecord1)

57 varying = makeRec Lit.varying (termN EmptyRecord1)

59 in

58 in

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

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

62 E.Var var ->

61 E.Var var ->

63 let name = V.toString var

62 let name = V.toString var

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

68 existsNumber $ \n ->

67 existsNumber $ \n ->

69 do lowCon <- constrain env lowExpr n

68 do lowCon <- constrain env lowExpr n

70 highCon <- constrain env highExpr n

69 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+ ]

73 E.ExplicitList exprs ->

76 E.ExplicitList exprs ->

74 constrainList env region exprs tipe

77 constrainList env region exprs tipe

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

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

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

87 (Fragment.typeConstraint fragment /\ bodyCon)

90 (Fragment.typeConstraint fragment /\ bodyCon)

88 )

91 )

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

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

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

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

92 do argVar <- variable Flexible

95 do argVar <- variable Flexible

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

105 (varN funcVar)

108 (varN funcVar)

106 (varN argVar' ==> varN resultVar)

109 (varN argVar' ==> varN resultVar)

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

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

108− , tipe === varN resultVar

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

109 ]

112 ]

110

113

111 E.MultiIf branches ->

114 E.MultiIf branches ->

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

139 recordCon <- constrain env expr recordType

142 recordCon <- constrain env expr recordType

140 let newRecordType =

143 let newRecordType =

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

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

145+ return $ CAnd

146+ [ valueCon

147+ , recordCon

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

148+ , CEqual Error.Record region tipe newRecordType

149+ ]

143

150

144 E.Modify expr fields ->

151 E.Modify expr fields ->

145 exists $ \t ->

152 exists $ \t ->

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

149

156

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

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

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

158 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)

153

160

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

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

155

162

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

164 (map varN vars)

171 (map varN vars)

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

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

166 let recordType = record fields' (termN EmptyRecord1)

173 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])))

168

175

169 E.Let defs body ->

176 E.Let defs body ->

170 do bodyCon <- constrain env body tipe

177 do bodyCon <- constrain env body tipe

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

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

15 -> IO T.TypeConstraint

16constrain env region literal tipe =

17 do tipe' <- litType

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

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

19 where

20 prim name =

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

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

27 L.Chr _ -> prim "Char"

28 L.Str _ -> prim "String"

29 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

23 -> IO Fragment

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

25 let

26+ equal patternError leftType rightType =

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

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

28 rvar v =

29 rvar v =

29 A.A region (varN v)

30 A.A region (varN v)

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

41 return $ Fragment

42 return $ Fragment

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

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

43 , vars = [v]

44 , vars = [v]

44− , typeConstraint = varN v === tipe

45+ , typeConstraint =

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

45 }

47 }

47 P.Alias name p ->

49 P.Alias name p ->

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

50 return $ fragment

52 return $ fragment

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

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

52 , vars = v : vars fragment

54 , vars = v : vars fragment

55+ , typeConstraint =

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

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

57+ /\ typeConstraint fragment

54 }

58 }

56 P.Data name patterns ->

60 P.Data name patterns ->

61+ do let stringName = V.toString name

62+

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

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

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

64+ Env.freshDataScheme env stringName

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

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

61 let fragment = joinFragments fragList

67 let fragment = joinFragments fragList

62 return $ fragment

68 return $ fragment

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

69+ { vars = cvars ++ vars fragment

64− , vars = cvars ++ vars fragment

70+ , typeConstraint =

71+ typeConstraint fragment

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

65 }

73 }

67 P.Record fields ->

75 P.Record fields ->

76+ do pairs <-

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

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

78+

79+ let tenv =

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

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

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

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+

71 return $ Fragment

88 return $ Fragment

72 { typeEnv = tenv

89 { typeEnv = tenv

73 , vars = map snd pairs

90 , vars = map snd pairs

74− , typeConstraint = c

91+ , typeConstraint = con

75 }

92 }

src/Type/Solve.hs+1−1

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

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

171

172 t <- TS.flatten term

173− unify Error.None region freshCopy t

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

174

175

176solveScheme

src/Type/Unify.hs+23−15

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

44newtype RawMismatch =

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

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

48typeError

49 :: UF.Point Descriptor

50 -> UF.Point Descriptor

51− -> Error.Note

51+ -> Maybe String

52 -> Unify a

53typeError leftType rightType note =

54 do leftSrcType <- liftIO (toSrcType leftType)

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

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

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

123 _ ->

124− typeError variable1 variable2 Error.NoNote

124+ typeError variable1 variable2 Nothing

125

126 comparableError maybeHint =

127− typeError variable1 variable2 $ Error.PostNote $

127+ typeError variable1 variable2 $ Just $

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

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

130

131 appendableError =

132− typeError variable1 variable2 $ Error.PostNote $

132+ typeError variable1 variable2 $ Just $

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

134

135 unifyComparable v (Var.Canonical home name) =

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

164 _ -> appendableError

165

166 rigidError var =

167+ typeError variable1 variable2 $ Just $

167− let v = render (pretty Never var)

168+ rigidErrorMessage (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."

173

169

174 superUnify =

170 superUnify =

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

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

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

195

191

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

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

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

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

198− _ -> typeError variable1 variable2 Error.NoNote

194+ _ -> typeError variable1 variable2 Nothing

199

195

200 case (structure desc1, structure desc2) of

196 case (structure desc1, structure desc2) of

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

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

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

239 (Record1 _ _, Record1 _ _) ->

235 (Record1 _ _, Record1 _ _) ->

240 recordUnify fresh variable1 variable2

236 recordUnify fresh variable1 variable2

241

237

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."

243

251

244

252

245-- RECORD UNIFICATION

253-- RECORD UNIFICATION

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

262 let uniqueFields2 = diffFields fields2 fields1

270 let uniqueFields2 = diffFields fields2 fields1

263

271

264 let addFieldMismatchError missingFields =

272 let addFieldMismatchError missingFields =

265− typeError variable1 variable2 $ Error.PreNote $

273+ typeError variable1 variable2 $ Just $

266 fieldMismatchError missingFields

274 fieldMismatchError missingFields

267

275

268 case (ext1, ext2) of

276 case (ext1, ext2) of

269 (Empty _, Empty _) ->

277 (Empty _, Empty _) ->

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

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

271 True -> return ()

279 True -> return ()

272− False -> typeError variable1 variable2 Error.NoNote

280+ False -> typeError variable1 variable2 Nothing

273

281

274 (Empty var1, Extension var2) ->

282 (Empty var1, Extension var2) ->

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

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