41a1963 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Update Type/* for changes in AST.Canonical and Reporting.Region

41a1963Evan Czaplicki8 years ago

compiler/src/Type/Constrain/Expression.hs+17−18

compare with master

unifiedsplit

@@ -17,7 +17,6 @@ import qualified Elm.ModuleName as ModuleName

17import qualified Reporting.Annotation as A

18import qualified Reporting.Error.Type as E

19import Reporting.Error.Type (Expected(..), Context(..), SubContext(..), MaybeName(..), Category(..), PExpected(..), PContext(..))

20−import qualified Reporting.Region as R

21import qualified Type.Constrain.Pattern as Pattern

20import qualified Type.Constrain.Pattern as Pattern

22import qualified Type.Instantiate as Instantiate

21import qualified Type.Instantiate as Instantiate

23import Type.Type as Type hiding (Descriptor(..))

22import Type.Type as Type hiding (Descriptor(..))

@@ -149,15 +148,15 @@ constrain rtv (A.At region expression) expected =

149 Can.Tuple a b maybeC ->

148 Can.Tuple a b maybeC ->

150 constrainTuple rtv region a b maybeC expected

149 constrainTuple rtv region a b maybeC expected

151

150

152− Can.Shader _uid _src glType ->

151+ Can.Shader _src types ->

153− constrainShader region glType expected

152+ constrainShader region types expected

154

153

155

154

156

155

157-- CONSTRAIN LAMBDA

156-- CONSTRAIN LAMBDA

158

157

159

158

160−constrainLambda :: RTV -> R.Region -> [Can.Pattern] -> Can.Expr -> Expected Type -> IO Constraint

159+constrainLambda :: RTV -> A.Region -> [Can.Pattern] -> Can.Expr -> Expected Type -> IO Constraint

161constrainLambda rtv region args body expected =

160constrainLambda rtv region args body expected =

162 do (Args vars tipe resultType (Pattern.State headers pvars revCons)) <-

161 do (Args vars tipe resultType (Pattern.State headers pvars revCons)) <-

163 constrainArgs args

162 constrainArgs args

@@ -182,7 +181,7 @@ constrainLambda rtv region args body expected =

182-- CONSTRAIN CALL

181-- CONSTRAIN CALL

183

182

184

183

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

184+constrainCall :: RTV -> A.Region -> Can.Expr -> [Can.Expr] -> Expected Type -> IO Constraint

186constrainCall rtv region func@(A.At funcRegion _) args expected =

185constrainCall rtv region func@(A.At funcRegion _) args expected =

187 do let maybeName = getName func

186 do let maybeName = getName func

188

187

@@ -208,7 +207,7 @@ constrainCall rtv region func@(A.At funcRegion _) args expected =

208 ]

207 ]

209

208

210

209

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

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

212constrainArg rtv region maybeName index arg =

211constrainArg rtv region maybeName index arg =

213 do argVar <- mkFlexVar

212 do argVar <- mkFlexVar

214 let argType = VarN argVar

213 let argType = VarN argVar

@@ -241,7 +240,7 @@ getAccessName (A.At _ expr) =

241-- CONSTRAIN BINOP

240-- CONSTRAIN BINOP

242

241

243

242

244−constrainBinop :: RTV -> R.Region -> Name.Name -> Can.Annotation -> Can.Expr -> Can.Expr -> Expected Type -> IO Constraint

243+constrainBinop :: RTV -> A.Region -> Name.Name -> Can.Annotation -> Can.Expr -> Can.Expr -> Expected Type -> IO Constraint

245constrainBinop rtv region op annotation leftExpr rightExpr expected =

244constrainBinop rtv region op annotation leftExpr rightExpr expected =

246 do leftVar <- mkFlexVar

245 do leftVar <- mkFlexVar

247 rightVar <- mkFlexVar

246 rightVar <- mkFlexVar

@@ -269,7 +268,7 @@ constrainBinop rtv region op annotation leftExpr rightExpr expected =

269-- CONSTRAIN LISTS

268-- CONSTRAIN LISTS

270

269

271

270

272−constrainList :: RTV -> R.Region -> [Can.Expr] -> Expected Type -> IO Constraint

271+constrainList :: RTV -> A.Region -> [Can.Expr] -> Expected Type -> IO Constraint

273constrainList rtv region entries expected =

272constrainList rtv region entries expected =

274 do entryVar <- mkFlexVar

273 do entryVar <- mkFlexVar

275 let entryType = VarN entryVar

274 let entryType = VarN entryVar

@@ -285,7 +284,7 @@ constrainList rtv region entries expected =

285 ]

284 ]

286

285

287

286

288−constrainListEntry :: RTV -> R.Region -> Type -> Index.ZeroBased -> Can.Expr -> IO Constraint

287+constrainListEntry :: RTV -> A.Region -> Type -> Index.ZeroBased -> Can.Expr -> IO Constraint

289constrainListEntry rtv region tipe index expr =

288constrainListEntry rtv region tipe index expr =

290 constrain rtv expr (FromContext region (ListEntry index) tipe)

289 constrain rtv expr (FromContext region (ListEntry index) tipe)

291

290

@@ -294,7 +293,7 @@ constrainListEntry rtv region tipe index expr =

294-- CONSTRAIN IF EXPRESSIONS

293-- CONSTRAIN IF EXPRESSIONS

295

294

296

295

297−constrainIf :: RTV -> R.Region -> [(Can.Expr, Can.Expr)] -> Can.Expr -> Expected Type -> IO Constraint

296+constrainIf :: RTV -> A.Region -> [(Can.Expr, Can.Expr)] -> Can.Expr -> Expected Type -> IO Constraint

298constrainIf rtv region branches final expected =

297constrainIf rtv region branches final expected =

299 do let boolExpect = FromContext region IfCondition Type.bool

298 do let boolExpect = FromContext region IfCondition Type.bool

300 let (conditions, exprs) = foldr (\(c,e) (cs,es) -> (c:cs,e:es)) ([],[final]) branches

299 let (conditions, exprs) = foldr (\(c,e) (cs,es) -> (c:cs,e:es)) ([],[final]) branches

@@ -331,7 +330,7 @@ constrainIf rtv region branches final expected =

331-- CONSTRAIN CASE EXPRESSIONS

330-- CONSTRAIN CASE EXPRESSIONS

332

331

333

332

334−constrainCase :: RTV -> R.Region -> Can.Expr -> [Can.CaseBranch] -> Expected Type -> IO Constraint

333+constrainCase :: RTV -> A.Region -> Can.Expr -> [Can.CaseBranch] -> Expected Type -> IO Constraint

335constrainCase rtv region expr branches expected =

334constrainCase rtv region expr branches expected =

336 do ptrnVar <- mkFlexVar

335 do ptrnVar <- mkFlexVar

337 let ptrnType = VarN ptrnVar

336 let ptrnType = VarN ptrnVar

@@ -376,7 +375,7 @@ constrainCaseBranch rtv (Can.CaseBranch pattern expr) pExpect bExpect =

376-- CONSTRAIN RECORD

375-- CONSTRAIN RECORD

377

376

378

377

379−constrainRecord :: RTV -> R.Region -> Map.Map Name.Name Can.Expr -> Expected Type -> IO Constraint

378+constrainRecord :: RTV -> A.Region -> Map.Map Name.Name Can.Expr -> Expected Type -> IO Constraint

380constrainRecord rtv region fields expected =

379constrainRecord rtv region fields expected =

381 do dict <- traverse (constrainField rtv) fields

380 do dict <- traverse (constrainField rtv) fields

382

381

@@ -402,7 +401,7 @@ constrainField rtv expr =

402-- CONSTRAIN RECORD UPDATE

401-- CONSTRAIN RECORD UPDATE

403

402

404

403

405−constrainUpdate :: RTV -> R.Region -> Name.Name -> Can.Expr -> Map.Map Name.Name Can.FieldUpdate -> Expected Type -> IO Constraint

404+constrainUpdate :: RTV -> A.Region -> Name.Name -> Can.Expr -> Map.Map Name.Name Can.FieldUpdate -> Expected Type -> IO Constraint

406constrainUpdate rtv region name expr fields expected =

405constrainUpdate rtv region name expr fields expected =

407 do extVar <- mkFlexVar

406 do extVar <- mkFlexVar

408 fieldDict <- Map.traverseWithKey (constrainUpdateField rtv region) fields

407 fieldDict <- Map.traverseWithKey (constrainUpdateField rtv region) fields

@@ -423,7 +422,7 @@ constrainUpdate rtv region name expr fields expected =

423 return $ exists vars $ CAnd (fieldsCon:con:cons)

422 return $ exists vars $ CAnd (fieldsCon:con:cons)

424

423

425

424

426−constrainUpdateField :: RTV -> R.Region -> Name.Name -> Can.FieldUpdate -> IO (Variable, Type, Constraint)

425+constrainUpdateField :: RTV -> A.Region -> Name.Name -> Can.FieldUpdate -> IO (Variable, Type, Constraint)

427constrainUpdateField rtv region field (Can.FieldUpdate _ expr) =

426constrainUpdateField rtv region field (Can.FieldUpdate _ expr) =

428 do var <- mkFlexVar

427 do var <- mkFlexVar

429 let tipe = VarN var

428 let tipe = VarN var

@@ -435,7 +434,7 @@ constrainUpdateField rtv region field (Can.FieldUpdate _ expr) =

435-- CONSTRAIN TUPLE

434-- CONSTRAIN TUPLE

436

435

437

436

438−constrainTuple :: RTV -> R.Region -> Can.Expr -> Can.Expr -> Maybe Can.Expr -> Expected Type -> IO Constraint

437+constrainTuple :: RTV -> A.Region -> Can.Expr -> Can.Expr -> Maybe Can.Expr -> Expected Type -> IO Constraint

439constrainTuple rtv region a b maybeC expected =

438constrainTuple rtv region a b maybeC expected =

440 do aVar <- mkFlexVar

439 do aVar <- mkFlexVar

441 bVar <- mkFlexVar

440 bVar <- mkFlexVar

@@ -467,8 +466,8 @@ constrainTuple rtv region a b maybeC expected =

467-- CONSTRAIN SHADER

466-- CONSTRAIN SHADER

468

467

469

468

470−constrainShader :: R.Region -> Shader.Shader -> Expected Type -> IO Constraint

469+constrainShader :: A.Region -> Shader.Types -> Expected Type -> IO Constraint

471−constrainShader region (Shader.Shader attributes uniforms varyings) expected =

470+constrainShader region (Shader.Types attributes uniforms varyings) expected =

472 do attrVar <- mkFlexVar

471 do attrVar <- mkFlexVar

473 unifVar <- mkFlexVar

472 unifVar <- mkFlexVar

474 let attrType = VarN attrVar

473 let attrType = VarN attrVar

@@ -509,7 +508,7 @@ glToType glType =

509-- CONSTRAIN DESTRUCTURES

508-- CONSTRAIN DESTRUCTURES

510

509

511

510

512−constrainDestruct :: RTV -> R.Region -> Can.Pattern -> Can.Expr -> Constraint -> IO Constraint

511+constrainDestruct :: RTV -> A.Region -> Can.Pattern -> Can.Expr -> Constraint -> IO Constraint

513constrainDestruct rtv region pattern expr bodyCon =

512constrainDestruct rtv region pattern expr bodyCon =

514 do patternVar <- mkFlexVar

513 do patternVar <- mkFlexVar

515 let patternType = VarN patternVar

514 let patternType = VarN patternVar

compiler/src/Type/Constrain/Module.hs+7−8

@@ -13,7 +13,6 @@ import qualified AST.Canonical as Can

13import qualified Elm.ModuleName as ModuleName

14import qualified Reporting.Annotation as A

15import qualified Reporting.Error.Type as E

16−import qualified Reporting.Region as R

17import qualified Type.Constrain.Expression as Expr

16import qualified Type.Constrain.Expression as Expr

18import qualified Type.Instantiate as Instantiate

17import qualified Type.Instantiate as Instantiate

19import Type.Type (Type(..), Constraint(..), (==>), mkFlexVar, nameToRigid, never)

18import Type.Type (Type(..), Constraint(..), (==>), mkFlexVar, nameToRigid, never)

@@ -24,7 +23,7 @@ import Type.Type (Type(..), Constraint(..), (==>), mkFlexVar, nameToRigid, never

26constrain :: Can.Module -> IO Constraint

25constrain :: Can.Module -> IO Constraint

27−constrain (Can.Module home _ _ decls _ _ _ effects) =

26+constrain (Can.Module home _ decls _ _ _ effects) =

28 case effects of

27 case effects of

29 Can.NoEffects ->

28 Can.NoEffects ->

30 constrainDecls decls CSaveTheEnvironment

29 constrainDecls decls CSaveTheEnvironment

@@ -75,13 +74,13 @@ letPort name port_ makeConstraint =

75 Can.Incoming freeVars _ srcType ->

74 Can.Incoming freeVars _ srcType ->

76 do vars <- Map.traverseWithKey (\k _ -> nameToRigid k) freeVars

75 do vars <- Map.traverseWithKey (\k _ -> nameToRigid k) freeVars

77 tipe <- Instantiate.fromSrcType (Map.map VarN vars) srcType

76 tipe <- Instantiate.fromSrcType (Map.map VarN vars) srcType

78− let header = Map.singleton name (A.At R.zero tipe)

77+ let header = Map.singleton name (A.At A.zero tipe)

79 CLet (Map.elems vars) [] header CTrue <$> makeConstraint

78 CLet (Map.elems vars) [] header CTrue <$> makeConstraint

81 Can.Outgoing freeVars _ srcType ->

80 Can.Outgoing freeVars _ srcType ->

82 do vars <- Map.traverseWithKey (\k _ -> nameToRigid k) freeVars

81 do vars <- Map.traverseWithKey (\k _ -> nameToRigid k) freeVars

83 tipe <- Instantiate.fromSrcType (Map.map VarN vars) srcType

82 tipe <- Instantiate.fromSrcType (Map.map VarN vars) srcType

84− let header = Map.singleton name (A.At R.zero tipe)

83+ let header = Map.singleton name (A.At A.zero tipe)

85 CLet (Map.elems vars) [] header CTrue <$> makeConstraint

84 CLet (Map.elems vars) [] header CTrue <$> makeConstraint

@@ -94,7 +93,7 @@ letCmd home tipe constraint =

94 do msgVar <- mkFlexVar

93 do msgVar <- mkFlexVar

95 let msg = VarN msgVar

94 let msg = VarN msgVar

96 let cmdType = FunN (AppN home tipe [msg]) (AppN ModuleName.cmd Name.cmd [msg])

95 let cmdType = FunN (AppN home tipe [msg]) (AppN ModuleName.cmd Name.cmd [msg])

97− let header = Map.singleton "command" (A.At R.zero cmdType)

96+ let header = Map.singleton "command" (A.At A.zero cmdType)

98 return $ CLet [msgVar] [] header CTrue constraint

97 return $ CLet [msgVar] [] header CTrue constraint

100

@@ -103,11 +102,11 @@ letSub home tipe constraint =

103 do msgVar <- mkFlexVar

102 do msgVar <- mkFlexVar

104 let msg = VarN msgVar

103 let msg = VarN msgVar

105 let subType = FunN (AppN home tipe [msg]) (AppN ModuleName.sub Name.sub [msg])

104 let subType = FunN (AppN home tipe [msg]) (AppN ModuleName.sub Name.sub [msg])

106− let header = Map.singleton "subscription" (A.At R.zero subType)

105+ let header = Map.singleton "subscription" (A.At A.zero subType)

107 return $ CLet [msgVar] [] header CTrue constraint

106 return $ CLet [msgVar] [] header CTrue constraint

108

107

109

108

110−constrainEffects :: ModuleName.Canonical -> R.Region -> R.Region -> R.Region -> Can.Manager -> IO Constraint

109+constrainEffects :: ModuleName.Canonical -> A.Region -> A.Region -> A.Region -> Can.Manager -> IO Constraint

111constrainEffects home r0 r1 r2 manager =

110constrainEffects home r0 r1 r2 manager =

112 do s0 <- mkFlexVar

111 do s0 <- mkFlexVar

113 s1 <- mkFlexVar

112 s1 <- mkFlexVar

@@ -175,7 +174,7 @@ checkMap name home tipe constraint =

175 do a <- mkFlexVar

174 do a <- mkFlexVar

176 b <- mkFlexVar

175 b <- mkFlexVar

177 let mapType = toMapType home tipe (VarN a) (VarN b)

176 let mapType = toMapType home tipe (VarN a) (VarN b)

178− let mapCon = CLocal R.zero name (E.NoExpectation mapType)

177+ let mapCon = CLocal A.zero name (E.NoExpectation mapType)

179 return $ CLet [a,b] [] Map.empty mapCon constraint

178 return $ CLet [a,b] [] Map.empty mapCon constraint

180

179

181

180

compiler/src/Type/Constrain/Pattern.hs+5−6

@@ -17,7 +17,6 @@ import qualified Data.Index as Index

17import qualified Elm.ModuleName as ModuleName

18import qualified Reporting.Annotation as A

19import qualified Reporting.Error.Type as E

20−import qualified Reporting.Region as R

21import qualified Type.Instantiate as Instantiate

20import qualified Type.Instantiate as Instantiate

22import Type.Type as T

21import Type.Type as T

@@ -138,7 +137,7 @@ emptyState =

138 State Map.empty [] []

137 State Map.empty [] []

139

138

140

139

141−addToHeaders :: R.Region -> Name.Name -> E.PExpected Type -> State -> State

140+addToHeaders :: A.Region -> Name.Name -> E.PExpected Type -> State -> State

142addToHeaders region name expectation (State headers vars revCons) =

141addToHeaders region name expectation (State headers vars revCons) =

143 let

142 let

144 tipe = getType expectation

143 tipe = getType expectation

@@ -158,7 +157,7 @@ getType expectation =

158-- CONSTRAIN LIST

157-- CONSTRAIN LIST

159

158

160

159

161−addEntry :: R.Region -> Type -> State -> (Index.ZeroBased, Can.Pattern) -> IO State

160+addEntry :: A.Region -> Type -> State -> (Index.ZeroBased, Can.Pattern) -> IO State

162addEntry listRegion tipe state (index, pattern) =

161addEntry listRegion tipe state (index, pattern) =

163 let

162 let

164 expectation =

163 expectation =

@@ -171,7 +170,7 @@ addEntry listRegion tipe state (index, pattern) =

171-- CONSTRAIN TUPLE

170-- CONSTRAIN TUPLE

172

171

173

172

174−addTuple :: R.Region -> Can.Pattern -> Can.Pattern -> Maybe Can.Pattern -> E.PExpected Type -> State -> IO State

173+addTuple :: A.Region -> Can.Pattern -> Can.Pattern -> Maybe Can.Pattern -> E.PExpected Type -> State -> IO State

175addTuple region a b maybeC expectation state =

174addTuple region a b maybeC expectation state =

176 do aVar <- mkFlexVar

175 do aVar <- mkFlexVar

177 bVar <- mkFlexVar

176 bVar <- mkFlexVar

@@ -211,7 +210,7 @@ simpleAdd pattern patternType state =

211-- CONSTRAIN CONSTRUCTORS

210-- CONSTRAIN CONSTRUCTORS

212

211

213

212

214−addCtor :: R.Region -> ModuleName.Canonical -> Name.Name -> [Name.Name] -> Name.Name -> [Can.PatternCtorArg] -> E.PExpected Type -> State -> IO State

213+addCtor :: A.Region -> ModuleName.Canonical -> Name.Name -> [Name.Name] -> Name.Name -> [Can.PatternCtorArg] -> E.PExpected Type -> State -> IO State

215addCtor region home typeName typeVarNames ctorName args expectation state =

214addCtor region home typeName typeVarNames ctorName args expectation state =

216 do varPairs <- traverse (\var -> (,) var <$> nameToFlex var) typeVarNames

215 do varPairs <- traverse (\var -> (,) var <$> nameToFlex var) typeVarNames

217 let typePairs = map (second VarN) varPairs

216 let typePairs = map (second VarN) varPairs

@@ -231,7 +230,7 @@ addCtor region home typeName typeVarNames ctorName args expectation state =

231 }

230 }

232

231

233

232

234−addCtorArg :: R.Region -> Name.Name -> Map.Map Name.Name Type -> State -> Can.PatternCtorArg -> IO State

233+addCtorArg :: A.Region -> Name.Name -> Map.Map Name.Name Type -> State -> Can.PatternCtorArg -> IO State

235addCtorArg region ctorName freeVarDict state (Can.PatternCtorArg index srcType pattern) =

234addCtorArg region ctorName freeVarDict state (Can.PatternCtorArg index srcType pattern) =

236 do tipe <- Instantiate.fromSrcType freeVarDict srcType

235 do tipe <- Instantiate.fromSrcType freeVarDict srcType

237 let expectation = E.PFromContext region (E.PCtorArg ctorName index) tipe

236 let expectation = E.PFromContext region (E.PCtorArg ctorName index) tipe

compiler/src/Type/Type.hs+4−5

@@ -41,7 +41,6 @@ import qualified AST.Utils.Type as Type

41import qualified Elm.ModuleName as ModuleName

42import qualified Reporting.Annotation as A

43import qualified Reporting.Error.Type as E

44−import qualified Reporting.Region as R

45import qualified Type.Error as ET

44import qualified Type.Error as ET

46import qualified Type.UnionFind as UF

45import qualified Type.UnionFind as UF

@@ -53,10 +52,10 @@ import qualified Type.UnionFind as UF

53data Constraint

52data Constraint

54 = CTrue

53 = CTrue

55 | CSaveTheEnvironment

54 | CSaveTheEnvironment

56− | CEqual R.Region E.Category Type (E.Expected Type)

55+ | CEqual A.Region E.Category Type (E.Expected Type)

57− | CLocal R.Region Name.Name (E.Expected Type)

56+ | CLocal A.Region Name.Name (E.Expected Type)

58− | CForeign R.Region Name.Name Can.Annotation (E.Expected Type)

57+ | CForeign A.Region Name.Name Can.Annotation (E.Expected Type)

59− | CPattern R.Region E.PCategory Type (E.PExpected Type)

58+ | CPattern A.Region E.PCategory Type (E.PExpected Type)

60 | CAnd [Constraint]

59 | CAnd [Constraint]

61 | CLet

60 | CLet

62 { _rigidVars :: [Variable]

61 { _rigidVars :: [Variable]