41a1963 · elk · git.iko.soy

git.iko.soy/elk

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

commit41a1963dbf7876b26ddd5c875d4e5fc0e8f3986f authorEvan Czaplicki <evancz@users.noreply.github.com> dateThu 27 Dec 2018, 11:50 (8 years ago) parent1ae4e82

4 files changed+33−37

compare with master

unifiedsplit

compiler/src/Type/Constrain/Expression.hs+17−18 compiler/src/Type/Constrain/Module.hs+7−8 compiler/src/Type/Constrain/Pattern.hs+5−6 compiler/src/Type/Type.hs+4−5

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

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

1717import qualified Reporting.Annotation as A

1818import qualified Reporting.Error.Type as E

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

20−import qualified Reporting.Region as R

2120import qualified Type.Constrain.Pattern as Pattern

2221import qualified Type.Instantiate as Instantiate

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

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

149148 Can.Tuple a b maybeC ->

150149 constrainTuple rtv region a b maybeC expected

151150

152− Can.Shader _uid _src glType ->

153− constrainShader region glType expected

151+ Can.Shader _src types ->

152+ constrainShader region types expected

154153

155154

156155

157156-- CONSTRAIN LAMBDA

158157

159158

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

161160constrainLambda rtv region args body expected =

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

163162 constrainArgs args

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

182181-- CONSTRAIN CALL

183182

184183

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

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

187186 do let maybeName = getName func

188187

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

208207 ]

209208

210209

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)

212211constrainArg rtv region maybeName index arg =

213212 do argVar <- mkFlexVar

214213 let argType = VarN argVar

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

241240-- CONSTRAIN BINOP

242241

243242

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

245244constrainBinop rtv region op annotation leftExpr rightExpr expected =

246245 do leftVar <- mkFlexVar

247246 rightVar <- mkFlexVar

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

269268-- CONSTRAIN LISTS

270269

271270

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

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

273272constrainList rtv region entries expected =

274273 do entryVar <- mkFlexVar

275274 let entryType = VarN entryVar

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

285284 ]

286285

287286

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

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

289288constrainListEntry rtv region tipe index expr =

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

291290

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

294293-- CONSTRAIN IF EXPRESSIONS

295294

296295

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

298297constrainIf rtv region branches final expected =

299298 do let boolExpect = FromContext region IfCondition Type.bool

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

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

331330-- CONSTRAIN CASE EXPRESSIONS

332331

333332

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

335334constrainCase rtv region expr branches expected =

336335 do ptrnVar <- mkFlexVar

337336 let ptrnType = VarN ptrnVar

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

376375-- CONSTRAIN RECORD

377376

378377

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

380379constrainRecord rtv region fields expected =

381380 do dict <- traverse (constrainField rtv) fields

382381

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

402401-- CONSTRAIN RECORD UPDATE

403402

404403

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

406405constrainUpdate rtv region name expr fields expected =

407406 do extVar <- mkFlexVar

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

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

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

424423

425424

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)

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

428427 do var <- mkFlexVar

429428 let tipe = VarN var

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

435434-- CONSTRAIN TUPLE

436435

437436

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

439438constrainTuple rtv region a b maybeC expected =

440439 do aVar <- mkFlexVar

441440 bVar <- mkFlexVar

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

467466-- CONSTRAIN SHADER

468467

469468

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

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

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

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

472471 do attrVar <- mkFlexVar

473472 unifVar <- mkFlexVar

474473 let attrType = VarN attrVar

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

509508-- CONSTRAIN DESTRUCTURES

510509

511510

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

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

513512constrainDestruct rtv region pattern expr bodyCon =

514513 do patternVar <- mkFlexVar

515514 let patternType = VarN patternVar

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

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

1313import qualified Elm.ModuleName as ModuleName

1414import qualified Reporting.Annotation as A

1515import qualified Reporting.Error.Type as E

16−import qualified Reporting.Region as R

1716import qualified Type.Constrain.Expression as Expr

1817import qualified Type.Instantiate as Instantiate

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

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

2423

2524

2625constrain :: Can.Module -> IO Constraint

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

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

2827 case effects of

2928 Can.NoEffects ->

3029 constrainDecls decls CSaveTheEnvironment

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

7574 Can.Incoming freeVars _ srcType ->

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

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

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

8079

8180 Can.Outgoing freeVars _ srcType ->

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

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

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

8685

8786

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

9493 do msgVar <- mkFlexVar

9594 let msg = VarN msgVar

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

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

9998

10099

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

103102 do msgVar <- mkFlexVar

104103 let msg = VarN msgVar

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

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

108107

109108

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

111110constrainEffects home r0 r1 r2 manager =

112111 do s0 <- mkFlexVar

113112 s1 <- mkFlexVar

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

175174 do a <- mkFlexVar

176175 b <- mkFlexVar

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

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

180179

181180

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

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

1717import qualified Elm.ModuleName as ModuleName

1818import qualified Reporting.Annotation as A

1919import qualified Reporting.Error.Type as E

20−import qualified Reporting.Region as R

2120import qualified Type.Instantiate as Instantiate

2221import Type.Type as T

2322

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

138137 State Map.empty [] []

139138

140139

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

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

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

143142 let

144143 tipe = getType expectation

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

158157-- CONSTRAIN LIST

159158

160159

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

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

162161addEntry listRegion tipe state (index, pattern) =

163162 let

164163 expectation =

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

171170-- CONSTRAIN TUPLE

172171

173172

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

175174addTuple region a b maybeC expectation state =

176175 do aVar <- mkFlexVar

177176 bVar <- mkFlexVar

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

211210-- CONSTRAIN CONSTRUCTORS

212211

213212

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

215214addCtor region home typeName typeVarNames ctorName args expectation state =

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

217216 let typePairs = map (second VarN) varPairs

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

231230 }

232231

233232

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

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

236235 do tipe <- Instantiate.fromSrcType freeVarDict srcType

237236 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

4141import qualified Elm.ModuleName as ModuleName

4242import qualified Reporting.Annotation as A

4343import qualified Reporting.Error.Type as E

44−import qualified Reporting.Region as R

4544import qualified Type.Error as ET

4645import qualified Type.UnionFind as UF

4746

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

5352data Constraint

5453 = CTrue

5554 | CSaveTheEnvironment

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

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

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

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

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

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

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

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

6059 | CAnd [Constraint]

6160 | CLet

6261 { _rigidVars :: [Variable]