1966810 · elk · git.iko.soy

git.iko.soy/elk

Rename to CLocal and CForeign / track variable names a bit different

commit1966810d849063e6162a1f3a83519f4fae9326d5 authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 12 Jan 2018, 16:13 (9 years ago) parent2a2e58c

4 files changed+59−60

compare with master

unifiedsplit

src/Type/Constrain/Expression.hs+34−28 src/Type/Constrain/Module.hs+3−3 src/Type/Constraint.hs+9−7 src/Type/Solve.hs+13−22

src/Type/Constrain/Expression.hs+34−28

@@ -41,22 +41,25 @@ constrain :: RTV -> Can.Expr -> Expected Type -> IO Constraint

4141constrain rtv (A.At region expression) expected =

4242 case expression of

4343 Can.VarLocal name ->

44− return (CLookup region name expected)

44+ return (CLocal region name expected)

4545

4646 Can.VarTopLevel _ name ->

47− return (CLookup region name expected)

47+ return (CLocal region name expected)

4848

4949 Can.VarKernel _ _ ->

5050 return CTrue

5151

5252 Can.VarForeign _ name annotation ->

53− return $ CInstance region (FuncName name) annotation expected

53+ return $ CForeign region name annotation expected

54+

55+ Can.VarCtor _ _ name _ annotation ->

56+ return $ CForeign region name annotation expected

5457

5558 Can.VarDebug _ name annotation ->

56− return $ CInstance region (FuncName name) annotation expected

59+ return $ CForeign region name annotation expected

5760

5861 Can.VarOperator op _ _ annotation ->

59− return $ CInstance region (OpName op) annotation expected

62+ return $ CForeign region op annotation expected

6063

6164 Can.Str _ ->

6265 return $ CEqual region String Type.string expected

@@ -180,7 +183,7 @@ constrainLambda rtv region args body expected =

180183

181184constrainCall :: RTV -> R.Region -> Can.Expr -> [Can.Expr] -> Expected Type -> IO Constraint

182185constrainCall rtv region func args expected =

183− do let maybeFuncName = getFuncName func

186+ do let maybeName = getName func

184187

185188 funcVar <- mkFlexVar

186189 resultVar <- mkFlexVar

@@ -190,10 +193,10 @@ constrainCall rtv region func args expected =

190193 funcCon <- constrain rtv func (NoExpectation funcType)

191194

192195 (argVars, argTypes, argCons) <-

193− unzip3 <$> Index.indexedTraverse (constrainArg rtv region maybeFuncName) args

196+ unzip3 <$> Index.indexedTraverse (constrainArg rtv region maybeName) args

194197

195198 let arityType = foldr FunN resultType argTypes

196− let resultCon = CEqual region (CallResult maybeFuncName) resultType expected

199+ let resultCon = CEqual region (CallResult maybeName) resultType expected

197200

198201 return $ exists (funcVar:resultVar:argVars) $

199202 CAnd

@@ -202,53 +205,56 @@ constrainCall rtv region func args expected =

202205 { _a = funcType

203206 , _b = arityType

204207 , _eq = CAnd [ CAnd argCons, resultCon ]

205− , _neq = constrainCallBackup rtv region maybeFuncName func args

208+ , _neq = constrainCallBackup rtv region maybeName func args

206209 }

207210 ]

208211

209212

210−constrainArg :: RTV -> R.Region -> Maybe FuncName -> Index.ZeroBased -> Can.Expr -> IO (Variable, Type, Constraint)

211−constrainArg rtv region maybeFuncName index arg =

213+constrainArg :: RTV -> R.Region -> MaybeName -> Index.ZeroBased -> Can.Expr -> IO (Variable, Type, Constraint)

214+constrainArg rtv region maybeName index arg =

212215 do argVar <- mkFlexVar

213216 let argType = VarN argVar

214− argCon <- constrain rtv arg (FromContext region (CallArg maybeFuncName index) argType)

217+ argCon <- constrain rtv arg (FromContext region (CallArg maybeName index) argType)

215218 return (argVar, argType, argCon)

216219

217220

218−constrainCallBackup :: RTV -> R.Region -> Maybe FuncName -> Can.Expr -> [Can.Expr] -> IO Constraint

219−constrainCallBackup rtv region maybeFuncName func args =

221+constrainCallBackup :: RTV -> R.Region -> MaybeName -> Can.Expr -> [Can.Expr] -> IO Constraint

222+constrainCallBackup rtv region maybeName func args =

220223 do (argVars, argTypes, argCons) <-

221− unzip3 <$> Index.indexedTraverse (constrainArg rtv region maybeFuncName) args

224+ unzip3 <$> Index.indexedTraverse (constrainArg rtv region maybeName) args

222225

223226 resultVar <- mkFlexVar

224227 let resultType = VarN resultVar

225228 let arityType = foldr FunN resultType argTypes

226229

227− funcCon <- constrain rtv func (FromContext region (TooManyArgs maybeFuncName (length args)) arityType)

230+ funcCon <- constrain rtv func (FromContext region (TooManyArgs maybeName (length args)) arityType)

228231

229232 return $ exists (resultVar:argVars) $ CAnd [ CAnd argCons, funcCon ]

230233

231234

232−getFuncName :: Can.Expr -> Maybe FuncName

233−getFuncName (A.At _ expr) =

235+getName :: Can.Expr -> MaybeName

236+getName (A.At _ expr) =

234237 case expr of

235238 Can.VarLocal name ->

236− Just (FuncName name)

239+ FuncName name

237240

238241 Can.VarTopLevel _ name ->

239− Just (FuncName name)

240−

241− Can.VarKernel _ name ->

242− Just (FuncName name)

242+ FuncName name

243243

244244 Can.VarForeign _ name _ ->

245− Just (FuncName name)

245+ FuncName name

246+

247+ Can.VarCtor _ _ name _ _ ->

248+ CtorName name

246249

247250 Can.VarOperator op _ _ _ ->

248− Just (OpName op)

251+ OpName op

252+

253+ Can.VarKernel _ name ->

254+ FuncName name

249255

250256 _ ->

251− Nothing

257+ NoName

252258

253259

254260

@@ -265,7 +271,7 @@ constrainBinop rtv region op annotation leftExpr rightExpr expected =

265271 let answerType = VarN answerVar

266272 let binopType = leftType ==> rightType ==> answerType

267273

268− let opCon = CInstance region (OpName op) annotation (NoExpectation binopType)

274+ let opCon = CForeign region op annotation (NoExpectation binopType)

269275

270276 leftCon <- constrain rtv leftExpr (FromContext region (OpLeft op) leftType)

271277 rightCon <- constrain rtv rightExpr (FromContext region (OpRight op) rightType)

@@ -275,7 +281,7 @@ constrainBinop rtv region op annotation leftExpr rightExpr expected =

275281 [ opCon

276282 , leftCon

277283 , rightCon

278− , CEqual region (CallResult (Just (OpName op))) answerType expected

284+ , CEqual region (CallResult (OpName op)) answerType expected

279285 ]

280286

281287

src/Type/Constrain/Module.hs+3−3

@@ -136,11 +136,11 @@ constrainEffects r0 r1 r2 toFinalArgs =

136136 return $

137137 CLet [] vars Map.empty

138138 (CAnd

139− [ CLookup r0 "init" $ NoExpectation $

139+ [ CLocal r0 "init" $ NoExpectation $

140140 task s0

141− , CLookup r1 "onEffects" $ NoExpectation $

141+ , CLocal r1 "onEffects" $ NoExpectation $

142142 router msg1 selfMsg1 ==> toFinalArgs msg1 (VarN s1 ==> task s1)

143− , CLookup r2 "onSelfMsg" $ NoExpectation $

143+ , CLocal r2 "onSelfMsg" $ NoExpectation $

144144 router msg2 selfMsg2 ==> VarN selfMsg2 ==> VarN s2 ==> task s2

145145 , equal r1 s0 (VarN s1)

146146 , equal r2 s0 (VarN s2)

src/Type/Constraint.hs+9−7

@@ -6,7 +6,7 @@ module Type.Constraint

66 , Expected(..)

77 , Context(..)

88 , SubContext(..)

9− , FuncName(..)

9+ , MaybeName(..)

1010 , Category(..)

1111 , PExpected(..)

1212 , PContext(..)

@@ -35,8 +35,8 @@ data Constraint

3535 = CTrue

3636 | CSaveTheEnvironment

3737 | CEqual R.Region Category Type (Expected Type)

38− | CLookup R.Region N.Name (Expected Type)

39− | CInstance R.Region FuncName Can.Annotation (Expected Type)

38+ | CLocal R.Region N.Name (Expected Type)

39+ | CForeign R.Region N.Name Can.Annotation (Expected Type)

4040 | CPattern R.Region PCategory Type (PExpected Type)

4141 | CAnd [Constraint]

4242 | CBranch

@@ -77,8 +77,8 @@ data Context

7777 | IfCondition

7878 | IfBranch Index.ZeroBased

7979 | CaseBranch Index.ZeroBased

80− | CallArg (Maybe FuncName) Index.ZeroBased

81− | TooManyArgs (Maybe FuncName) Int

80+ | CallArg MaybeName Index.ZeroBased

81+ | TooManyArgs MaybeName Int

8282 | RecordAccess N.Name

8383 | RecordUpdate

8484 | Destructure

@@ -90,9 +90,11 @@ data SubContext

9090 | TypedBody

9191

9292

93−data FuncName

93+data MaybeName

9494 = FuncName N.Name

95+ | CtorName N.Name

9596 | OpName N.Name

97+ | NoName

9698

9799

98100data Category

@@ -104,7 +106,7 @@ data Category

104106 | Binop

105107 | If

106108 | Case

107− | CallResult (Maybe FuncName)

109+ | CallResult MaybeName

108110 | Lambda

109111 | Accessor N.Name

110112 | Access N.Name

src/Type/Solve.hs+13−22

@@ -87,15 +87,14 @@ solve env rank pools state constraint =

8787 do introduce rank pools vars

8888 return state

8989

90− Unify.Err vars problem actualType expectedType ->

90+ Unify.Err vars actualType expectedType ->

9191 do introduce rank pools vars

9292 return $ addError state $

9393 Error.Mismatch

9494 (Error.BadExpr region category actualType)

9595 (Con.typeReplace expectation expectedType)

96− problem

9796

98− CLookup region name expectation ->

97+ CLocal region name expectation ->

9998 do actual <- makeCopy rank pools (env ! name)

10099 expected <- expectedToVariable rank pools expectation

101100 answer <- Unify.unify actual expected

@@ -104,15 +103,14 @@ solve env rank pools state constraint =

104103 do introduce rank pools vars

105104 return state

106105

107− Unify.Err vars problem actualType expectedType ->

106+ Unify.Err vars actualType expectedType ->

108107 do introduce rank pools vars

109108 return $ addError state $

110109 Error.Mismatch

111110 (Error.BadLocal region name actualType)

112111 (Con.typeReplace expectation expectedType)

113− problem

114112

115− CInstance region funcName (Can.Forall freeVars srcType) expectation ->

113+ CForeign region name (Can.Forall freeVars srcType) expectation ->

116114 do actual <- srcTypeToVariable rank pools freeVars srcType

117115 expected <- expectedToVariable rank pools expectation

118116 answer <- Unify.unify actual expected

@@ -121,13 +119,12 @@ solve env rank pools state constraint =

121119 do introduce rank pools vars

122120 return state

123121

124− Unify.Err vars problem actualType expectedType ->

122+ Unify.Err vars actualType expectedType ->

125123 do introduce rank pools vars

126124 return $ addError state $

127125 Error.Mismatch

128− (Error.BadForeign region funcName actualType)

126+ (Error.BadForeign region name actualType)

129127 (Con.typeReplace expectation expectedType)

130− problem

131128

132129 CPattern region category tipe expectation ->

133130 do actual <- typeToVariable rank pools tipe

@@ -138,12 +135,11 @@ solve env rank pools state constraint =

138135 do introduce rank pools vars

139136 return state

140137

141− Unify.Err vars problem actualType expectedType ->

138+ Unify.Err vars actualType expectedType ->

142139 do introduce rank pools vars

143140 return $ addError state $

144141 Error.BadPattern region category actualType

145142 (Con.ptypeReplace expectation expectedType)

146− problem

147143

148144 CAnd constraints ->

149145 foldM (solve env rank pools) state constraints

@@ -157,7 +153,7 @@ solve env rank pools state constraint =

157153 do introduce rank pools vars

158154 solve env rank pools state eqCon

159155

160− Unify.Err vars _ _ _ ->

156+ Unify.Err vars _ _ ->

161157 do introduce rank pools vars

162158 solve env rank pools state =<< makeNotEqCon

163159

@@ -218,16 +214,11 @@ isGeneric var =

218214 do (Descriptor _ rank _ _) <- UF.get var

219215 if rank == noRank

220216 then return ()

221− else crash "Unable to generalize a type variable. It is not unranked."

222−

223−

224−crash :: String -> a

225−crash msg =

226− error $

227− "It looks like something went wrong with the type inference algorithm.\n\n"

228− ++ msg ++ "\n\n"

229− ++ "Please create a minimal example that triggers this problem and report it to\n"

230− ++ "<https://github.com/elm-lang/elm-compiler/issues>"

217+ else

218+ error

219+ "You ran into a compiler bug!\n\n\

220+ \I was unable to generalize a type variable during type inference. It was ranked.\n\n\

221+ \Please create an <http://sscce.org/> and report it at <https://github.com/elm-lang/elm-compiler/issues>\n\n"

231222

232223

233224